| 함수 getKbstatus () : 문자열; // Numloce, Caps Lock, Insert를 포함하여 현재 키보드 상태로 돌아갑니다. // 각 상태 정보는 순서대로 두 문자를 차지합니다. // 오른쪽 복사 549@11 : 29 2003-7-22 var 상태 : 문자열; Keystates : Tkeyboardstate; 시작하다 getkeyboardstate (keystates); 홀수 (keystates [vk_numlock]) 상태 : = '번호' 또 다른 상태 : = '커서'; 홀수 (keystates [vk_capital]) 상태 : = 상태+'캡' 또 다른 상태 : = 상태+'소문자'; 홀수 (keystates [vk_insert]) 상태 : = 상태+'삽입' 또 다른 상태 : = status+'rewrite'; 결과 : = 상태; 끝; 팁 : 팁 : const errhead = '작업에서 오류가 발생했으며 오류 메시지는'+#13입니다. 노력하다 ... 제외하고 ON E : 예외는 showMessage (errhead+e.message+#13+'현재 작동은 xxxxx'); 끝; 사용자가 더 많은 오류 메시지를 볼 수있어 고객이 프로그램 오류를 피드백하는 데 도움이됩니다. 나는 좋은 생각을 씁니다. 그러나 나는 종종 그것을 사용합니다 : // >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>OUNDE >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>ONDO >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> // SQL을 실행합니다 // 입력 매개 변수 : SQLString, AdoQuery // 유형 : String, TadoQuery 절차 tmainform.exesql (sqlstring : String; AdoQuery : TadoQuery); 시작하다 AdoQuery와 함께 시작하다 연결 : = DM.DBACCINFO; // 이것은 내 것입니다. 연결을 추가 할 수 있습니다. // 사용하십시오. 그렇다면 활성화 된 경우 활성 : = 거짓; 열려 있는; SQL. 청소; sql.add (sqlstring); execsql; 닫다; 끝; 아마도 모든 사람들이 이것을 알고 있을지도 모릅니다. 그러나 내가 본 코드에서는 그러한 독립적 인 프로세스를 쓰는 사람이 거의없는 것 같습니다. 이것은 혼자서 독창적 인 것으로 보장됩니다 ... // adoQuery를 열었습니다 // 실제 과정에서 적응 한 (Aixiang (Lizzy만이 다른 사람들이 할 수 없다고들을 수 있음))) // 멀티 라인 SQL을 지원합니다 // 단일 라인 SQL 프로 시저 또는 exeSQL 프로 시저 만 지원하기 위해 필요에 따라 직접 수정할 수 있습니다. // delphi6의 테스트가 통과되었습니다. 절차 OpenSQL (sqlstring : tstrings; adoquery : tadoquery); var i : 정수; 시작하다 AdoQuery와 함께 시작하다 닫다; SQL. 청소; i : = 0 ~ sqlstring.count-1 do sql.add (sqlstring [i]); 노력하다 열려 있는; 제외하고 ON E : 예외는 showMessage를 수행합니다 ( '오류 : 메시지는 다음과 같습니다.'+#13+e.message); 끝; 끝; 끝; 이것은 SQL의 한 줄입니다 절차 OpenSQL1 (SQLString : String; AdoQuery : TadoQuery); 시작하다 AdoQuery와 함께 시작하다 닫다; SQL. 청소; sql.add (sqlstring); 노력하다 열려 있는; 제외하고 ON E : 예외는 showMessage를 수행합니다 ( '오류 : 메시지는 다음과 같습니다.'+#13+e.message); 끝; 끝; 끝; 호호,이 문제를 해결하도록 도와 주셔서 감사합니다. 하지만 execsql을 사용하지 않습니까? 나는 보통이 과정 밖에서, 즉 그가 인용 된 곳에서 시도를 추가합니다. 그것은 시도입니다 exesql (sqlstring, adoquery1) 제외하고 // 오류 프롬프트, 지저분한 물건. 끝 to : Reallike (Aixiang (Lizzy만이 다른 사람들이 할 수 없다고들을 수 있음)) 나도 execsql을했다 // execsql adoQuery // 멀티 라인 SQL을 지원합니다 // 단일 라인 SQL 프로 시저 또는 exeSQL 프로 시저 만 지원하기 위해 필요에 따라 직접 수정할 수 있습니다. // delphi6의 테스트가 통과되었습니다. 절차 exesql (sqlstring : tstrings; adoquery : tadoquery); var i : 정수; 시작하다 AdoQuery와 함께 시작됩니다 닫다; SQL. 청소; i : = 0 ~ sqlstring.count-1 do sql.add (sqlstring [i]); 노력하다 execsql; 제외하고 ON E : 예외는 showMessage를 수행합니다 ( '오류 : 메시지는 다음과 같습니다.'+#13+e.message); 끝; 끝; 끝; // 제외한 위치와 동일하다고 생각합니다. 다른 디버깅 정보를 추가 할 수 있기 때문에 외부에 넣는 것이 좋습니다. //어떻게 생각하나요? // 단일 줄을 실행하고 여러 줄을 하나로 실행하는 두 프로세스를 결합한 사람은 누구입니까? 두 가지를 더 할 것입니다. 내 필요에 따라 추가하고 삭제할 수 있지만 DBGrideh를 사용하여 동적으로 COL을 생성합니다. 절차 buildCol (vfieldName : String; vcaption : String; vwidth : Integer; var vgrid : tdbgrideh; butertype : tfootervaluetype = fvtnon; boolreadonly : boolean = true; tcolor = clbtnface); var CCOL : TDBGRIDCOLUMNEH; Cfootercol : Tcolumnfootereh; 시작하다 ccol : = tdbgridcolumneh.create (vgrid.columns); ccol.fieldName : = vfieldName; ccol.width : = vwidth; ccol.title.caption : = vcaption; ccol.title.alignment : = Tacenter; ccol.title.color : = vcolor; ccol.readonly : = boolreadonly; // 태그 값이 -1 인 경우 dbgrid 인쇄시 열은 인쇄되지 않습니다. ccol.tag : = itag; 시작하다 cfootercol : = ccol.footers.add; cfootercol.valueType : = buterType; 바닥 타자 = fvtstaticText라면 시작하다 vgrid.footerRowCount : = 1; cfootercol.value : = 바닥 텍스트; 끝; //ccol.footer.fieldName:=; 끝; 끝; 프로 시저 TitleBtnClick (발신자 : Tobject; Acol : Integer; 칼럼 : tcolumneh; var cdstmp : tclientDataset; 시작하다 (TDBGRIDEH로서 발신자)와 함께 시작하다 cdstmp : = (tclientDataset as as dataSource.dataset); cdstmp.active가 아닌 경우 종료하십시오. // 현재 행의 정렬 방법을 설정합니다 column.title.sortmarker = smnoneeh라면 시작하다 Column.title.sortmarker : = Smupeh; CDSHELPER.SORTBYFIELD (column.fieldName, Soascending); 끝 또 다른 column.title.sortmarker = smupeh 시작하다 column.title.sortmarker : = smdowneh; CDSHELPER.SORTBYFIELD (column.fieldName, Sodescending); 끝 또 다른 시작하다 Column.title.sortmarker : = Smnoneeh; CDSHELPER.SORTBYFIELD (column.fieldName, SonoSort); 끝; 끝; 종료; DBGrid의 각 열의 위치와 너비를 INI 파일에 기록하고 INI 파일에서 DBGRID의 각 열의 위치와 너비를 읽습니다. 절차 f_readini (const now_dbgrid : tdbgrid; form_name : String); var FilePath : 문자열; myinifile : Tinifile; grid_name, field_name : 문자열; 너비 : 정수; i, j, n : 정수; 열 : 문자열의 배열 [0..100]; 너비 : 정수의 배열 [0..100]; 시작하다 FilePath : = ExtractFilePath (Application.Exename); myInifile : = tinifile.create (filepath+'gsp.ini'); grid_name : = form_name+','+now_dbgrid.name; n : = now_dbgrid.columns.count-1; i : = 0 ~ n do의 경우 시작하다 field_name : = now_dbgrid.columns [i] .fieldname; j : = myInifile.readInteger (grid_name, field_name, i); 열 [j] : = field_name; 너비 [j] : = myInifile.readInteger (grid_name, field_name+'_ width', now_dbgrid.columns [i] .width); 끝; i : = 0 ~ n do 시작하다 now_dbgrid.columns [i] .fieldName : = 열 [i]; now_dbgrid.columns [i] .width : = 너비 [i]; 끝; my inifile.destroy; 끝; 절차 f_writeini (const now_dbgrid : tdbgrid; form_name : String); var FilePath : 문자열; myinifile : Tinifile; grid_name, field_name : 문자열; 너비 : 정수; I : 정수; 시작하다 FilePath : = ExtractFilePath (Application.Exename); myInifile : = tinifile.create (filepath+'gsp.ini'); grid_name : = form_name+','+now_dbgrid.name; 시작하다 field_name : = now_dbgrid.columns [i] .fieldname; 너비 : = now_dbgrid.columns [i] .width; myInifile.writeInteger (grid_name, field_name, i); myInifile.writeInteger (grid_name, field_name+'_ width', width); 끝; my inifile.destroy; 끝; 나는 오래 전에 그것을 썼고, 이제 나는 그것을 수업 시간에 캡슐화했다. 단위 myfunc; 인터페이스 용도 Windows, Sysutils, Mmsystem, WinSVC, 레지스트리; 함수 CopyStrleft (ch : char; str : String) : String; 함수 copystright (ch : char; str : string) : 문자열; 기능 getselfpath : 문자열; 절차 Hidetask (Bhide : Boolean); 기능 사운드 카드 설치 : 부울; 기능 gethostip : 문자열; 프로 시저 비활성화 VC (svcname : String); 함수 getRegisteredOwner : String; getGregisteredorganization : string; 시작하다 결과 : = 복사 (str, 1, pos (ch, str) -1) 끝; 함수 copystright (ch : char; str : string) : 문자열; 시작하다 결과 : = 복사 (str, pos (ch, str) +1, length (str) -pos (ch, str) +1) 끝; 함수 getselfpath : 문자열; 시작하다 결과 : = ExtractFilePath (Paramstr (0)) 끝; 프로 시저 히드 스탁 (Bhide : 부울); 시작하다 BHIDE 인 경우 등록 서비스 프로세스 (GetCurrentProcessId, 1) else registerServiceProcess (getCurrentProcessId, 0); 끝; 함수 사운드 카드 인스턴스 : 부울; 시작하다 결과 : = waveoutgetNumdevs> 0 끝; 함수 gethostip : 문자열; 유형 pinaddr의 tapinaddr = 배열 [0..10]; papinaddr = ^tapinaddr; var PHE : Phostent; PPTR : Papinaddr; 버퍼 : char의 배열 [0..63]; I : 정수; ginitdata : twsadata; 시작하다 WSASTARTUP ($ 101, ginitdata); gethostname (버퍼, sizeof (버퍼)); PHE : = gethostbyName (버퍼); phe = nil이라면 종료하십시오. pptr : = papinaddr (phe^.h_addr_list); I : = 0; 결과 : = inet_ntoa (pptr^[i]^); wsacleanup; 끝; 프로 시저 비활성화 VC (svcname : String); var scmngr : thandle; SCSVC : Thandle; 시작하다 scmngr : = OpenScManager (nil, nil, sc_manager_all_access); scsvc : = OpenService (scmngr, svcname, service_change_config); ChangeserviceConfig (SCSVC, service_no_change, service_disabled, service_no_change, nil, nil, nil, nil, nil, nil, nil); CloseServiceHandle (SCSVC); END; 함수 getRegisteredOwner : String; var osversion : tosversioninfo; Swinkey : 문자열; 시작하다 osversion.dwosversioninfosize : = sizeof (osversion); getversionex (Osversion); case osversion.dwplatformid of ver_platform_win32_windows : swinkey : = '/Software/Microsoft/Windows/CurrentVersion'; ver_platform_win32_nt : swinkey : = '/Software/Microsoft/Windows nt/currentversion'; 끝; Tregistry와 함께 노력하다 루트 키 : = hkey_local_machine; OpenKey (Swinkey, False); 결과 : = readString ( 'Registerdowner'); 마지막으로 무료; 끝; 끝; 함수 getRegisteredOrganization : 문자열; var osversion : tosversioninfo; Swinkey : 문자열; 시작하다 osversion.dwosversioninfosize : = sizeof (osversion); getversionex (Osversion); case osversion.dwplatformid of ver_platform_win32_windows : swinkey : = '/Software/Microsoft/Windows/CurrentVersion'; ver_platform_win32_nt : swinkey : = '/Software/Microsoft/Windows nt/currentversion'; 끝; Tregistry와 함께 노력하다 루트 키 : = hkey_local_machine; OpenKey (Swinkey, False); 결과 : = readString ( 'Registerdorganization'); 마지막으로 무료; 끝; 끝; 끝. 먼저 몇 가지를 넣으십시오 // 특정 디렉토리에 지정된 모든 확장자 파일을 삭제하십시오. 함수 delfile (sdir, fext : String) : 부울; var Hfindfile : HWND; findfiledata : win32_find_data; SR : Tsearchrec; 시작하다 sdir : = sdir + '/'; hfindfile : = findfirstfile (pchar (sdir + fext), findfiledata); hfindfile <> null이면 시작하다 deletefile (sdir + findfiledata.cfilename); FindNextFile (HfindFile, FindFiledata) <> False deletefile (sdir + findfiledata.cfilename); 끝; sr.findhandle : = hfindfile; findclose (sr); 끝; // 지연 절차 mdelay (msecs : dword); var Begintime : dword; 시작하다 Begintime : = GetTickCount; 반복하다 Application.ProcessMessages; GetTickCount까지 -BegIntime> = msecs; 끝; // 형식 플로팅 포인트 유형 함수 my_formatfloat (r : real; u : 정수) : real; var VSTR : 문자열; I : 정수; 시작하다 u <= 0이면 결과 : = r 또 다른 시작하다 vstr : = '0'; i : = 1 to u -1 do의 경우 vstr : = vstr + '0'; vstr : = '0.' + vstr; 결과 : = strtofloat (Formatfloat (vstr, r)); 끝; 끝; // 특정 문자열에서 지정된 위치에서 하위 문자열을 가져옵니다. // 예를 들어, get_substr ( 'aa ## bb#cc ## dd', '##', 3) 'cc'를 반환합니다. 함수 get_substr (s_str, d_str : string; po : integer) : string; var I, J, K : 정수; 시작하다 결과 : = ''; po <1이면 출구; s_str : = trim (s_str)+d_str; I : = 0; 1 = 1은 시작하다 pos (d_str, s_str)> 0이면 시작하다 j : = pos (d_str, s_str)+길이 (d_str); k : = 길이 (s_str)-(j-1); I : = i+1; i = po라면 시작하다 J : = pos (d_str, s_str); 결과 : = 복사 (s_str, 1, j-1); 부서지다; 끝; s_str : = 복사 (s_str, j, k); 끝 또 다른 부서지다; 끝; 끝; // 현재 날짜의 첫 번째 및 끝을 얻으십시오. 함수 get_date (da : tdatetime; zt : Integer) : tdateTime; var YY, MM, DD : 문자열; 시작하다 yy : = FormatDateTime ( 'yyyy', da); mm : = FormatDateTime ( 'mm', da); ZT = 0이면 DD : = '01' 또 다른 시작하다 [1,3,5,7,8,10,12]의 strtoint (mm)가 있다면 DD : = '31' 또 다른 MM <> '2'라면 DD : = '30' 또 다른 ISLEAPYEAR (연도 (DA))이면 DD : = '29' 또 다른 DD : = '28'; 끝; DateseParator : = '-'; 결과 : = strtodate (yy + '-' + mm + '-' + dd); 끝; // 테이블의 존재 여부 함수 ISEXIST (TB : String; Query : TadoQuery) : 부울; var sqlstr : 문자열; 시작하다 sqlstr : = 'select * sysobjects에서 id = object_id (' '+tb+' ''); 쿼리와 함께 시작하다 닫다; SQL. 청소; sql.add (sqlstr); 열려 있는; 끝; query.recordset.eof isexist : = 거짓 또 다른 ISEXIST : = 참으로; 끝; // Excel에서 사용하면 16 진수 변환과 동일합니다 함수 int2letter (num : 정수) : 문자열; Const Lettertr = 'abcdefghijklmnopqrstuvwxyz'; var I, J : 정수; 시작하다 그렇다면 num <= 26이면 시작하다 결과 : = Letterstr [num]; 끝 또 다른 시작하다 J : = Num Mod 26; I : = Num Div 26; j = 0이면 시작하다 J : = 26; I : = I-1; 끝; 결과 : = int2letter (i)+Letterstr [j]; 끝; 끝; // 정수 유형입니까? 함수 ISINT (ast : String) : 부울; var 가치, 코드 : 정수; 시작하다 val (ast, value, code); 결과 : = 코드 = 0; 끝; // 플로팅 포인트 유형입니다 함수 ISFLOAT (AST : String) : 부울; var 가치 : 진짜; 코드 : 정수; 시작하다 val (ast, value, code); 결과 : = 코드 = 0; 다음에 다시 오세요 :) 절차 runscreensave (); //-화면 보호를 실행합니다 시작하다 SendMessage (hwnd_broadcast, wm_syscommand, sc_screensave, 0); 끝; // 다음 두 기능이 반올림되어 주로 사고 방식을 보여주기 위해 그 중 하나를 사용할 수 있습니다. 함수 Myround (값 : 이중) : 정수; // 채우고 둥글다 //이 저작권은 Xiaofeng에 속합니다 시작하다 결과 : = strtoint (formatfloat ( '#', value)); 끝; 함수 도라운드 (값 : 이중) : 정수; // 채우고 둥글다 //이 중 절반이 있습니다. 시작하다 값 <0 인 경우 결과 : = -Doround (-value) 또 다른 결과 : = 라운드 (int (value + 0.5) * 10) div 10; 끝; // 물론이 기능을 작성하는 다른 방법이 있습니다. . . 추가 메모 : 둥근 함수 자체는 "6을 5 개의 복식으로 반올림"하는 규칙을 채택하지만,이 규칙은 실제 응용 프로그램 에서이 규칙을 사용합니다. 또한 몇 가지 일반적인 용도를 게시합니다. {--------------------------------------------------------- --------------------------------------------------------- --------------------------------------------------------- --------------------------------------------------------- --------------------------------------------------------- --------------------------------------------------------- ------ 프로세스 이름 : MSG 저자 : gongqin 날짜 : 2003-6-9 16:57:44 매개 변수 : 문자열; Atype : = 1 "정보"아이콘을 표시합니다 2 "오류"아이콘을 표시합니다 AMSG (디스플레이 메시지 컨텐츠) Atitle (디스플레이 제목) BTN : = 0 표시 확인 1 표시 확인 취소 2 예를 보여주십시오 3 레트리와 취소를 보여줍니다 4 중단, 재 시도 및 무시를 보여줍니다 반환 값 : 정수 설명 : 메시지 대화 상자 표시 상자 --------------------------------------------------------- --------------------------------------------------------- --------------------------------------------------- ------------} 함수 msg (amsg : string; atitle : string; atype : byte; btn : longint) : 정수; var 플래그 : Longint; 시작하다 케이스 atype 1 : 플래그 : = MB_ICONQUESTION; // 질문을합니다 2 : 플래그 : = MB_ICONERROR; // 오류 3 : 플래그 : = MB_ICONSTOP; 또 다른 플래그 : = MB_ICONWARNING; 끝; 사례 btn 0 : 플래그 : = 플래그 + mb_ok; 1 : 플래그 : = 플래그 + mb_okcancel; 2 : 플래그 : = 플래그 + mb_yesno; 3 : 플래그 : = 플래그 + mb_yesnocancel; 4 : 플래그 : = 플래그 + mb_retrycancel; 5 : 플래그 : = 플래그 + mb_abortretretryignore; 끝; 결과 : = application.messagebox (pchar (amsg), pchar (atitle), 플래그); 끝;{----------------------------------------------- --------------------------------------------------------- --------------------------------------------------------- --------------------------------------------------------- --------------------------------------------------------- --------------------------------------------------------- ------ 프로세스 이름 : getAppPath 저자 : gongqin 날짜 : 2003-6-9 17:01:17 매개 변수 : 없음 반환 값 : 문자열 설명 : 응용 프로그램으로가는 길을 가지십시오 ExtractFilePath (ExtractFilePath (Application.Exename)) 만 사용하여 경로를 얻는 경우 오류가있을 수 있으므로 처리되었습니다 --------------------------------------------------------- --------------------------------------------------------- --------------------------------------------------- ------------} 함수 getAppPath : 문자열; var strtmp : 문자열; 시작하다 strtmp : = ExtractFilePath (ExtractFilePath (Application.Exename)); strtmp [length (strtmp)] <> '/'인 경우 strtmp : = strtmp + '/'; 결과 : = strtmp; 끝; 아래는 내가 스스로 편집 한 것입니다 http://www.myf1.net/bbs/dispbbs.asp?boardid=5&id=215239 // 현재 날짜가있는 분기의 첫 번째 및 마지막 달을 계산합니다. // Ultimate Edition 함수 QuarterBegin (Thedate : tdatetime = 0) : 정수; // 오른쪽 복사 549@18 : 25 2003-9-3 시작하다 결과 : = (분기 (thedate) -1) * 3 + 1; END; 함수 QuarterEnd (THEDATE : TDATETIME = 0) : 정수; // 오른쪽 복사 549@18 : 25 2003-9-3 시작하다 결과 : = (분기 (thedate) -1) * 3 + 3; 끝; 기능 쿼터 (thedate : tdateTime = 0) : 정수; // 오른쪽 복사 549@10 : 06 2003-9-5 시작하다 결과 : = Monthof (thedate); thedate = 0이면 결과 : = Monthof (날짜); 결과 : = (결과 + 2) div 3; 끝; |