| fonction getkbstatus (): string; // retour à l'état du clavier actuel, y compris numloce, verrouillage de caps, insérer // chaque information d'état occupe deux caractères, dans l'ordre: numloce, verrouillage des bouchons, insérer // Copier à droite 549 @ 11: 29 2003-7-22 statut var: chaîne; Mistes de clé: TkeyboardState; Commencer GetKeyBoardState (clés); Si étrange (clés [vk_numlock]) alors Statut: = 'nombre' autre Statut: = 'curseur'; Si étrange (états clés [vk_capital]) alors Statut: = Statut + 'Caps' autre Statut: = Status + «minuscules»; Si étrange (états clés [vk_insert]) alors Statut: = statut + 'insert' autre Status: = statut + 'réécriture'; Résultats: = statut; fin; const errhead = 'L'erreur s'est produite dans l'opération, le message d'erreur est:' + # 13 essayer ... sauf sur e: exception do showMessage (errhead + e.Message + # 13 + 'L'opération actuelle est: xxxxx'); fin; Il permet aux utilisateurs de voir plus de messages d'erreur, ce qui aide les erreurs de programme de rétroaction aux clients. J'écris une bonne idée, mais je l'utilise souvent: // >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>> // Exécuter SQL // Paramètres d'entrée: SQLString, Adodery // Type: chaîne, tadoquière Procédure tmainform.exesql (sqlString: String; Adoliery: Tadoquery); Commencer avec Adoquery faire Commencer Connexion: = dm.dbaccinfo; // c'est à moi, vous pouvez ajouter la connexion // ou l'utiliser. Si actif alors Actif: = false; Ouvrir; Sql.clear; Sql.add (sqlstring); Execsql; Fermer; fin; fin; peut-être que tout le monde le sait. Cependant, dans le code que j'ai vu, il semble que peu de gens écrivent un processus aussi indépendant. C'est garanti d'être original par moi-même ... // Ouvrez Adoquery // adapté du processus de réel (Aixiang (seul Lizzy peut être informé que les autres ne peuvent pas))) // Prise en charge de SQL multi-lignes // Vous pouvez le modifier vous-même selon les besoins pour prendre en charge uniquement les procédures SQL d'une seule ligne ou les procédures EXESQL // Le test sous Delphi6 est passé. Procédure OpenSQL (SQLString: TStrings; Adodery: Tadoquery); var i: entier; Commencer avec Adoquery faire Commencer Fermer; Sql.clear; pour i: = 0 à sqlstring.count-1 do Sql.add (sqlString [i]); essayer Ouvrir; sauf sur e: exception do showMessage ('error: le message est le suivant' + # 13 + e.Message); fin; fin; fin; Ceci est une seule ligne de SQL Procédure OpenSQL1 (SQLString: String; Adoliery: Tadoquery); Commencer avec Adoquery faire Commencer Fermer; Sql.clear; Sql.add (sqlstring); essayer Ouvrir; sauf sur e: exception do showMessage ('error: le message est le suivant' + # 13 + e.Message); fin; fin; fin; Hoho, merci de m'avoir aidé à réparer cette chose. Mais n'utilisez-vous pas EXECSQL? J'ajoute généralement un essai en dehors de ce processus, c'est-à-dire où il est cité. C'est d'essayer Exesql (SQLString, Adoquery1) sauf // Invite d'erreur, trucs désordonnés. fin à: Reallike (Aixiang (seule Lizzy peut être informée que les autres ne peuvent pas)) J'ai aussi fait Execsql // EXECSQL ADOQUERY // Prise en charge de SQL multi-lignes // Vous pouvez le modifier vous-même selon les besoins pour prendre en charge uniquement les procédures SQL d'une seule ligne ou les procédures EXESQL // Le test sous Delphi6 est passé. Procédure Exesql (SQLString: TStrings; Adodery: Tadoquière); var i: entier; Commencer avec Adoquery commence Fermer; Sql.clear; pour i: = 0 à sqlstring.count-1 do Sql.add (sqlString [i]); essayer Execsql; sauf sur e: exception do showMessage ('error: le message est le suivant' + # 13 + e.Message); fin; fin; fin; // Je pense que c'est la même chose où sauf est placé, il vaut mieux le mettre à l'extérieur parce que vous pouvez ajouter d'autres informations de débogage //Qu'en penses-tu? // est-ce que quelqu'un a combiné les deux processus d'exécution d'une seule ligne et d'exécution de plusieurs lignes en une, ce serait génial. Je vais en faire deux de plus, et je peux les ajouter et les supprimer en fonction de mes besoins, mais j'utilise dbgrideh pour créer dynamiquement Col procédure buildCol (vFieldName: String; vCaption: String; vWidth: entier; var VGrid: tdbGrideh; FootType: tfootervalutype = fvtnon; boolreadonly: boolean = true; var CCOL: TDBGridColumneh; CfooterCol: TColumnfooTereh; Commencer 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; // Si la valeur de balise est -1, la colonne ne sera pas imprimée lors de l'impression dbgrid ccol.tag: = itag; Commencer cfootercol: = ccol.footers.add; cfootercol.valuetype: = footTerype; Si foottype = fvtStatictExt alors Commencer vgrid.footerrowCount: = 1; cfootercol.value: = foeterText; fin; //ccol.footer.fieldname:=; fin; end; procédure titlebtnclick (expéditeur: tobject; acol: entier; Colonne: TCOLUMNEH; CDSHELPER: TClientDatasethelPer); var CDSTMP: TClientDataset; Commencer avec (expéditeur comme tdbgrideh) faire Commencer cdstmp: = (dataSource.dataset comme tClientDataset); Si non CDSTMP.ACTIVE, EXIT; // Définissez la méthode de tri de la ligne actuelle si chronn.title.sortmarker = smnoneeh alors Commencer Column.Title.Sortmarker: = SmupEH; cdshelper.sortbyfield (Column.FieldName, Soasceming); fin autre si chronn.title.sortmarker = smupeh alors Commencer Column.Title.Sortmarker: = SmDowneh; cdshelper.sortbyfield (Column.FieldName, SoEsChenting); fin autre Commencer Column.Title.Sortmarker: = SmnoneEh; cdshelper.sortbyfield (Column.FieldName, Sonosort); fin; fin; fin; une fonction qui enregistre les positions et les largeurs de chaque colonne dans DBGrid dans le fichier INI, et lit les positions et les largeurs de chaque colonne dans DBGrid à partir du fichier INI Procédure f_readini (const nuw_dbgrid: tdbgrid; form_name: string); var Filepath: String; Myinifile: tinifile; Grid_name, field_name: string; Largeur: entier; i, j, n: entier; Colonne: Array [0..100] de String; Largeurs: Array [0..100] d'Integer; Commencer Filepath: = extractFilePath (application.exename); Myinifile: = tinifile.create (filepath + 'gsp.ini'); Grid_name: = form_name + ',' + maintenant_dbgrid.name; n: = maintenant_dbgrid.colums.Count-1; pour i: = 0 à 100 do Colonne [i]: = ''; pour i: = 0 à n faire Commencer Field_name: = now_dbgrid.columns [i] .fieldName; j: = myinifile.readInteger (grid_name, field_name, i); Colonne [j]: = field_name; Widths [j]: = myinifile.readInteger (grid_name, field_name + '_ width', now_dbgrid.columns [i] .width); fin; Commencer NOW_DBGRID.Columns [i] .FieldName: = Column [i]; NOW_DBGRID.Columns [i] .Width: = Widths [i]; fin; end; procédure f_writeini (const NOW_DBGRID: tdbGrid; form_name: string); var Filepath: String; Myinifile: tinifile; Grid_name, field_name: string; Largeur: entier; I: entier; Commencer Filepath: = extractFilePath (application.exename); Myinifile: = tinifile.create (filepath + 'gsp.ini'); Grid_name: = form_name + ',' + maintenant_dbgrid.name; Commencer Field_name: = now_dbgrid.columns [i] .fieldName; Largeur: = maintenant_dbgrid.columns [i] .width; Myinifile.writeInteger (grid_name, field_name, i); Myinifile.writeInteger (grid_name, field_name + '_ width', largeur); fin; fin; je l'ai écrit il y a longtemps, et maintenant je l'ai encapsulé en classe. unité myfunc; interface usages Windows, synutils, mmSystem, winsvc, registre; fonction copystrleft (ch: char; str: string): string; fonction copystrright (ch: char; str: string): String; Fonction GetSelfPath: String; Procédure Hidetask (bhide: booléen); fonction SoundCardiNstalled: Boolean; Fonction Gethostip: String; Procédure DiryVC (svcName: String); fonction getRegisterEdOwner: String; Fonction GetRegTeredOrganization: String; ImplementationFunction RegistServiceProcess (DWProcessId, DWTYPE: INTEGER): Integer; Commencer Résultats: = Copie (Str, 1, Pos (Ch, Str) -1) end; fonction copystrright (ch: char; str: string): String; Commencer Résultats: = copy (str, pos (ch, str) +1, longueur (str) -pos (ch, str) +1) end; fonction getselfpath: String; Commencer Résultat: = ExtractFilePath (paramstr (0)) fin; procédure Hidetask (bhide: booléen); Commencer Si bhide puis registrevceprocess (getCurrentProcesssid, 1) Else RegisterserviceProcess (GetCurrentProcessId, 0); fin; fonction SoundCardiNstalled: Boolean; Commencer Résultat: = waveoutgetnumdevs> 0 end; fonction gethostip: string; taper Tapinaddr = array [0..10] de Pinaddr; Papinaddr = ^ tapinaddr; var Phe: Phostent; PPTR: Papinaddr; Tampon: tableau [0..63] de char; I: entier; Ginitdata: twsadata; Commencer Wsastartup (101 $, Ginitdata); GethostName (tampon, taille de tampon)); Phe: = GethostByName (tampon); Si phe = nil alors sortez; pptr: = papinaddr (phe ^ .h_addr_list); I: = 0; Résultat: = INET_NTOA (pptr ^ [i] ^); Wsacleanup; end; procédure DisABSVC (svcName: String); var Scmngr: Thandle; SCSVC: Thandle; Commencer 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); CloserServiceHandle (SCSVC); end; fonction getRegisterEdOwner: String; var Osversion: TosversionInfo; Swinkey: String; Commencer Osversion.dwosversionInfosize: = sizeof (osversion); GetVersionEx (Osversion); cas osversion.dwplatformId de Ver_platform_win32_windows: swinkey: = '/ logiciel / microsoft / windows / currentversion'; Ver_platform_win32_nt: swinkey: = '/ logiciel / Microsoft / Windows nt / currentVersion'; fin; avec du tregistry.Create do essayer RootKey: = hkey_local_machine; OpenKey (Swinkey, False); Résultat: = readString («registredOwner»); Enfin Gratuit; fin; end; fonction getRegisterEd Oorganisation: String; var Osversion: TosversionInfo; Swinkey: String; Commencer Osversion.dwosversionInfosize: = sizeof (osversion); GetVersionEx (Osversion); cas osversion.dwplatformId de Ver_platform_win32_windows: swinkey: = '/ logiciel / microsoft / windows / currentversion'; Ver_platform_win32_nt: swinkey: = '/ logiciel / Microsoft / Windows nt / currentVersion'; fin; avec du tregistry.Create do essayer RootKey: = hkey_local_machine; OpenKey (Swinkey, False); Résultat: = ReadString («Recreed Oorganisation»); Enfin Gratuit; fin; fin; fin. Mettez quelques premiers // Supprimer tous les fichiers d'extension spécifiés dans un certain répertoire Fonction Delfile (SDIR, FEXT: String): Boolean; var hfindfile: hwnd; FindFileData: win32_find_data; SR: TSearchrec; Commencer sdir: = sdir + '/'; hFindFile: = findFirstfile (pChar (sdir + fext), findFileData); Si hfindfile <> null alors Commencer DeleteFile (SDIR + FindFileData.cFileName); tandis que FindNextFile (hfindfile, findfiledata) <> false do DeleteFile (SDIR + FindFileData.cFileName); fin; sr.findHandle: = hFindFile; FindClose (sr); fin; // retard Procédure Mdelay (MSECS: DWORD); var Begintime: DWORD; Commencer Begintime: = getTickCount; répéter Application.ProcessMessages; Jusqu'à GetTickCount - Begintime> = MSECS; fin; // format type de point flottant fonction my_formatfloat (r: réel; u: entier): réel; var vstr: string; I: entier; Commencer Si u <= 0 alors Résultats: = R autre Commencer vstr: = '0'; pour i: = 1 à u - 1 faire VSTR: = VSTR + '0'; VSTR: = '0.' '+ VSTR; Résultat: = strtofloat (formatfloat (vstr, r)); fin; end; // obtenir la sous-chaîne à la position spécifiée dans une certaine chaîne // par exemple, get_substr ('aa ## bb # cc ## dd', '##', 3) renvoie 'cc' fonction get_substr (s_str, d_str: string; po: entier): String; var I, J, K: entier; Commencer Résultat: = ''; Si po <1 alors sortie; S_STR: = TRIM (S_STR) + D_STR; i: = 0; tandis que 1 = 1 faire Commencer Si pos (d_str, s_str)> 0 alors Commencer j: = pos (d_str, s_str) + longueur (d_str); k: = longueur (s_str) - (j-1); i: = i + 1; Si i = po alors Commencer j: = pos (d_str, s_str); Résultat: = Copy (S_STR, 1, J-1); casser; fin; S_STR: = COPY (S_STR, J, K); fin autre casser; fin; fin; // Obtenez le premier et la fin du mois de la date actuelle function get_date (da: tdatetime; zt: entier): tdateTime; var yy, mm, dd: string; Commencer yy: = formatdatetime ('yyyy', da); mm: = formatDateTime ('mm', da); Si zt = 0 alors dd: = '01' autre Commencer Si strToint (mm) dans [1,3,5,7,8,10,12] dd: = '31' autre Si mm <> '2' alors dd: = '30' autre Si Isleapyear (année de (da)) alors dd: = '29' autre dd: = '28'; fin; Dates-enregistrement: = '-'; Résultat: = strtodate (yy + '-' + mm + '-' + dd); fin; // l'existence ou non du tableau Fonction isExist (TB: String; Query: Tadoquery): booléen; var SQLSTR: String; Commencer sqlstr: = 'select * from sysobjects where id = object_id (' '+ tb +' '') '; avec la requête faire Commencer fermer; sql.clear; sql.add (sqlstr); ouvrir; fin; Si query.recordset.eof alors IsExist: = false autre IsExist: = true; fin; // utilise dans Excel, il équivaut à la conversion hexadécimale fonction int2letter (num: entier): String; const Letterstr = 'abcdefghijklmnopqrstuvwxyz'; var I, J: entier; Commencer Si num <= 26 alors Commencer Résultat: = Letterstr [num]; fin autre Commencer j: = num mod 26; i: = num div 26; Si j = 0 alors Commencer J: = 26; i: = i-1; fin; Résultat: = int2letter (i) + Letterstr [J]; fin; fin; // est-ce de type entier Fonction isInt (AST: String): Boolean; var Valeur, code: entier; Commencer Val (astr, valeur, code); Résultat: = code = 0; fin; // est-ce un type de point flottant fonction isfloat (astr: string): booléen; var Valeur: réel; Code: entier; Commencer Val (astr, valeur, code); Résultat: = code = 0; fin; revenez la prochaine fois :) Procédure RunScreensave (); // - exécuter la protection de l'écran Commencer SendMessage (hwnd_broadcast, wm_syscommand, sc_screensave, 0); fin; // Les deux fonctions suivantes sont arrondies, principalement pour montrer une façon de penser, vous pouvez utiliser n'importe lequel d'entre eux fonction myround (valeur: double): entier; // remplit et rond // Ce droit d'auteur appartient à Xiaofeng Commencer Résultat: = strToint (formatFloat ('#', valeur)); end; fonction Doround (valeur: double): entier; // remplit et rond // J'en ai la moitié, haha. Commencer Si la valeur <0 alors Résultats: = - DOROUND (-VALUE) autre Résultat: = Round (int ((valeur + 0,5) * 10)) Div 10; fin; // Bien sûr, il existe d'autres façons d'écrire cette fonction. . . Notes supplémentaires: La fonction ronde elle-même adopte la règle de "Arrondi six en cinq doubles". Je poste également quelques-unes de mes utilisations courantes: {------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- ------ Nom du processus: MSG Auteur: Gongqin Date: 2003-6-9 16:57:44 Paramètres: AMSG: String; Atitle: String = 'Tip'; Atype: = 1 Afficher l'icône "Information" 2 Afficher l'icône "Erreur" AMSG (affichage du contenu du message) aTitle (Titre d'affichage) btn: = 0 show ok 1 Afficher OK Annuler 2 show oui non 3 Show Retry and Annuler 4 Montrer, avorter, réessayer et ignorer Valeur de retour: entier Description: Afficher la boîte de dialogue des messages -------------------------------------------------- -------------------------------------------------- ---------------------------- ---------------------- --------------} fonction msg (AMSG: String; Atitle: String; atype: octet; btn: longint): entier; Var Flag: Longint; Commencer cas de type de 1: Flag: = MB_ICONQUESTION; 2: Flag: = MB_IConError; 3: Flag: = MB_ICONSTOP; autre Flag: = MB_ICONWARNING; fin; cas btn de 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_ABORTRESTRYIGNORE; fin; Résultat: = Application.MessageBox (PCHA (AMSG), PCHA (AITLE), FLAG); fin;{----------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- ------ Nom du processus: getAppPath Auteur: Gongqin Date: 2003-6-9 17:01:17 Paramètres: aucun Valeur de retour: chaîne Description: prenez le chemin vers l'application Si vous n'utilisez que ExtractFilePath (ExtractFilePath (application.exename)) pour obtenir le chemin Il peut y avoir une erreur, donc il a été traité -------------------------------------------------- -------------------------------------------------- ---------------------------- ---------------------- --------------} fonction getAppPath: String; var strtmp: string; Commencer strtmp: = extractFilePath (extractFilePath (application.exename)); Si strtmp [longueur (strtmp)] <> '/' alors strtmp: = strtmp + '/'; Résultat: = strtmp; fin; Ci-dessous est ce que j'ai compilé moi-même http://www.myf1.net/bbs/dispbbs.asp?boardid=5&id=215239 // Calculez le premier et dernier mois du trimestre où se trouve la date actuelle // Édition ultime Fonction QuarterBegin (TheDate: tdateTime = 0): entier; // Copier à droite 549 @ 18: 25 2003-9-3 Commencer Résultat: = (Quarter (TheDate) - 1) * 3 + 1; end; fonction quartrend (thedate: tdatetime = 0): entier; // Copier à droite 549 @ 18: 25 2003-9-3 Commencer Résultat: = (Quarter (TheDate) - 1) * 3 + 3; end; fonction du quart (thedate: tdatetime = 0): entier; // Copier à droite 549 @ 10: 06 2003-9-5 Commencer Résultat: = moisof (thedate); si theDate = 0 alors résultat: = Monthof (date); Résultat: = (résultat + 2) Div 3; fin; | 