| function getkbstatus (): string; // retorna ao status atual do teclado, incluindo NumLoce, Caps Lock, Insert // Cada informação de status ocupa dois caracteres, na ordem: numloce, caps trava, inserir // Copiar direito 549@11: 29 2003-7-22 status var: string; Keystates: TKEYBOARDSTATE; Começar GetKeyboardState (KeyStates); Se ímpar (KeyStates [vk_numlock]) então Status: = 'Número' outro Status: = 'cursor'; Se ímpar (KeyStates [vk_capital]) então Status: = Status+'Caps' outro Status: = status+'minúsculo'; Se ímpar (keystates [vk_insert]) então Status: = status+'inserir' outro Status: = status+'reescrever'; Resultados: = status; final; const errhead = 'O erro ocorreu na operação, a mensagem de erro é:'+#13 tentar ... exceto ON E: Exceção do showMessage (errhead+e.message+#13+'A operação atual é: xxxxx'); fim; Ele permite que os usuários vejam mais mensagens de erro, o que ajuda os erros do programa de feedback dos clientes. Escrevo uma boa ideia, mas muitas vezes a uso: // >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>> // execute sql // Parâmetros de entrada: SQLSTRING, ADoquery // Tipo: String, TadoQuery Procedimento tmainform.exesql (sqlstring: string; débil: tadoquery); Começar Com o ADoquery do Começar Conexão: = dm.dbaccinfo; // Este é meu, você pode adicionar a conexão // ou use -o. Se ativo então Ativo: = false; Abrir; Sql.clear; Sql.add (sqlString); Execsql; Fechar; fim; fim; talvez todos saibam disso. No entanto, no código que eu vi, parece que poucas pessoas escrevem um processo tão independente. Isso é garantido para ser original por mim ... // Abra o Adoquery // Adaptado do processo de verdadeiro (Aixiang (apenas Lizzy pode ser informado de que outros não podem)) // suporta SQL multi-linha // Você pode modificá-lo você mesmo conforme necessário para suportar apenas procedimentos SQL de linha única ou procedimentos exesql // O teste em Delphi6 passou. Procedimento OpenSQL (SQLSTRING: TSTRINGS; Adoquery: TadoQuery); var i: número inteiro; Começar Com o ADoquery do Começar Fechar; Sql.clear; para i: = 0 a sqlstring.count-1 do Sql.add (sqlString [i]); tentar Abrir; exceto Em e: Exceção do showMessage ('Erro: a mensagem é a seguinte'+#13+e.message); fim; fim; fim; Esta é uma única linha de SQL Procedimento OpenSQL1 (SQLSTRING: String; Adoquery: TadoQuery); Começar Com o ADoquery do Começar Fechar; Sql.clear; Sql.add (sqlString); tentar Abrir; exceto Em e: Exceção do showMessage ('Erro: a mensagem é a seguinte'+#13+e.message); fim; fim; fim; Hoho, obrigado por me ajudar a consertar essa coisa. Mas você não usa o ExecSQL? Normalmente, acrescento tente fora deste processo, ou seja, onde ele é citado. Isso é tentar Exesql (SQLSTRING, Adoquery1) exceto // Prompt de erro, coisas bagunçadas. fim Para: Real Like (Aixiang (apenas Lizzy pode ser informado de que outros não podem))) Eu fiz execsql também // EXECSQL Adoquery // suporta SQL multi-linha // Você pode modificá-lo você mesmo conforme necessário para suportar apenas procedimentos SQL de linha única ou procedimentos exesql // O teste em Delphi6 passou. Procedimento exesQL (SQLSTRING: TSTRINGS; ADOCERY: TadoQuery); var i: número inteiro; Começar Com o ADoquery Comece Fechar; Sql.clear; para i: = 0 a sqlstring.count-1 do Sql.add (sqlString [i]); tentar Execsql; exceto Em e: Exceção do showMessage ('Erro: a mensagem é a seguinte'+#13+e.message); fim; fim; fim; // Acho que é o mesmo onde, exceto //O que você acha? // Alguém combinou os dois processos de execução de uma única linha e executar várias linhas em uma, isso seria ótimo. Farei mais dois, e posso adicioná -los e excluí -los de acordo com minhas necessidades, mas estou usando o DBGrideh para criar dinamicamente o COL Procedimento BuildCol (vFieldName: string; vcaption: string; vwidth: integer; var vGrid: tdbGrideH; FooterType: tfootValuetype = fvtnon; boolreadonly: boolean = true; var CCOL: TDBGRIDCOLUMNEH; cfoOTerCol: tcolumnfootereh; Começar 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; // Se o valor da tag for -1, a coluna não será impressa ao imprimir DBGrid CCOL.TAG: = ITAG; Começar cfoOTerCol: = ccol.footers.add; cfoOTerCol.Valuetype: = FoDerType; Se FooterType = fvtStaticText então Começar vGrid.footerrowCount: = 1; cfoOTerCol.Value: = FoDerText; fim; //ccol.footer.fieldname:=; fim; final; procedimento titleBtnClick (remetente: Tobject; Acol: Integer; Coluna: tcolumneh; var CDSTMP: tclientDataSet; Começar com (remetente como tdbGrideh) Começar CDSTMP: = (DataSource.DataSet como tclientDataset); se não cdstmp.active, então saia; // Defina o método de classificação da linha atual se column.title.sortmarker = smnoneeh então Começar Colun.title.sortmarker: = smupeh; CDSHELPER.SORTBYFIELD (COLUNN.FIELDNAME, SOASSENDENTE); fim outro se column.title.sortmarker = smupeh então Começar Colun.title.sortmarker: = smdowneh; CDSHELPER.SORTBYFIELD (Column.FieldName, Sodescending); fim outro Começar Colun.title.sortmarker: = smnoneeh; CDSHELPER.SORTBYFIELD (Column.FieldName, Sonosort); fim; fim; fim; procedimento f_readini (const now_dbgrid: tdbgrid; form_name: string); var Filepath: string; Myinifile: Tinifile; Grid_name, field_name: string; Largura: Inteiro; i, j, n: inteiro; Coluna: Array [0..100] de String; Larguras: matriz [0..100] de inteiro; Começar Filepath: = extractFilePath (application.exename); Myinifile: = tinifile.create (filepath+'gsp.ini'); Grid_name: = form_name+','+agora_dbgrid.name; n: = agora_dbgrid.columns.count-1; para i: = 0 a n fazer Começar Field_name: = agora_dbgrid.columns [i] .fieldName; j: = myinifile.readInteger (grid_name, field_name, i); Coluna [j]: = field_name; Larguras [j]: = myInifile.readinteger (grid_name, field_name+'_ width', agora_dbgrid.columns [i] .width); fim; Começar Agora_dbgrid.columns [i] .fieldName: = colun [i]; Agora_dbgrid.columns [i] .width: = widths [i]; fim; end; procedimento f_writeini (const now_dbgrid: tdbgrid; form_name: string); var Filepath: string; Myinifile: Tinifile; Grid_name, field_name: string; Largura: Inteiro; I: Inteiro; Começar Filepath: = extractFilePath (application.exename); Myinifile: = tinifile.create (filepath+'gsp.ini'); Grid_name: = form_name+',' agora_dbgrid.name; Começar Field_name: = agora_dbgrid.columns [i] .fieldName; Largura: = agora_dbgrid.columns [i] .width; Myinifile.writeInteger (grid_name, field_name, i); Myinifile.writeInteger (grid_name, field_name+'_ width', largura); fim; fim; unidade myfunc; interface usos Windows, Sysutils, Mmsystem, Winsvc, Registro; função copystrleft (ch: char; str: string): string; função copystrright (ch: char; str: string): string; função getSeilpath: string; Procedimento HideTask (Bhide: Boolean); Função SoundCardInstalled: boolean; função gethostip: string; Procedimento desativa ovc (svcname: string); função getRegisterDowner: string; função getRegudorDornation: string; Começar Resultados: = cópia (str, 1, pos (ch, str) -1) end; função copystrright (ch: char; str: string): string; Começar Resultados: = cópia (str, pos (ch, str) +1, comprimento (str) -pos (ch, str) +1) fim; função getSelfpath: string; Começar Resultado: = ExtractFilePath (Paramstr (0)) final; procedimento HIDETASK (BHIDE: booleano); Começar Se bhide, então registringServiceProcess (getCurrentProcessId, 1) caso contrário, registreviceProcess (getCurrentProcessId, 0); final; função, o SoundCardInstalled: boolean; Começar Resultado: = WaveOutgetNumDevs> 0 fim; função gethostip: string; tipo Tapinaddr = matriz [0..10] de pinaddr; Papinaddr = ^tapinaddr; var Phe: Fostent; PPTR: Papinaddr; Buffer: Array [0..63] de Char; I: Inteiro; Ginitdata: Twsadata; Começar WSASTARTUP (US $ 101, ginitdata); GethostName (buffer, sizeof (buffer)); phe: = gethostbyname (buffer); se phe = nil então saia; pptr: = Papinaddr (Phe^.h_addr_list); I: = 0; Resultado: = INT_NTOA (pptr^[i]^); WSACLEANUP; final; procedimento desabilitaVC (svcname: string); var Scmngr: Thandle; SCSVC: THANDLE; Começar 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); ClosserviiceHandle (SCSVC); fim; função getRegisterDowner: string; var Osversion: TosversionInfo; Swinkey: string; Começar Osversion.dwosversionInfosize: = sizeof (Osversion); GetVersionEx (Osversion); case Osversion.dwplatformid de Ver_platform_win32_windows: swinkey: = '/software/microsoft/windows/currentVersion'; Ver_platform_win32_nt: swinkey: = '/software/microsoft/windows nt/currentVersion'; fim; com Tregistry.create Do tentar Rootkey: = hkey_local_machine; OpenKey (Swinkey, falso); Resultado: = ReadString ('RegisteredOwner'); Finalmente Livre; fim; fim; função getRegisterDorganization: string; var Osversion: TosversionInfo; Swinkey: string; Começar Osversion.dwosversionInfosize: = sizeof (Osversion); GetVersionEx (Osversion); case Osversion.dwplatformid de Ver_platform_win32_windows: swinkey: = '/software/microsoft/windows/currentVersion'; Ver_platform_win32_nt: swinkey: = '/software/microsoft/windows nt/currentVersion'; fim; com Tregistry.create Do tentar Rootkey: = hkey_local_machine; OpenKey (Swinkey, falso); Resultado: = readString ('RegisterDorganization'); Finalmente Livre; fim; fim; fim. Coloque alguns primeiros // Exclua todos os arquivos de extensão especificados em um determinado diretório função delfile (sdir, fext: string): boolean; var hfindfile: hwnd; FindFiledata: win32_find_data; SR: TSearchRec; Começar sdir: = sdir + '/'; hfindfile: = findFirstFile (PCHO (sdir + fext), findfiledata); Se hfindfile <> nulo então Começar deletefile (sdir + findfiledata.cfilename); enquanto findNextFile (hfindfile, findfiledata) <> false Do deletefile (sdir + findfiledata.cfilename); fim; sr.findhandle: = hfindfile; FindClose (SR); fim; // atraso procedimento mdelay (msecs: dword); var BEGINTIME: DWORD; Começar BEGINTIME: = getTickCount; repita Application.processMessages; Até gettickcount - BEGINTIME> = MSECS; fim; // Tipo de ponto flutuante de formato function my_formatfloat (r: real; u: integer): real; var vstr: string; I: Inteiro; Começar Se u <= 0 então Resultados: = r outro Começar vstr: = '0'; para i: = 1 a u - 1 fazer vstr: = vstr + '0'; vstr: = '0.' + vstr; Resultado: = strtofloat (formatfloat (vstr, r)); fim; end; // obtenha a substring na posição especificada em uma certa string // por exemplo, get_substr ('aa ## bb#cc ## dd', '##', 3) retorna 'cc' função get_substr (s_str, d_str: string; po: integer): string; var I, J, K: Inteiro; Começar resultado: = ''; Se Po <1 então saída; S_STR: = TRIM (S_STR)+D_STR; i: = 0; enquanto 1 = 1 do Começar Se pos (d_str, s_str)> 0 então Começar J: = POS (d_str, s_str)+comprimento (d_str); k: = comprimento (s_str)-(j-1); i: = i+1; Se eu = PO então Começar J: = POS (D_STR, S_STR); resultado: = cópia (s_str, 1, j-1); quebrar; fim; s_str: = cópia (s_str, j, k); fim outro quebrar; fim; fim; // Obtenha o primeiro e o final do mês da data atual function get_date (da: tdateTime; zt: integer): tdateTime; var yy, mm, dd: string; Começar yy: = formatDateTime ('aaaa', da); mm: = formatDateTime ('mm', da); se zt = 0 então dd: = '01' outro Começar Se Strtoint (mm) em [1,3,5,7,8,10,12] então dd: = '31' outro Se mm <> '2' então dd: = '30' outro Se Isleapyear (ano (da)), então dd: = '29' outro dd: = '28'; fim; DateeParator: = '-'; Resultado: = strtodate (yy + '-' + mm + '-' + dd); fim; // a existência ou não da tabela função isExist (TB: String; Consulta: TadoQuery): Boolean; var sqlstr: string; Começar SQLSTR: = 'Selecione * FROM SYSOBJETS WHERE ID = Object_id (' '+TB+' '') '; com consulta fazer Começar fechar; sql.clear; sql.add (sqlstr); abrir; fim; se query.recordset.eof então IsExist: = false outro IsExist: = true; fim; // Uso no Excel, é equivalente à conversão hexadecimal função int2LETter (num: integer): string; const Letterstr = 'abcdefghijklmnopqrstuvwxyz'; var I, J: Inteiro; Começar Se num <= 26 então Começar Resultado: = Letterstr [num]; fim outro Começar j: = num mod 26; i: = num div 26; se j = 0 então Começar j: = 26; i: = i-1; fim; Resultado: = int2LETTER (i)+Letterstr [J]; fim; fim; // é o tipo inteiro função isint (ast: string): boolean; var Valor, código: número inteiro; Começar Val (Astr, valor, código); Resultado: = code = 0; fim; // é o tipo de ponto flutuante função isfloat (astr: string): boolean; var Valor: real; Código: Inteiro; Começar Val (Astr, valor, código); Resultado: = code = 0; fim; procedimento runscreensave (); //-Execute a proteção da tela Começar SendMessage (hwnd_broadcast, wm_syscommand, sc_screensave, 0); fim; // As duas funções a seguir são arredondadas, principalmente para mostrar uma maneira de pensar, você pode usar qualquer um deles Função MyRound (Valor: Double): Inteiro; // encher e redondo // Este direitos autorais pertencem a Xiaofeng Começar resultado: = strtoint (formatfloat ('#', valor)); fim; função doround (valor: duplo): número inteiro; // encher e redondo // eu tenho metade disso, haha. Começar Se valor <0, então resultados: = - doround (-Value) outro Resultado: = redonda (int ((valor + 0,5) * 10)) div 10; fim; // Claro, existem outras maneiras de escrever essa função. . . Notas adicionais: A própria função redonda adota a regra de "arredondar seis em cinco duplas". Eu também posto alguns dos meus usos comuns: {------------------------------------------------- -------------------------------------------------------- -------------------------------------------------------- -------------------------------------------------------- -------------------------------------------------------- -------------------------------------------------------- ------ Nome do processo: msg Autor: Gongqin Data: 2003-6-9 16:57:44 Parâmetros: amsg: string; ATYPE: = 1 Exibir o ícone "Information" 2 Exibir o ícone "erro" AMSG (Teor de Mensagem de Exibir) ATITLE (Título de exibição) btn: = 0 Mostrar ok 1 MOSTRAR OK CANCEL 2 Mostrar sim não 3 Mostrar tente repetir e cancelar 4 Mostre abortar, tentar novamente e ignorar Valor de retorno: Inteiro Descrição: Exibir a caixa de diálogo da mensagem -------------------------------------------------------- -------------------------------------------------------- ------------------------------ ------------------------ --------------} função msg (amsg: string; atitle: string; atype: byte; btn: longint): inteiro; sinalizador var: longint; Começar caso atype de 1: sinalizador: = mb_iconQuestion; 2: sinalizador: = MB_ICONERROR; // Erro 3: sinalizador: = mb_iconstop; outro Sinalizador: = mb_iconwarning; fim; Caso Btn de 0: sinalizador: = sinalizador + mb_ok; 1: sinalizador: = sinalizador + mb_okcancel; 2: sinalizador: = sinalizador + mb_yesno; 3: sinalizador: = sinalizador + mb_yesnocancel; 4: sinalizador: = sinalizador + mb_retrycancel; 5: sinalizador: = sinalizador + mb_abortretryignore; fim; Resultado: = Application.MessageBox (PChar (AMSG), PCHA (ATITLE), FLAG); fim;{----------------------------------------------- -------------------------------------------------------- -------------------------------------------------------- -------------------------------------------------------- -------------------------------------------------------- -------------------------------------------------------- ------ Nome do processo: getAppPath Autor: Gongqin Data: 2003-6-9 17:01:17 Parâmetros: Nenhum Valor de retorno: string Descrição: Pegue o caminho para o aplicativo Se você usar apenas o ExtractFilePath (ExtractFilePath (Application.Exename)) para obter o caminho Pode haver um erro, então foi processado -------------------------------------------------------- -------------------------------------------------------- ------------------------------ ------------------------ --------------} função getApppath: string; var strtmp: string; Começar strtmp: = extractFilePath (ExtractFilePath (Application.Exename)); Se strtmp [comprimento (strtmp)] <> '/' então strtmp: = strtmp + '/'; Resultado: = strtmp; fim; Abaixo está o que eu me compilei http://www.myf1.net/bbs/dispbbs.asp?boardid=5&id=215239 // Calcule o primeiro e o último mês do trimestre em que a data atual está localizada // Ultimate Edition Função Quarterbegin (Thedate: tDateTime = 0): Integer; // Copiar direito 549@18: 25 2003-9-3 Começar Resultado: = (trimestre (thedate) - 1) * 3 + 1; fim; função quartel -end (Thedate: tdateTime = 0): Integer; // Copiar direito 549@18: 25 2003-9-3 Começar Resultado: = (trimestre (thedate) - 1) * 3 + 3; final; trimestre da função (Thedate: tdateTime = 0): Inteiro; // Copiar direito 549@10: 06 2003-9-5 Começar Resultado: = Mês do (Thedate); se thedate = 0, então resultado: = mêsf (data); Resultado: = (resultado + 2) div 3; fim; | 