| 関数getkbstatus（）：string; // numloce、キャップロック、挿入など、現在のキーボードステータスに戻る //各ステータス情報は、2つの文字を占有します。Numloce、Caps Lock、挿入 //右549@11：29 2003-7-22をコピーします varステータス：文字列; KeyStates：tkeyboardState; 始める getKeyBoardState（keyStates）; ODD（keyStates [vk_numlock]）の場合 ステータス：= '番号' それ以外 ステータス：= 'cursor'; ODD（keystates [vk_capital]）の場合 ステータス：=ステータス+「キャップ」 それ以外 ステータス：=ステータス+「低ケース」; ODD（keystates [vk_insert]）の場合 ステータス：=ステータス+「挿入」 それ以外 ステータス：= status+'write'; 結果：=ステータス; 終了： const errhead = '操作でエラーが発生し、エラーメッセージは次のとおりです。 試す ... を除外する on：例外Do ShowMessage（errhead+e.message+＃13+'現在の操作はxxxxx'）; 終わり; ユーザーはより多くのエラーメッセージを表示できるため、顧客がプログラムのエラーをフィードバックするのに役立ちます。私は良い考えを書きますが、よく使用します：// >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>> // sqlを実行します //入力パラメーター：SQLSTRING、養食器 //タイプ：文字列、タドキュリー 手順tmainform.exesql（sqlstring：string;養食器：タドキュリー）; 始める 養食器でやる 始める 接続：= dm.dbaccinfo; //これは私のものです、接続を追加できます //またはそれを使用します。 アクティブな場合 アクティブ：= false; 開ける; sql.clear; sql.add（sqlstring）; execsql; 近い; 終わり; たぶん誰もがこれを知っています。しかし、私が見たコードでは、そのような独立したプロセスを書く人はほとんどいないようです。これは自分でオリジナルであることが保証されています... //肥満を開きます //リアルのようなプロセスから適応しました（aixiang（リジーだけが他の人ができないと言われることができます）） //マルチラインSQLをサポートします //必要に応じて自分で修正して、シングルラインのSQL手順のみをサポートするか、exeSQL手順 // Delphi6の下のテストが合格しました。 手順opensql（sqlstring：tstrings;養食器：タドキュリー）; var i：整数; 始める 養食器でやる 始める 近い; sql.clear; i：= 0からsqlstring.count-1 do sql.add（sqlstring [i]）; 試す 開ける; を除外する on：例外DO showmessage（ 'エラー：メッセージは次のとおりです'+＃13+e.message）; 終わり; 終わり; 終わり; これはSQLの単一行です 手順opensql1（sqlstring：string;養食器：タドキュリー）; 始める 養食器でやる 始める 近い; sql.clear; sql.add（sqlstring）; 試す 開ける; を除外する on：例外DO showmessage（ 'エラー：メッセージは次のとおりです'+＃13+e.message）; 終わり; 終わり; 終わり; Hoho、このことを修正してくれてありがとう。しかし、execsqlを使用しませんか？私は通常、このプロセス、つまり彼が引用されている場所の外に試してみることを追加します。それは試してみてください exesql（sqlstring、adoquery1） を除外する //エラープロンプト、乱雑なもの。 終わり 宛先：Reallike（aixiang（リジーだけが他の人ができないと言うことができる）） 私もexecSQLをしました // execsql養食器 //マルチラインSQLをサポートします //必要に応じて自分で修正して、シングルラインのSQL手順のみをサポートするか、exeSQL手順 // Delphi6の下のテストが合格しました。 手順ExeSQL（SQLSTRING：TSTRINGS; AUDQUERY：TADOQUERY）; var i：整数; 始める 養食器から始まります 近い; sql.clear; i：= 0からsqlstring.count-1 do sql.add（sqlstring [i]）; 試す execsql; を除外する on：例外DO showmessage（ 'エラー：メッセージは次のとおりです'+＃13+e.message）; 終わり; 終わり; 終わり; //配置されていることを除いて同じだと思います。他のデバッグ情報を追加できるので、外に置く方が良いと思います //どう思いますか？ //誰もが1つの行を実行して複数の行を1つに実行する2つのプロセスを組み合わせたものですが、それは素晴らしいことです。 私はさらに2つのことをします、そして私は私のニーズに応じてそれらを追加して削除することができますが、私はdbgridehを使用してcolを動的に作成します 手順BuildCol（vfieldName：string; vcaption：string; vwidth：integer; var vgrid：tdbgrideh：integer = 0; footertype：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：= footertype; footertype = fvtstatictextの場合 始める vgrid.footerrowcount：= 1; cfootercol.value：= footertext; 終わり; //ccol.footer.fieldname:=; 終わり; end; procedure titlebtnclick（sender：tobject; acol：integer; 列：tcolumneh; var CDSTMP：TCLIENTDATASET; 始める （tdbgridehのように送信者）を使用します 始める cdstmp：=（datasource.dataset as tclientdataset）; 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：string; 幅：整数; 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; widths [j]：= myinifile.readinteger（grid_name、field_name+'_ width'、now_dbgrid.columns [i] .width）; end; = 0からn do 始める 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：文字列; myinifile：Tinifile; grid_name、field_name：string; 幅：整数; 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; width：= now_dbgrid.columns [i] .width; myinifile.writeinteger（grid_name、field_name、i）; myinifile.writeinteger（grid_name、field_name+'_ width'、width）; End MyInifile.Destroy; 私はずっと前にそれを書きました、そして今私はそれをクラスでカプセル化しました。 ユニットmyfunc;インターフェイス 用途 Windows、sysutils、mmsystem、winsvc、registry; function copystreft（ch：char; str：string）：string; 関数Copystright（Ch：char; str：string）：string; 関数get selfpath：string; 手順Hidetask（Bhide：boolean）; function soundcardinstalled：boolean; 関数gethostip：文字列; 手順DisableSvc（svcname：string）; 関数getregisteredowner：string; function registeredorination：string registerserviceprocess（dwtyper：integer） 始める 結果：= copy（str、1、pos（ch、str）-1） end; function copystright（ch：char; str：string）：string; 始める 結果：= copy（str、pos（ch、str）+1、length（str）-pos（ch、str）+1） end; function get selfpath：string; 始める 結果：= extractfilepath（paramstr（0）） end; procedure hidetask（bhide：boolean）; 始める Bhideの場合、registerServiceProcess（getCurrentProcessid、1） else RegisterServiceProcess（getCurrentProcessid、0）; end; function soundcardinstalled：boolean; 始める 結果：= waveoutgetnumdevs> 0 end; function gethostip：string; タイプ pinaddrのtapinaddr = array [0..10]; papinaddr = ^tapinaddr; var Phe：Phostent; PPTR：Papinaddr; バッファ：charの配列[0..63]。 I：整数; Ginitdata：Twsadata; 始める wsastartup（$ 101、ginitdata）; gethostname（buffer、sizeof（buffer））; phe：= gethostbyname（buffer）; phe = nilの場合、終了します。 pptr：= papinaddr（phe^.h_addr_list）; i：= 0; 結果：= inet_ntoa（pptr^[i]^）; wsacleanup; end; procedure disableSvc（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; function 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.create do 試す rootkey：= hkey_local_machine; OpenKey（Swinkey、False）; 結果：= ReadString（ 'RegisteredOwner'）; ついに 無料; 終わり; end; function getregisteredorganization：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.create do 試す rootkey：= hkey_local_machine; OpenKey（Swinkey、False）; 結果：= readString（ 'Registeredorganization'）; ついに 無料; 終わり; 終わり; 終わり。 いくつかの最初に//特定のディレクトリ内のすべての指定された拡張機能ファイルを削除します function delfile（sdir、fext：string）：boolean; 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 do deletefile（sdir + findfiledata.cfilename）; 終わり; sr.findhandle：= hfindfile; findclose（sr）; 終了; //遅延 手順mdelay（msecs：dword）; var begintime：dword; 始める begintime：= getTickCount; 繰り返す application.processmessages; getTickCount -begintime> = msecs; End; // Formatフローティングポイントタイプ function my_formatfloat（r：real; u：integer）：real; var VSTR：文字列; I：整数; 始める u <= 0の場合 結果：= r それ以外 始める VSTR：= '0'; i：= 1からu -1 do VSTR：= VSTR + '0'; VSTR：= '0。 結果：= strtofloat（formatfloat（vstr、r））; 終わり; 終了; //特定の文字列の指定された位置でサブストリングを取得します //たとえば、get_substr（ 'aa ## bb＃cc ## dd'、 '##'、3） 'cc'を返します function 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）+length（d_str）; k：= length（s_str） - （j-1）; i：= i+1; i = poの場合 始める j：= pos（d_str、s_str）; 結果：= copy（s_str、1、j-1）; 壊す; 終わり; s_str：= copy（s_str、j、k）; 終わり それ以外 壊す; 終わり; 終了; //現在の日付の最初と終了を取得します function 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（yearof（da））の場合 DD：= '29' それ以外 DD：= '28'; 終わり; dateseparator：= ' - '; 結果：= strtodate（yy + ' - ' + mm + ' - ' + dd）; 終了; //テーブルの存在かどうか 関数ISEXIST（TB：String; Query：Tadoquery）：Boolean; var SQLSTR：文字列; 始める sqlstr：= 'select * from sysobjects where id = object_id（' '+tb+' ''） '; クエリで 始める 近い; sql.clear; sql.add（sqlstr）; 開ける; 終わり; query.recordset.eofの場合 isexist：= false それ以外 isexist：= true; 終了; // Excelで使用すると、16進変換に相当します function int2letter（num：integer）：string; const letterstr = '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]; 終わり; 終了; //整数型です function isint（ast：string）：boolean; var 値、コード：整数; 始める val（astr、value、code）; 結果：= code = 0; 終わり; //フローティングポイントタイプですか 関数isfloat（astr：string）：boolean; var 値：リアル; コード：整数; 始める val（astr、value、code）; 結果：= code = 0; 次回も再び来る:) 手順runcreensave（）; //-画面保護を実行します 始める sendMessage（hwnd_broadcast、wm_syscommand、sc_screensave、0）; 終わり; //次の2つの関数は丸みを帯びており、主に考え方を示すために、それらのいずれかを使用できます function myround（value：double）：integer; //塗りつぶしと丸い //この著作権はXiaofengに属します 始める 結果：= strtoint（formatfloat（ '＃'、value））; end; function doround（value：double）：integer; //塗りつぶしと丸い //私はこれの半分を持っています、ハハ。 始める 値<0の場合、結果：= -doround（-value） それ以外 結果：= round（int（（value + 0.5） * 10））div 10; 終わり; //もちろん、この機能を書く他の方法があります。 。 。追加のメモ： ラウンド関数自体は、「6つのダブルに丸めている」というルールを採用していますが、実際のアプリケーションでこのルールを使用するものはほとんどありません。 また、私の一般的な用途のいくつかを投稿します： {----------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------- ------ プロセス名：MSG 著者：Gongqin 日付：2003-6-9 16:57:44 パラメーター：atitle：string = 'tipe：byte = 0; atype：= 1「情報」アイコンを表示します 2「エラー」アイコンを表示します AMSG（表示メッセージコンテンツ）atitle（ディスプレイタイトル） btn：= 0 show ok 1 show okキャンセル 2はいいいえを表示します 3再試行を表示してキャンセルします 4中断、再試行、無視を表示します 返品値：整数 説明：[メッセージ]ダイアログボックスを表示します -------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------- ------------} 関数msg（amsg：string; atitle：string; atype：byte; btn：longint）：integer; var flag：longint; 始める のケースアタイプ 1：flag：= mb_iconquestion; //尋ねます 2：flag：= mb_iconerror; //エラー 3：flag：= MB_ICONSTOP; それ以外 フラグ：= MB_ICONWARNING; 終わり; のケースbtn 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; 終わり; 結果：= application.messagebox（pchar（amsg）、pchar（atitle）、flag）; 終わり;{ - - - - - - - - - - - - - - - - - - - - - - - - -------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------- ------ プロセス名：GetAppPath 著者：Gongqin 日付：2003-6-9 17:01:17 パラメーター：なし 戻り値：文字列 説明：アプリケーションへのパスを取ります extractfilepath（extractfilepath（application.exename））のみを使用してパスを取得する場合 エラーがある可能性があるため、処理されました -------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------- ------------} 関数getApppath：string; var strtmp：string; 始める strtmp：= extractfilepath（extractfilepath（application.exename））; strtmp [length（strtmp）] <> '/' thenの場合 strtmp：= strtmp + '/'; 結果：= strtmp; 終わり; 以下は私が自分自身をまとめたものです http://www.myf1.net/bbs/dispbbs.asp?boardid=5&id=215239 //現在の日付がある四半期の最初と最後の月を計算します //究極のエディション function QuarterBegin（thedate：tdateTime = 0）：整数; //右549@18：25 2003-9-3をコピーします 始める 結果：=（Quarter（thedate）-1） * 3 + 1; end; function quarterend（thedate：tdatetime = 0）：整数; //右549@18：25 2003-9-3をコピーします 始める 結果：=（Quarter（thedate）-1） * 3 + 3; end; function quarter（thedate：tdatetime = 0）：整数; //右549@10：06 2003-9-5をコピーします 始める 結果：= monthof（thedate）; thedate = 0の場合、結果：= monthof（date）; 結果：=（結果 + 2）div 3; 終わり; | 