| function GetKbStatus():string; //Return to the current keyboard status, including NumLoce, Caps Lock, Insert //Each status information occupies two characters, in the order: NumLoce, Caps Lock, Insert //Copy Right 549@11:29 2003-7-22 var Status:string; KeyStates:TKeyboardState; Begin GetKeyboardState(KeyStates); if Odd(KeyStates[VK_NUMLOCK])then Status:='number' else Status:='cursor'; if Odd(KeyStates[VK_CAPITAL]) then Status:=status+'caps' else Status:=status+'lowercase'; if Odd(KeyStates[VK_INSERT]) then Status:=status+'insert' else Status:=status+'rewrite'; Results:=Status; end; tips: const ErrHead='The error occurred in the operation, the error message is: '+#13 try ... except on E: Exception do showmessage(ErrHead+E.Message+#13+'The current operation is: xxxxx'); end; It allows users to see more error messages, which helps customers feedback program errors. I write a good idea, but I often use it: //>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> //Execute Sql //Input parameters: SqlString, ADOQuery //Type: string, TADOQuery PRocedure TMainForm.ExeSql(SqlString: string; ADOQuery: TADOQuery); Begin with ADOQuery do Begin Connection := DM.DBAccinfo;//This is mine, you can add the connection // Or use it. If Active then Active := False; Open; SQL.Clear; SQL.Add(SqlString); ExecSQL; Close; end; end; Maybe everyone knows this. However, in the code I have seen, it seems that few people write such an independent process. This is guaranteed to be original by myself... //Open Adoquery //Adapted from the process of reallike (Aixiang (only lizzy can be told that others cannot)) //Support multi-line sql //You can modify it as needed to only support single-line SQL procedures, or exesql procedures //The test under Delphi6 passed. procedure OpenSql(SqlString: tstrings; ADOQuery: TADOQuery); var i:integer; Begin with ADOQuery do Begin Close; SQL.Clear; for i:=0 to sqlstring.Count-1 do SQL.Add(SqlString[i]); try Open; except on e:exception do showmessage('Error: The message is as follows'+#13+e.Message); end; end; end; This is a single line of SQL procedure OpenSql1(SqlString: string; ADOQuery: TADOQuery); Begin with ADOQuery do Begin Close; SQL.Clear; SQL.Add(SqlString); try Open; except on e:exception do showmessage('Error: The message is as follows'+#13+e.Message); end; end; end; Hoho, thank you for helping me fix this thing. But don't you use Execsql? I usually add try outside this process, that is, where he is quoted. That is Try Exesql(sqlstring, Adoquery1) except //Error prompt, messy stuff. end to: reallike (Aixiang (only lizzy can be told that others cannot)) I did ExecSql too //ExecSql Adoquery //Support multi-line sql //You can modify it yourself as needed to only support single-line SQL procedures, or exesql procedures //The test under Delphi6 passed. procedure ExeSql(SqlString: tstrings; ADOQuery: TADOQuery); var i:integer; Begin with ADOQuery do begin Close; SQL.Clear; for i:=0 to sqlstring.Count-1 do SQL.Add(SqlString[i]); try ExecSql; except on e:exception do showmessage('Error: The message is as follows'+#13+e.Message); end; end; end; //I think it's the same where except is placed, it's better to put it outside because, you can add some other debugging information //What do you think? //Is anyone combined the two processes of executing a single line and executing multiple lines into one, that would be great. I'll do two more, and I can add and delete them according to my needs, but I'm using DBGridEh to dynamically create Col procedure BuildCol(vFieldName: string; vCaption: string; vWidth: Integer; var vGrid: TDBGridEh; iTag: Integer = 0; FooterType: TFooterValueType = fvtNon; FooterText: string = ''; boolReadOnly: Boolean = True; vColor: TColor = clBtnFace); var cCol: TDBGridColumnEh; cFooterCol: TColumnFooterEh; Begin 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; //If the tag value is -1, the column will not be printed when printing dbgrid cCol.Tag := iTag; if FooterType <> fvtNon then Begin cFooterCol := cCol.Footers.Add; cFooterCol.ValueType := FooterType; if FooterType = fvtStaticText then Begin vGrid.FooterRowCount := 1; cFooterCol.Value := FooterText; end; //cCol.Footer.FieldName:=; end; end;procedure TitleBtnClick(Sender: TObject; ACol: Integer; Column: TColumnEh; cdsHelper: TClientDataSetHelper); var cdsTmp: TClientDataSet; Begin with (Sender as TDBGridEh) do Begin cdsTmp := (DataSource.DataSet as TClientDataSet); if not cdsTmp.Active then Exit; //Set the sorting method of the current row if Column.Title.SortMarker = smNoneEh then Begin Column.Title.SortMarker := smUpEh; cdsHelper.SortByField(Column.FieldName, soAscending); end else if Column.Title.SortMarker = smUpEh then Begin Column.Title.SortMarker := smDownEh; cdsHelper.SortByField(Column.FieldName, soDescending); end else Begin Column.Title.SortMarker := smNoneEh; cdsHelper.SortByField(Column.FieldName, soNoSort); end; end; end; a function that records the positions and widths of each column in DBGrid into the Ini file, and reads the positions and widths of each column in DBGrid from the Ini file procedure f_ReadIni(const Now_DBGrid:TDBGrid;Form_Name:String); var FilePath:String; MyIniFile:Tinifile; Grid_Name,Field_Name:String; Width:integer; i,j,n:integer; Column:Array[0..100] of String; Widths:Array[0..100] of integer; Begin FilePath := ExtractFilePath(application.ExeName); MyIniFile:=TiniFile.Create(FilePath+'gsp.ini'); Grid_Name :=Form_Name+','+Now_DBGrid.Name; n:= Now_DBGrid.Columns.Count-1 ; for i:=0 to 100 do column[i]:=''; for i:=0 to n do Begin Field_Name:=Now_DBGrid.Columns[i].FieldName; j:=MyIniFile.ReadInteger(Grid_Name,Field_Name,i); Column[j]:=Field_Name; Widths[j] :=MyIniFile.ReadInteger(Grid_Name,Field_Name+'_Width',Now_DBGrid.Columns[i].Width); end; for i:=0 to n do Begin Now_DBGrid.Columns[i].FieldName := Column[i]; Now_DBGrid.Columns[i].Width := Widths[i]; end; MyIniFile.Destroy; end;procedure f_WriteIni(const Now_DBGrid:TDBGrid;Form_Name:String); var FilePath:String; MyIniFile:Tinifile; Grid_Name,Field_Name:String; Width:Integer; i:integer; Begin FilePath := ExtractFilePath(Application.ExeName); MyIniFile:=TiniFile.Create(FilePath+'gsp.ini'); Grid_Name :=Form_Name+','+Now_DBGrid.Name; for i:=0 to Now_DBGrid.Columns.Count-1 do Begin Field_Name := Now_DBGrid.Columns[i].FieldName; Width := Now_DBGrid.Columns[i].Width; MyIniFile.WriteInteger(Grid_Name,Field_Name,i); MyIniFile.WriteInteger(Grid_Name,Field_Name+'_Width',Width); end; MyIniFile.Destroy; end; I wrote it a long time ago, and now I have encapsulated it in class. unit MyFunc;interface uses Windows, SysUtils, MMSystem, WinSvc, Registry;function CopyStrLeft(ch: Char; str: string): string; function CopyStrRight(ch: Char; str: string): string; function GetSelfPath: string; procedure HideTask(bHide: Boolean); function SoundCardInstalled: Boolean; function GetHostip: String; procedure DisableSvc(SvcName: string); function GetRegisteredOwner: string; function GetRegisteredOrganization: string; implementationfunction RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL'; function CopyStrLeft(ch: Char; str: string): string; Begin Results:= Copy(str, 1, Pos(ch, str)-1) end;function CopyStrRight(ch: Char; str: string): string; Begin Results:= Copy(str, Pos(ch, str)+1, Length(str)-Pos(Ch, str)+1) end;function GetSelfPath: string; Begin Result:= ExtractFilePath(ParamStr(0)) end;procedure HideTask(bHide: Boolean); Begin if bHide then RegisterServiceProcess(GetCurrentProcessID, 1) else RegisterServiceProcess(GetCurrentProcessID, 0); end;function SoundCardInstalled: Boolean; Begin Result:= WaveOutGetNumDevs >0 end;function GetHostIP: String; type TaPInAddr = Array[0..10] of PInAddr; PaPInAddr = ^TaPInAddr; var phe: PHostEnt; PPTr: PaPInAddr; Buffer: Array[0..63] of Char; I: Integer; GInitData: TWSAData; Begin WSAStartup($101,GInitData); GetHostName(Buffer,SizeOf(Buffer)); phe:= GetHostByName(buffer); if phe = nil then Exit; pPtr:= PaPInAddr(phe^.h_addr_list); I:= 0; Result:=inet_ntoa(pptr^[I]^); WSACleanup; end;procedure DisableSvc(SvcName: string); var scMngr: THandle; scSvc: THandle; Begin 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;function GetRegisteredOwner: string; var OSVersion: TOSVersionInfo; sWinKey: string; Begin 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'; end; with TRegistry.Create do try RootKey := HKEY_LOCAL_MACHINE; OpenKey(sWinKey, False); Result := ReadString('RegisteredOwner'); Finally Free; end; end;function GetRegisteredOrganization: string; var OSVersion: TOSVersionInfo; sWinKey: string; Begin 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'; end; with TRegistry.Create do try RootKey := HKEY_LOCAL_MACHINE; OpenKey(sWinKey, False); Result := ReadString('RegisteredOrganization'); Finally Free; end; end; end. Put a few first //Delete all the specified extension files in a certain directory function DelFile(sDir,fExt: string): Boolean; var hFindFile: HWND; FindFileData: WIN32_FIND_DATA; sr: TSearchRec; Begin sDir:= sDir + '/'; hFindFile:= FindFirstFile(pchar(sDir + fExt), FindFileData); if hFindFile <> NULL then Begin deletefile(sDir + FindFileData.cFileName); while FindNextFile(hFindFile, FindFileData) <> FALSE do deletefile(sDir + FindFileData.cFileName); end; sr.FindHandle:= hFindFile; FindClose(sr); end;//Delay procedure mDelay(MSecs: DWord); var BeginTime: DWORD; Begin BeginTime := GetTickCount; repeat Application.ProcessMessages; until GetTickCount - BeginTime >= MSecs; end;//Format floating point type function my_FormatFloat(r: Real; u: Integer): Real; var vStr : String; I : Integer; Begin if u <= 0 then Results := r else Begin vStr := '0'; for I := 1 to u - 1 do vStr := vStr + '0'; vStr := '0.' + vStr; Result := StrToFloat(FormatFloat(vStr, r)); end; end;//Get the substring at the specified position in a certain string //For example, get_substr('aa##bb#cc##dd','##',3) returns 'cc' function get_substr(s_str,d_str:string;po:integer):string; //s_str large string, d_str separator, po position var i,j,k:integer; Begin result:=''; if po<1 then exit; s_str:=trim(s_str)+d_str; i:=0; while 1=1 do Begin if pos(d_str,s_str)>0 then Begin j:=pos(d_str,s_str)+length(d_str); k:=length(s_str)-(j-1); i:=i+1; if i=po then Begin j:=pos(d_str,s_str); result:=copy(s_str,1,j-1); break; end; s_str:=copy(s_str,j,k); end else break; end; end;//Get the first and end of the month of the current date function get_date(da:TDateTime;zt:integer):TDateTime; var yy,mm,dd:string; Begin yy:=formatdatetime('yyyy',da); mm:=formatdatetime('mm',da); if zt=0 then dd:='01' else Begin if strtoint(mm) in [1,3,5,7,8,10,12] then dd := '31' else if mm <> '2' then dd:='30' else if IsLeapYear(YearOf(Da)) then dd:='29' else dd:='28'; end; DateSeparator := '-'; result:=strtodate(yy + '-' + mm +'-' + dd); end;//The existence or not of the table function IsExist(tb:String;query:TADOQuery):Boolean; var sqlstr:String; Begin sqlstr:='select * from sysobjects where id=object_id(''+tb+''')'; with query do Begin close; sql.Clear; sql.Add(sqlstr); open; end; if query.Recordset.EOF then IsExist:=False else IsExist:=True; end;//Use in Excel, it is equivalent to hexadecimal conversion function int2letter(num:integer):string; const LetterStr='ABCDEFGHIJKLMNOPQRSTUVWXYZ'; var i,j:integer; Begin if num<=26 then Begin result:=LetterStr[num]; end else Begin j:=num mod 26; i:=num div 26; if j=0 then Begin j:=26; i:=i-1; end; result:=int2letter(i)+LetterStr[j]; end; end;//Is it integer type function IsInt(ASt: string): Boolean; var Value, Code: Integer; Begin Val(AStr, Value, Code); Result := Code = 0; end; //Is it floating point type function IsFloat(AStr: string): Boolean; var Value: Real; Code: Integer; Begin Val(AStr, Value, Code); Result := Code = 0; end; come again next time:) procedure RunScreenSave(); //--Run screen protection Begin SendMessage(HWND_BROADCAST, WM_SYSCOMMAND, SC_SCREENSAVE, 0); end; //The following two functions are rounded, mainly to show a way of thinking, you can use any one of them function MyRound(Value: Double): integer; //Fill and round //This copyright belongs to Xiaofeng Begin result:= strtoint(FormatFloat('#',value)); end;function doRound(Value: Double): integer; //Fill and round //I have half of this, haha. Begin if Value < 0 then Results:= - doRound( -Value ) else Result := round(int((value + 0.5) * 10)) div 10; end; //Of course, there are other ways to write this function. If you have different ideas, please continue. . . Additional Notes: The round function itself adopts the rule of "rounding six into five doubles". Although it is more scientific, few of them use this rule in actual applications. I also post a few of my common uses: {------------------------------------------------- ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Process name: Msg Author: Gongqin Date: 2003-6-9 16:57:44 Parameters: AMsg : String; ATitle : String='tip'; AType : byte=0; btn : Longint=0 AType := 1 Display the "Information" icon 2 Display the "Error" icon AMsg (display message content) ATitle (display title) btn := 0 Show OK 1 Show Ok Cancel 2 Show Yes No 3 Show Retry and Cancel 4 Show Abort, Retry, and Ignore Return value: Integer Description: Display message dialog box -------------------------------------------------------------------------------------------------------------------------------- ------------------------------------} function Msg(AMsg: String;ATitle: String;AType: byte;btn: Longint): Integer; var Flag : Longint; Begin case AType of 1: Flag := MB_ICONQUESTION; // Ask a question 2: Flag := MB_ICONERROR; //Error 3: Flag := MB_ICONSTOP; //Stop else Flag := MB_ICONWARNING; end; case btn of 0 : Flag := Flag + MB_OK; 1: Flag := Flag + MB_OKCANCEL; 2: Flag := Flag + MB_YESNO; 3: Flag := Flag + MB_YESNOCANCEL; 4: Flag := Flag + MB_RETRYCANCEL; 5: Flag := Flag + MB_ABORTRETRYIGNORE; end; result := Application.MessageBox(pchar(AMsg), pchar(ATitle), Flag); end;{----------------------------------------------- ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Process name: getAppPath Author: Gongqin Date: 2003-6-9 17:01:17 Parameters: None Return value: string Description: Take the path to the application If you only use ExtractFilePath(ExtractFilePath(application.Exename)) to get the path There may be an error, so it was processed -------------------------------------------------------------------------------------------------------------------------------- ------------------------------------} function getAppPath : string; var strTmp : string; Begin strTmp := ExtractFilePath(ExtractFilePath(application.Exename)); if strTmp[length(strTmp)] <> '/' then strTmp := strTmp + '/'; result := strTmp; end; Below is what I have compiled myself http://www.myf1.net/bbs/dispbbs.asp?boardID=5&ID=215239 // Calculate the first and last month of the quarter where the current date is located //Ultimate Edition function QuarterBegin( TheDate : TDateTime = 0 ) : Integer; //Copy Right 549@18:25 2003-9-3 Begin Result := ( Quarter( TheDate ) - 1 ) * 3 + 1; end;function QuarterEnd( TheDate : TDateTime = 0 ) : Integer; //Copy Right 549@18:25 2003-9-3 Begin Result := ( Quarter( TheDate ) - 1 ) * 3 + 3; end;function Quarter( TheDate : TDateTime = 0 ) : Integer; //Copy Right 549@10:06 2003-9-5 Begin Result := MonthOf( TheDate ); if TheDate = 0 then Result := MonthOf( Date ); Result := (Result + 2 ) div 3; end; | 