Delphi Funcoes

Funções para o Delphi Delphi

APOSTIL A POSTILA A DICA DICA S DE PROGRAMA PROGRAMAÇÃO ÇÃO DEL DEL PHI PHI

Professor Profess or Edgar Edg ar Caldeir Caldeira a da Cruz

Ar A r aras ar as/SP /SP 2013 Página 1


SUMÁRIO Acessando arquivos Paradox em rede ............................................................................................................. 5 Confirmar o diretório ........................................................... ........................................................... ....................... 5 Hint com quebra de linha ................................................... ........................................................... ....................... 5 Testa se existe disco no drive “A” ........................................................ ........................................................... ... 5 Verifica se o Form já está ativo .......................................................................................................................... 6 Pegando o nome do usuário e o nome da empresa no Windows ................................................................ 6 Como criar uma tela de abertura (Splash Screen) .......................................................................................... 7 Como validar a entrada de uma caixa de texto ..................................................... ........................................... 7 A tecla “ENTER” para funcionar funcionar como “TAB”....................................................... ........................................... 7 Capturar tela .................................................... ........................................................... ........................................... 8 Subtrair/adicionar Subtrair/adicionar N meses a uma data ....................................................... ..................................................... 8 Data por extenso................................................................................................................................................... 8 Habilitar e desabiliar a senha do protetor de tela ............................................................................... ............. 8 Sobrescrevendo Sobrescrevendo um evento ................................................................................................................................ 9 Como evitar a mensagem de erro Key Violation ............................................................................................. 9 Como evitar a mensagem de erro Key Violation ............................................................................................. 9 Executar um PACK em tabelas Paradox ....................................................................................................... . 10 Verificar se o registro está travado .................................................................................................................. 10 Cursor customizado ........................................................................................................................................... 12 Criando atalhos ......................................................... ........................................................... ............................... 12 Emular o pressionamento de uma tecla ....................................................... ................................................... 13 Fechar um aplicativo a partir do Delphi ........................................................ ................................................... 13 Configurar o Delphi para acessar tabelas do Access .................................................................................. . 13 Apagar um subdiretório ...................................................................................................................................... 14 Testar a impressora ........................................................................................................................................... 14 Validar datas .................................................... ........................................................... ......................................... 15 Procurar arquivos ............................................................................................................................................... 15 Abrir arquivos com aplicativo associado ....................................................... .................................................. 16 Fazer um TEdit aceitar apenas números ..................................................... ................................................... 17 Alterar o papel de parede do Windows ........................................................................................................... 17 Extrair o número de cores do modo de vídeo corrente ................................................................................. 17 Habilitar e desabilitar barra de tarefas .......................................................... ................................................... 17 Habilitar e desabilitar ctrl+alt+del ..................................................................................................................... 18 Alterar a data e a hora do sistema ....................................................... ........................................................... . 18 Extrair o tamanho de um arquivo ..................................................................................................................... 19 Extrair o ícone de um executável ......................................................... ........................................................... . 19 Verificando a memória ....................................................... ........................................................... ..................... 19 Número de série do hd ...................................................................................................................................... 20 Mapear uma pasta na rede ............................................................................................................................... 20 Pegar nome do usuário na rede ........................................................... ........................................................... . 21 saber o estado das teclas Num lock, Caps lock e Scroll lock ........................................................... ........... 21 Testando drives ................................................................................................................................................... 21 Executando programas externos ..................................................................................................................... 22 Reproduzindo sons wav, sem o componente mediaplayer ..................................................... ..................... 22 Manipular arquivos INI ....................................................... ........................................................... ..................... 22 Exponenciação.......................................................... ........................................................... ............................... 23 Aguardar um determinado nº de segundos .................................................................................................... 24 Tecla ENTER funcionar como TAB ................................................................................................................. 24 Utilizar ponto para separar decimais ............................................................................................................... 24 Criando um Splash Screen (abertura) .......................................................... ................................................... 24 Como limpar todos os edits edits de um form ........................................................................................................ 25

Página 2


SUMÁRIO Acessando arquivos Paradox em rede ............................................................................................................. 5 Confirmar o diretório ........................................................... ........................................................... ....................... 5 Hint com quebra de linha ................................................... ........................................................... ....................... 5 Testa se existe disco no drive “A” ........................................................ ........................................................... ... 5 Verifica se o Form já está ativo .......................................................................................................................... 6 Pegando o nome do usuário e o nome da empresa no Windows ................................................................ 6 Como criar uma tela de abertura (Splash Screen) .......................................................................................... 7 Como validar a entrada de uma caixa de texto ..................................................... ........................................... 7 A tecla “ENTER” para funcionar funcionar como “TAB”....................................................... ........................................... 7 Capturar tela .................................................... ........................................................... ........................................... 8 Subtrair/adicionar Subtrair/adicionar N meses a uma data ....................................................... ..................................................... 8 Data por extenso................................................................................................................................................... 8 Habilitar e desabiliar a senha do protetor de tela ............................................................................... ............. 8 Sobrescrevendo Sobrescrevendo um evento ................................................................................................................................ 9 Como evitar a mensagem de erro Key Violation ............................................................................................. 9 Como evitar a mensagem de erro Key Violation ............................................................................................. 9 Executar um PACK em tabelas Paradox ....................................................................................................... . 10 Verificar se o registro está travado .................................................................................................................. 10 Cursor customizado ........................................................................................................................................... 12 Criando atalhos ......................................................... ........................................................... ............................... 12 Emular o pressionamento de uma tecla ....................................................... ................................................... 13 Fechar um aplicativo a partir do Delphi ........................................................ ................................................... 13 Configurar o Delphi para acessar tabelas do Access .................................................................................. . 13 Apagar um subdiretório ...................................................................................................................................... 14 Testar a impressora ........................................................................................................................................... 14 Validar datas .................................................... ........................................................... ......................................... 15 Procurar arquivos ............................................................................................................................................... 15 Abrir arquivos com aplicativo associado ....................................................... .................................................. 16 Fazer um TEdit aceitar apenas números ..................................................... ................................................... 17 Alterar o papel de parede do Windows ........................................................................................................... 17 Extrair o número de cores do modo de vídeo corrente ................................................................................. 17 Habilitar e desabilitar barra de tarefas .......................................................... ................................................... 17 Habilitar e desabilitar ctrl+alt+del ..................................................................................................................... 18 Alterar a data e a hora do sistema ....................................................... ........................................................... . 18 Extrair o tamanho de um arquivo ..................................................................................................................... 19 Extrair o ícone de um executável ......................................................... ........................................................... . 19 Verificando a memória ....................................................... ........................................................... ..................... 19 Número de série do hd ...................................................................................................................................... 20 Mapear uma pasta na rede ............................................................................................................................... 20 Pegar nome do usuário na rede ........................................................... ........................................................... . 21 saber o estado das teclas Num lock, Caps lock e Scroll lock ........................................................... ........... 21 Testando drives ................................................................................................................................................... 21 Executando programas externos ..................................................................................................................... 22 Reproduzindo sons wav, sem o componente mediaplayer ..................................................... ..................... 22 Manipular arquivos INI ....................................................... ........................................................... ..................... 22 Exponenciação.......................................................... ........................................................... ............................... 23 Aguardar um determinado nº de segundos .................................................................................................... 24 Tecla ENTER funcionar como TAB ................................................................................................................. 24 Utilizar ponto para separar decimais ............................................................................................................... 24 Criando um Splash Screen (abertura) .......................................................... ................................................... 24 Como limpar todos os edits edits de um form ........................................................................................................ 25

Página 2

Funções para o Delphi Delphi Formatar números com zeros à esquerda ................................................... ................................................... 26 Obrigar a digitação de caracteres maiúsculos num campo memo ............................................................. 26 Imprimindo um campo memo via Canvas ..................................................... .................................................. 26 Procura e substituição de string num campo memo .................................................................................... . 27 Pegando a linha e coluna atuais de um memo ..................................................... ......................................... 27 Trocando a cor de uma célula num DBGrid ................................................................................................... 27 Trocando a cor da fonte num DBGrid ........................................................... ................................................... 28 Gerenciando mais de uma linha selecionada num DBGrid (Multiselect) ................................................... 28 Commit (Delphi 3) ..................................................... ........................................................... ............................... 29 Commit (Delphi 2) ..................................................... ........................................................... ............................... 29 Extrair o número do registro atual em tabelas Paradox ou Dbase ............................................................ . 29 Alterando Idapi32.Cfg Via Programa ................................................... ........................................................... . 30 Criando tabelas ......................................................... ........................................................... ............................... 30 Data por extenso no Quickreport ..................................................................................................................... 31 Filtrando registros com o Quickreport (Delphi 2) .......................................................................................... . 31 Extraindo o ano, mês ou dia de uma data via SQL ........................................................ ............................... 32 Cria um clone Monocromático de um outro Bitmap ...................................................................................... 32 Gerar Planilha no Excel ..................................................... ........................................................... ..................... 33 DBGrid, Ocultando Colunas Dinamicamente com Popup ............................................................................ 34 Transformar de minutos para horas ..................................................... ........................................................... . 35 Campo auto incremento no Oracle e no Interbase ......................................................... ............................... 35 Como desativar a proteção de tela ...................................................... ........................................................... . 36 Gira o texto .......................................................................................................................................................... 37 Hint Redondo ...................................................................................................................................................... 37 Informar a velocidade do Processador ......................................................... ......................................................... ................................................... 40 Instalar quickreport no delphi 7 ........................................................................................................................ 41 Mostra e esconde ícones da área de trabalho ...................................................... ......................................... 41 Alterando o papel de parede ....................................................... ........................................................... ........... 41 Salvar a tela em BMP ........................................................................................................................................ 42 Usando o Word dentro do Delphi ......................................................... ........................................................... . 43 Função para validar o PIS ........................................................... ........................................................... ........... 43 Calcular a idade usando o MaskEdit ............................................................................................................... 44 Como definir seu próprio hotkey (Tecla Quente) .................................................. ......................................... 45 Como interceptar as teclas de funções no programa ................................................................................... 46 DbGrid zebrado ......................................................... ........................................................... ............................... 46 Retorna o espaço livre em disco .......................................................... ........................................................... . 47 Para que o seu Form não seja redimensionado ............................................................................................ 47 Como mover um componente em Run-time .......................................................... ......................................... 48 Como verificar se a tecla TAB foi pressionada ................................................................................... ........... 50 Executar um AVI no Form ................................................................................................................................. 50 Colocar zeros a esquerda de um valor digitado no componente Edit ........................................................ 51 Cancelar o pressionamento de uma tecla ...................................................................................................... 51 Utilizar o MessageBox com parâmetros.......................................................................................................... 51 Retorna a cor de um determinado componente no formato string ................................................... ........... 51 Verifica se existe o diretório ........................................................ ........................................................... ........... 52 Bloquear a tecla Ctrl+Del do DBGrid ................................................... ........................................................... . 52 Para criar uma janela não retangular .............................................................................................................. 52 Fecha todos os arquivos.................................................................................................................................... 52 Hint com quebra de linhas ........................................................... ........................................................... ........... 52 Imprimindo sem passar pelo gerenciador de impressão .............................................................................. 53 Fechar um aplicativo Delphi a partir de outro aplicativo Delphi ........................................................ ........... 53 Mostrar o HINT num Panel.......................................................... ........................................................... ........... 53 Retornar o nome do usuário que esta editando o registro ........................................................................... 54 Retornar o nome do usuário que esta com a tabela Exclusiva .................................................................. . 54

Página 3

Funções para o Delphi Configuração do BDE para ambiente de rede ............................................................................................... 54 Como criar um Form de Apresentação (Splash Form) como o do WORD ................................................ 56 Verifica se o Form, já esta ativo, Delphi1, Delphi2 e Delphi3 ...................................................................... 56 Converter a primeira letra de um Texto em maiúscula ................................................................................. 56 Verifica se o Form, já esta ativo ....................................................................................................................... 57 Mostrar as fontes TrueType instaladas no Windows ......................................................................... ........... 57 ShowMessage com quebra de linhas ........................................................... ................................................... 58 Veja abaixo como retornar informações do ambiente DOS .................................................... ..................... 58 Como colocar um componente ComboBox em um componente StringGrid ............................................. 59 Como retornar A coluna ativa do DBGrid........................................................................................................ 60 Como mover o conteudo da calculadora do Windows para um Edit .......................................................... 61

Página 4

Funções para o Delphi

Acessando arqui vos Paradox em rede Arquivos Paradox podem ser compartilhados em rede. Para que isto ocorra devemos: 1. Adicionar o DATABASE ENGINE CONFIGURATION (BDE CONFIG) 2. Selecionar a página DRIVERS 3. Selecionar o driver PARADOX e alterar o parâmetro NET DIR para o local onde serão gravados os arquivos de controle para compartilhamento. Por exemplo, "G:\MEUAPLIC", onde G : corresponde ao drive de rede e MEUAPLIC, o diretório aonde está o aplicativo (executável) 4. Depois selecionar a página SYSTEM 5. Alterar o parâmetro LOCAL SHARE para TRUE. Após isto o BDE controlará o compartilhamento de arquivos PARADOX em rede.

Confirmar o diretório procedure TForm1.Button1Click(Sender: TObject); begin if DirectoryExists(Edit1.Text) then Label1.Caption := Edit1.Text + ' exists' else Label1.Caption := Edit1.Text + ' does not exist'; end;

Hint com qu ebra de linha

Para incluir mais de uma linha no Hint você deve utilizar o evento OnMouseMove de cada componente. Veja abaixo como ficará o código em um Edit por exemplo. procedure TForm1.Edit1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin Edit1.hint := 'Primeira Linha'+#13+'Segunda Linha'+#13+ 'Terceira Linha'+#13+'Quarta Linha'; end; Obs. Não esquecer de mudar para TRUE o evento ShowHint.

Testa se existe disco no drive “ A”

function TForm1.TemDiscoNoDrive(const drive : char): boolean; var DriveNumero : byte; EMode : word; begin result := false; DriveNumero := ord(Drive); if DriveNumero >= ord('a') then Página 5


dec(DriveNumero,$20); EMode := SetErrorMode(SEM_FAILCRITICALERRORS); try if DiskSize(DriveNumero-$40) <> -1 then Result := true else messagebeep(0); finally SetErrorMode(EMode); end; end; procedure TForm1.Button1Click(Sender: TObject); begin if TemDiscoNoDrive('a') then ShowMessage('Tem disco no drive A:') else ShowMessage('Não tem disco no drive A:'); end;

Verifica se o Form j á está ativo

procedure TForm1.Button1Click(Sender: TObject); var Found : Integer; begin Found := -1; for i := 0 to Screen.FormCount - 1 do if Screen.Forms[i] is TForm2 then Found := i; if Found >= 0 then Screen.Forms[Found].Show else begin Form2 := TForm2.Create(Self); Form2.Show; end; end;

Pegando o nome do usuário e o nome da empresa no Windows Uses Registry; Procedure GetUserCompany; var reg: TRegIniFile; begin reg := TRegIniFile.create('SOFTWARE\MICROSOFT\MS SETUP (ACME)\'); Edit1.Text := reg.ReadString('USER INFO','DefName',''); Edit2.Text := reg.ReadString('USER INFO','DefCompany',''); reg.free; end;

Página 6


Como criar uma tela de abertura (Splash Screen) Após ter criado o formulário principal, crie um Formulário para a Splah Screen que iremos chamar de FormAbertura (dê o nome que você quiser). Depois de criar os dois forms, clique no menu View, na opção Project Source. Encontrando a linha em que o form de abertura é criado e apague-a. Linha que deve ser apagada: begin Application.CreateForm(TFormabertura, FormAbertura); {Esta linha deve ser apagada} end;

Agora insira as linhas abaixo antes da criação dos demais form do seu aplicativo: begin AberturaForm:=TFormAbertura.Create(Application); AberturaForm.show; {Os outros form devem ser criados a partir daqui} FormAbertura.Hide; {Esconde o FormAbertura} FormAbertura.Free; {Libera Memória} Application.Run; End;

Como validar a entrada de uma caixa de texto procedure Edit1KeyPress(Sender: TObject; var Key: Char); begin If not(key in['0'..'9',#8]) then begin beep;{somente delphi 2.0 ou 3.0} key:=#0; end; end

A tecla “ ENTER” para funcionar como “ TAB”

obs.:(1) a propriedade KEYPREVIEW do form será igual TRUE; obs.:(2) a propriedade DEFAULT dos botões será igual FALSE; procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin If Key = #13 then Begin Key:=#0; If (Sender is TEdit) and (Sender is TComboBox) then TEdit(Sender).Perform(WM_KeyDown,VK_Tab,0) Else Perform(Wm_NextDlgCtl,0,0); End; Página 7


Capturar tela procedure TForm1.Button1Click(Sender: TObject); var BackgroundCanvas : TCanvas; Background : TBitmap; {bitmap holding the background } DC : hDC; begin // get the background bitmap Background:= TBitmap.Create; Background.Width:= Width; Background.Height:= Height; DC:= GetDC (0); BackgroundCanvas:= TCanvas.Create; BackgroundCanvas.Handle:= DC; // stretch the bitmap to the display size (it could be much smaller (preview)) Background.Canvas.CopyRect(Rect (0, 0, Width, Height), BackgroundCanvas, Rect (0, 0, Screen.Width, Screen.Height)); BackgroundCanvas.Free; image1.Picture.Bitmap:= Background; end;

Subtrair/adicionar N meses a uma data // Para acrescentar 1 mês a data de hoje: Edit1.text:= DATETOSTR(INCMONTH(DATE,1)); // Para subtrair é só colocar o número de meses negativo

Data por extenso

Edit1.text:= FormatDateTime('"São Paulo, "dddd", "d" de "mmmm" de "yyyy',date);

Habilitar e desabiliar a senha do pr otetor de tela Inclua a unit REGISTRY na clausula uses do seu form. // Habilita var Registry: TRegistry; begin Registry := TRegistry.Create; Registry.RootKey := HKEY_CURRENT_USER; Registry.OpenKey('\Control Panel\Desktop', TRUE); Registry.WriteInteger('ScreenSaveUsePassword',$0); Registry.CloseKey; Registry.Free; end;

Página 8


// Desabilita procedure TForm1.Button2Click(Sender: TObject); var Registry: TRegistry; begin Registry := TRegistry.Create; Registry.RootKey := HKEY_CURRENT_USER; Registry.OpenKey('\Control Panel\Desktop', TRUE); Registry.WriteInteger('ScreenSaveUsePassword',$1); Registry.CloseKey; Registry.Free; end;

Sobrescrevendo um evento Para executar algo antes do evento Showmodal por exemplo, utilize o seguinte: public function showmodal: integer; function TMeuForm.Showmodal : integer; begin { Aqui vai tudo que se precisa fazer antes } result := inherited showmodal; end;

Como evitar a mensagem de erro Key Violation No evento OnEnter do TEdit coloque:

procedure TForm1.Edit1Enter(Sender: TObject); begin Edit1.Selstart:= Length(Edit1.text); end;

Como evitar a mensagem de erro Key Violation Inclua a unit DBITYPES na clausula uses do seu form.

procedure TForm1.Table1PostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction); begin if EDBEngineError(E).Errors[0].ErrorCode = 9729 then ShowMessage('Registro já existe!'); Action:= daAbort; end;

Página 9


Executar um PACK em tabelas Paradox Inclua a unit DBIPROCS na clausula uses do seu form. procedure TForm1.ParadoxPack(Table : TTable); var TBDesc : CRTblDesc; hDb: hDbiDb; TablePath: array[0..dbiMaxPathLen] of char; begin Table.Open; FillChar(TBDesc,Sizeof(TBDesc),0); with TBDesc do begin StrPCopy(szTblName,Table.TableName); StrPCopy(szTblType,szParadox); bPack := True; end; hDb := nil; Check(DbiGetDirectory(Table.DBHandle, True, TablePath)); Table.Close; Check(DbiOpenDatabase(nil, 'STANDARD', dbiReadWrite, dbiOpenExcl,nil,0, nil, nil, hDb)); Check(DbiSetDirectory(hDb, TablePath)); Check(DBIDoRestructure(hDb,1,@TBDesc,nil,nil,nil,False)); Table.Open; end; Como utili zar: procedure TForm1.Button1Click(Sender: TObject); begin ParadoxPack(table1); end;

Verificar se o registro está travado

Inclua a unit DBITYPES na clausula uses do seu form. function TForm1.IsRecordLocked(Table: TTable; ByAnyone: boolean): Boolean; var Locked: BOOL; hCur: hDBICur; rslt: DBIResult; begin Table.UpdateCursorPos; // Is the record locked by the current session... Check(DbiIsRecordLocked(Table.Handle, Locked)); Página 10


Result := Locked; // If the current session does not have a lock and the ByAnyone varable is // set to check all sessions, continue check... if (Result = False) and (ByAnyone = True) then begin // Get a new cursor to the same record... Check(DbiCloneCursor(Table.Handle, False, False, hCur)); try // Try and get the record with a write lock... rslt := DbiGetRecord(hCur, dbiWRITELOCK, nil, nil); if rslt <> DBIERR_NONE then begin // if an error occured and it is a lock error, return true... if HiByte(rslt) = ERRCAT_LOCKCONFLICT then Result := True else // If some other error happened, throw an exception... Check(rslt); end else // Release the lock in this session if the function was successful... Check(DbiRelRecordLock(hCur, False)); finally // Close the cloned cursor... Check(DbiCloseCursor(hCur)); end; end; end; Como util izar: procedure TForm1.Button1Click(Sender: TObject); begin If IsRecordLocked(Table1,True) then Showmessage('Registro Travado!'); end;

Página 11


Cursor customizado Criar um arquivo de recurso com o cursor (vamos chamá-lo de teste.res) Vamos chamar o recurso de CUR_1 Coloque {$R teste.res} na seção implementation procedure InsereCursor(Num : Smallint); begin Screen.Cursors[Num]:= LoadCursor(hInstance, PChar('CUR_1')); Screen.Cursor := Num; end;

Criando atalhos

Inclua as units ShlObj, ActiveX, ComObj, Registry na clausula uses do seu form. Na seção type coloque: TShortcutPlace = (stDesktop, stStartMenu); E por fim a procedure para realizar o trabalho: procedure TForm1.CreateShortcut (FileName, Parameters, InitialDir, ShortcutName, ShortcutFolder : String; Place: TShortcutPlace); var MyObject : IUnknown; MySLink : IShellLink; MyPFile : IPersistFile; Directory : String; WFileName : WideString; MyReg : TRegIniFile; begin MyObject := CreateComObject(CLSID_ShellLink); MySLink := MyObject as IShellLink; MyPFile := MyObject as IPersistFile; with MySLink do begin SetArguments(PChar(Parameters)); SetPath(PChar(FileName)); SetWorkingDirectory(PChar(InitialDir)); end; MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer'); if Place = stDesktop then Directory := MyReg.ReadString ('Shell Folders','Desktop',''); if Place = stStartMenu then begin Página 12


Directory := MyReg.ReadString('Shell Folders', 'Start Menu','') + '\' + ShortcutFolder; CreateDir(Directory); end; WFileName := Directory + '\' + ShortcutName + '.lnk'; MyPFile.Save (PWChar (WFileName), False); MyReg.Free; end;

Emular o pressionamento de uma tecla keybd_event(65,0,0,0); Será enviado o 'A' para o componente que estiver em foco.

Fechar um aplic ativo a partir do Delphi

procedure TForm1.Button1Click(Sender: TObject); var hHandle : THandle; begin hHandle := FindWindow( nil, 'Form1'); if hHandle <> 0 then SendMessage( hHandle, WM_CLOSE, 0, 0); end;

Configurar o Delphi para acessar tabelas do Access • • • • •

•

•

• • •

•

Execute o BDE, abra a paleta CONFIGURATION, Click em Drivers – Native – MsAccess Uma janela de configuração com várias opções será aberta. Configure a DLL32 para IDDA032.DLL ACESS 95 ou IDDA3532.DLL ACESS 97. Na opção SYSTEM DATABASE, aponte para o arquivo System.mdw do Acess que geralmente está no subdiretório \Msoffice\Access. Salve a configuração e após isto é só criar seu alias (se já ouver algum criado, delete e configure de novo). Com essa informação em mãos, faça o programa não pedir o prompt de login (a da senha), colocando um TDatabase no projeto. Escolha o alias que você criou na propriedade AliasName. Altere LoginPrompt para False. Na propriedade DatabaseName, coloque um nome qualquer (servirá como substituto do alias em todas as TTable e TQuery que acessem esse BD). Altere a propriedade AliasName de todas as TTables e TQueries que acessem essas tabelas para o nome que você definiu em DatabaseName no TDatabase.

Página 13


Apagar um subdiretório Inclua a unit SHELLAPI na clausula uses do seu form. procedure DeleteDir( hHandle : THandle; Const sPath : String ); var OpStruc: TSHFileOpStruct; FromBuffer, ToBuffer: Array[0..128] of Char; begin fillChar( OpStruc, Sizeof(OpStruc), 0 ); FillChar( FromBuffer, Sizeof(FromBuffer), 0 ); FillChar( ToBuffer, Sizeof(ToBuffer), 0 ); StrPCopy( FromBuffer, sPath); With OpStruc Do Begin Wnd:= hHandle; wFunc:=FO_DELETE; pFrom:= @FromBuffer; pTo:= @ToBuffer; fFlags:= FOF_NOCONFIRMATION; fAnyOperationsAborted:=False; hNameMappings:=nil; //lpszProgressTitle:=nil; End; ShFileOperation(OpStruc); end; Como util izar: procedure TForm1.Button1Click(Sender: TObject); begin DeleteDir( Self.Handle,'C:\TESTE'); end;

Testar a impr essora

Function TForm1.PrinterOnLine : Boolean; Const PrnStInt : Byte = $17; StRq : Byte = $02; PrnNum : Word = 0; { 0 para LPT1, 1 para LPT2, etc. } Var nResult : byte; Begin Asm mov ah,StRq; mov dx,PrnNum; Int $17; Página 14


mov nResult,ah; end; PrinterOnLine := (nResult and $80) = $80; end; Como util izar: procedure TForm1.Button1Click(Sender: TObject); begin If not PrinterOnLine then ShowMessage('Verifique a Impressora!'); end;

Validar datas try StrToDate(Edit1.Text); except on EConvertError do ShowMessage ('Data Inválida!'); end;

Procurar arquivos procedure TForm1.DirList( ASource : string; ADirList : TStringList ); var SearchRec : TSearchRec; Result : integer; begin Result := FindFirst( ASource, faAnyFile, SearchRec ); if Result = 0 then while (Result = 0) do begin if (SearchRec.Name+' ')[1] = '.' then { Se pegou nome de SubDiretorio } begin Result := FindNext( SearchRec ); Continue; end; ADirList.Add( SearchRec.Name ); Result := FindNext( SearchRec ); end; FindClose( SearchRec ); ADirList.Sort; end;

Página 15

Funções para o Delphi Como util izar: procedure TForm1.Button1Click(Sender: TObject); var contador: Integer; lista: TStringlist; begin lista:= TStringlist.create; DirList('C:\*.*', lista); end;

Abrir ar quivos com aplicativo associado Inclua a unit SHELLAPI na clausula uses do seu form. procedure TForm1.ExecFile(F: String); var r: String; begin case ShellExecute(Handle, nil, PChar(F), nil, nil, SW_SHOWNORMAL) of ERROR_FILE_NOT_FOUND: r := 'The specified file was not found.'; ERROR_PATH_NOT_FOUND: r := 'The specified path was not found.'; ERROR_BAD_FORMAT: r := 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).'; SE_ERR_ACCESSDENIED: r := 'Windows 95 only: The operating system denied access to the specified file.'; SE_ERR_ASSOCINCOMPLETE: r := 'The filename association is incomplete or invalid.'; SE_ERR_DDEBUSY: r := 'The DDE transaction could not be completed because other DDE transactions were being processed.'; SE_ERR_DDEFAIL: r := 'The DDE transaction failed.'; SE_ERR_DDETIMEOUT: r := 'The DDE transaction could not be completed because the request timed out.'; SE_ERR_DLLNOTFOUND: r := 'Windows 95 only: The specified dynamic-link library was not found.'; SE_ERR_NOASSOC: r := 'There is no application associated with the given filename extension.'; SE_ERR_OOM: r := 'Windows 95 only: There was not enough memory to complete the operation.'; SE_ERR_SHARE: r := 'A sharing violation occurred.'; else Exit; end; ShowMessage(r); end;

Página 16

Funções para o Delphi Como util izar: procedure TForm1.Button1Click(Sender: TObject); begin ExecFile('c:\windows\ladrilhos.bmp'); end;

Fazer um TEdit aceitar apenas números Na rotina abaixo, o TEdit só aceitará números de 0 a 9 e o BackSpace (Chr(8)). Se você quiser a vírgula também, coloque dentro do colchete DecimalSeparator procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin if not (Key in['0'..'9',Chr(8)]) then Key:= #0; end;

Alterar o papel de parede do Windows

procedure TForm1.Button1Click(Sender: TObject); var Arquivo: String; begin Arquivo:= 'c:\windows\bitmap~1.bmp'; SystemParametersInfo(SPI_SetDeskWallPaper, 0, PChar(Arquivo), 0); end;

Extrair o número de cores do modo de vídeo corrente var hnd: THandle; bitsPorPixel: integer; begin hnd:= GetDC( Handle ); bitsPorPixel:= GetDeviceCaps( hnd, BITSPIXEL ); // 8 = 256 cores; 16 = high color; 24 = true color end;

Habilitar e desabilitar barra de tarefas // desabilita procedure hideTaskbar; var wndHandle : THandle; wndClass : array[0..50] of Char; begin StrPCopy(@wndClass[0], 'Shell_TrayWnd'); wndHandle:= FindWindow(@wndClass[0], nil); ShowWindow(wndHandle, SW_HIDE); end;

Página 17


// habilita procedure showTaskbar; var wndHandle : THandle; wndClass : array[0..50] of Char; begin StrPCopy(@wndClass[0], 'Shell_TrayWnd'); wndHandle:= FindWindow(@wndClass[0], nil); ShowWindow(wndHandle, SW_RESTORE); end;

Habilitar e desabilitar c trl+alt+del // desabilita procedure TForm1.Button1Click(Sender: TObject); var numero: integer; begin SystemParametersInfo(97,Word(true),@numero,0); end; // habilita procedure TForm1.Button2Click(Sender: TObject); var numero: integer; begin SystemParametersInfo(97,Word(false),@numero,0); end;

Alterar a data e a hora do sistema procedure TForm1.Button1Click(Sender: TObject); var SystemTime : TSystemTime; begin With SystemTime do begin //Definindo o dia do sistema wYear:= 1996; wMonth:= 5; wDay:= 10; //Definindo a hora do sistema wHour:= 20; //hora wMinute:= 50; //minutos wSecond:= 59; //segundos end; //Colocar a hora e data do sistema SetLocalTime(SystemTime); end; Página 18


Extrair o tamanho de um arquivo function TForm1.TamArquivo(Arquivo: string): Integer; begin with TFileStream.Create(Arquivo, fmOpenRead or fmShareExclusive) do try Result := Size; finally Free; end; end; Como util izar: procedure TForm1.Button1Click(Sender: TObject); begin edit1.text:= inttostr(TamArquivo('CAMINHO\NOMEDOARQUIVO')); end;

Extrair o ícone de um executável Inclua a unit Shellapi na cláusula uses do seu form. Image1.Picture.Icon.Handle:= ExtractIcon(Handle,PChar('c:\windows\calc.exe'),0);

Verificando a memória

var MemoryStatus: TMemoryStatus; begin MemoryStatus.dwLength:= sizeof(MemoryStatus); GlobalMemoryStatus(MemoryStatus); Label1.Caption := 'Total de memória física : ' + IntToStr(MemoryStatus.dwTotalPhys); end; {typedef struct _MEMORYSTATUS DWORD dwLength; // sizeof(MEMORYSTATUS) DWORD dwMemoryLoad; // percentual de memória em uso DWORD dwTotalPhys; // bytes de memória física DWORD dwAvailPhys; // bytes livres de memória física DWORD dwTotalPageFile; // bytes de paginação de arquivo DWORD dwAvailPageFile; // bytes livres de paginação de arquivo DWORD dwTotalVirtual; // bytes em uso de espaço de endereço DWORD dwAvailVirtual; // bytes livres}

Página 19


Número de série do hd Function TForm1.SerialNum(FDrive:String) :String; var Serial: DWord; DirLen, Flags: DWord; DLabel : Array[0..11] of Char; begin Try GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0); Result := IntToHex(Serial,8); Except Result := ''; end; end;

Mapear uma pasta na rede

var err : DWord; PServer, PSenha, PLetra : PChar; Begin PServer := '\\Caminho\Caminho' + #0; PLetra := 'L:'; PSenha := ''; ERR := WNetAddConnection ( PServer , PSenha , PLetra ); CASE ERR of ERROR_ACCESS_DENIED : ShowMessage ( 'Acesso negado.' ); ERROR_ALREADY_ASSIGNED : ShowMessage ( 'A letra do drive especificada já está conectada.' ); ERROR_BAD_DEV_TYPE : ShowMessage ( 'O tipo de dispositivo e o tipo de recurso não são compatíveis.' ); ERROR_BAD_DEVICE : ShowMessage ( 'Letra inválida.' ); ERROR_BAD_NET_NAME : ShowMessage ( 'Nome do servidor não é válido ou não pode ser localizado.' ); ERROR_BAD_PROFILE : ShowMessage ( 'Formato incorreto de parâmetros.' ); ERROR_CANNOT_OPEN_PROFILE : ShowMessage ( 'Conexão permanente não disponível.' ); ERROR_DEVICE_ALREADY_REMEMBERED : ShowMessage ( 'Uma entrada para o dispositivo especificado já está no perfil do usuário.' ); ERROR_EXTENDED_ERROR : ShowMessage ( 'Erro de rede.' ); ERROR_INVALID_PASSWORD : ShowMessage ( 'Senha especificada inválida.' ); ERROR_NO_NET_OR_BAD_PATH : ShowMessage ( 'A operação não foi concluída porque a rede não foi inicializada ou caminho é inválido.' ); ERROR_NO_NETWORK : ShowMessage ( 'A rede não está presente.' ); Página 20


else if Err > 0 then ShowMessage (IntToStr(Err)); end; end;

Pegar nome do usuário na rede function TForm1.usuario : string; var NomedoUsuario : array[0..255] of char; buffSize : DWORD; begin buffSize := sizeOf(NomedoUsuario); GetUserName(@NomedoUsuario, buffSize); result:= NomedoUsuario; end; Como util izar: procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage(usuario) end;

saber o estado das teclas Num lock, Caps lock e Scroll lock Para saber o estado das teclas acima citadas, utilize a função getkeystate em conjunto com o código das teclas, ela retorna 0 se a tecla estiver OFF e 1 se a tecla estiver ON, assim: If getkeystate(vk_numlock) = 0 then // Num lock está OFF If getkeystate(vk_numlock) = 1 then // Num lock está ON If getkeystate(vk_scroll) = 0 then // Scroll lock está OFF If getkeystate(vk_scroll) = 1 then // Scroll lock está ON If getkeystate(vk_CAPITAL) = 0 then // Caps lock está OFF If getkeystate(vk_CAPITAL) = 1 then // Caps lock está ON

Testando drives function TForm1.TemDiscoNoDrive(const drive : char): boolean; var DriveNumero : byte; EMode : word; begin result := false; DriveNumero := ord(Drive); if DriveNumero >= ord('a') then dec(DriveNumero,$20); EMode := SetErrorMode(SEM_FAILCRITICALERRORS); Página 21


try if DiskSize(DriveNumero-$40) <> -1 then Result := true else messagebeep(0); finally SetErrorMode(EMode); end; end; Como util izar: procedure TForm1.Button1Click(Sender: TObject); begin if TemDiscoNoDrive('a') then ShowMessage('Tem disco no drive A:') else ShowMessage('Não tem disco no drive A:'); end;

Executando programas externos

Winexec('Command.com /C Teste.exe',Tipo_de_Janela); Tipo_de_Janela : SW_SHOWNORMAL - Visualização normal da janela SW_MAXIMIZE - Janela maximizada SW_MINIMIZE - Janela minimizada SW_HIDE - Escondido

Reproduzindo sons wav, sem o compon ente mediaplayer Coloque na clásula Uses a unit MMSystem SndPlaySound('C:\Windows\Media\Som.wav',SND_ASYNC);

Manipular arquivos INI Inclua a unit IniFiles na clausula uses do seu form. Procedure TForm1.GravaIni( Numero : Longint ; Texto : String ; Condicao : Boolean); var ArqIni : TIniFile; begin ArqIni := TIniFile.Create('c:\windows\temp\Teste.Ini'); Try ArqIni.WriteInteger('Dados', 'Numero', Numero); ArqIni.WriteString('Dados', 'Texto', Texto); Página 22


ArqIni.WriteBool('Dados', 'Condição', Condicao); Finally ArqIni.Free; end; end; Procedure TForm1.LeIni( Var Numero : Longint ; Var Texto : String ; Var Condicao : Boolean); var ArqIni : tIniFile; begin ArqIni := tIniFile.Create('c:\windows\temp\Teste.Ini'); Try Numero := ArqIni.ReadInteger('Dados', 'Numero', Numero ); Texto := ArqIni.ReadString('Dados', 'Texto', Texto ); Condicao := ArqIni.ReadBool('Dados', 'Condição', Condicao ); Finally ArqIni.Free; end; end; Como utili zar: procedure TForm1.Button1Click(Sender: TObject); begin GravaIni(1234,'TESTE',True); end;

procedure TForm1.Button2Click(Sender: TObject); var N: Integer; T: String; C: Boolean; begin LeIni(N,T,C); Showmessage(IntToStr(N)+' '+T); end;

Exponenciação

Inclua a unit Math na clausula uses do seu form. Depois disso utilize a função Power. Edit1.text:= FloatToStr(Power(2,4));

Página 23


Aguardar um deter minado nº de segundos procedure TForm1.Delay(Tempo: Word); var x1: Double; begin x1:= now; repeat until ((now-x1)*86400) > Tempo; end;

Tecla ENTER funcionar como TAB

Setar a propriedade KeyPreview do Form para True. Setar a propriedade Default de todos os botões do Form para False. Criar um evento OnKeyPress para o Form como este: Procedure Tform1.FormKeyPress(Sender: Tobject; var Key: Char); begin If key = #13 then Begin Key:= #0; Perform(Wm_NextDlgCtl,0,0); end; end;

Utilizar ponto para separar decimais

Você pode combinar a variável DecimalSeparator, ThousandSeparator do Delphi com o evento OnKeyPress: procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin If key = '.' then key:= DecimalSeparator; end;

Criando um Splash Screen (abertura)

Você pode criar uma tela de abertura no seu programa em Delphi. Após ter criado um formulário principal, crie um formulário para a tela de abertura. Aqui iremos chamá-lo de ABERTURAFORM. Depois de criar os dois formulários, clique no menu VIEW, na opção PROJECT SOURCE, que permite que seja exibido o código do arquivo principal do projeto. Localize no código a linha em que o formulário de abertura é criado e apague-a (ou coloque em modo de observação, inserindo // no início da linha). Linha que deve ser apagada: begin Página 24


... Application.CreateForm(TAberturaForm, AberturaForm); // Esta linha deve ser apagada ... end; Após remover a linha acima, insira as linhas abaixo antes da criação dos demais formulários do seu aplicativo: Linhas que devem ser inseridas: begin AberturaForm:= TAberturaForm.Create(Application); AberturaForm.show {Os demais formulários devem ser criados aqui} ... AberturaForm.Hide; AberturaForm.Free; Application.Run; End; Os comandos... AberturaForm:= TAberturaForm.Create(Application); - cria o formulário AberturaForm.Show - exibe o formulário de abertura na tela AberturaForm.Hide; - esconde o formulário de abertura AberturaForm.Free; - tira o formulário da memória

Como limpar todos os edits de um form

procedure TForm1.Button1Click(Sender: TObject); var i : integer; begin for i := 0 to ComponentCount-1 do begin If Components[i].ClassName = 'TEdit' then Tedit(Components[i]).clear; // ou TEdit(components[i]).text:= '' end; end;

Página 25


Formatar números com zeros à esquerda var Numero: Integer; begin Numero:= 123; Edit1.text:= Format('%5.5d',[Numero]); // resulta '00123'; end;

Obrigar a digitação de caracteres maiúsculos num campo memo procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char); begin Key:= Upcase(Key); end;

Imprimindo um campo memo via Canvas Coloque na clásula Uses a unit printers

procedure TForm1.Button1Click(Sender: TObject); var i, altura : Integer; sMemo : String; begin With Printer do begin Title:= 'Imprimindo memo'; BeginDoc; With Canvas do begin altura := TextHeight('A'); for i := 1 to Memo1.Lines.Count do begin sMemo := Memo1.Lines[I]; TextOut(1, (i - 1) * Altura, sMemo); end; end; EndDoc; end; end;

Página 26


Procura e substituição de string num c ampo memo Procedure FindReplace (const Enc, subs: String; Var Texto: TMemo); Var i, Posicao: Integer; Linha: string; Begin For i:= 0 to Texto.Lines.count - 1 do begin Linha := Texto. Lines[i]; Repeat Posicao:=Pos(Enc,Linha); If Posicao > 0 then Begin Delete(Linha,Posicao,Length(Enc)); Insert(Subs,Linha,Posicao); Texto.Lines[i]:=Linha; end; until Posicao = 0; end; end; Como util izar: Procedure TForm1.Button1Click (Sender: TObject); Begin FindReplace(Edit1.Text,Edit2.Text, Memo1); end;

Pegando a linh a e coluna atuais de um memo With Memo1 do begin Line:= Perform(EM_LINEFROMCHAR,SelStart, 0); Column:= SelStart - Perform(EM_LINEINDEX, Line, 0); end;

Trocando a cor de uma célula num DBGrid No evento onDrawColumnCell do dbgrid coloque o código para mudar a cor da fonte do dbgrid e a chave do método para "desenhar" os dados. procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if (Column.Field.FieldName = 'NOMEDOCAMPO') then begin if condição then // coloque aqui sua condição begin Página 27


DBGrid1.Canvas.Brush.Color:= clAqua; DBGrid1.Canvas.Font.Color:= clWindowText; DBGrid1.Canvas.FillRect(Rect); DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State); end; end; end;

Trocando a cor da fonte num DBGrid Coloque a propriedade defaultdrawdata do dbgrid em FALSE; No evento onDrawColumnCell do dbgrid coloque o código para mudar a cor do font do dbgrid e a chave do método para "desenhar" os dados. procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin If Condição then Dbgrid1.Canvas.Font.Color:= clFuchsia; // coloque aqui a cor desejada Dbgrid1.DefaultDrawDataCell(Rect, dbgrid1.columns[datacol].field, State); end;

Gerenciando m ais de uma linha selecionada num DBGrid (Multiselect)

O DBGrid tem uma propriedade não documentada chamada SelectedRows (Tbookmark). Com ela você pode gerenciar Multiselect da seguinte forma: var contador: Integer; begin With Dbgrid1 do Begin for contador:= 0 to Pred(SelectedRows.Count) do Begin Datasource.Dataset.Bookmark:= SelectedRows[contador]; // posiciona nos registros selecionados do DBGrid end; end;

Página 28


Commit (Delphi 3) Inclua DBISaveChanges(Nome da Tabela.handle) no evento After Post. Inclua em uses a biblioteca DBIProcs. procedure TForm1.Table1AfterPost(DataSet: TDataSet); begin DBISaveChanges(TTable(Dataset).handle); end;

Commit (Delphi 2)

Inclua DBISaveChanges(Nome da Tabela.handle) no evento After Post. Inclua em uses a biblioteca DBIProcs. procedure TForm1.Table1AfterPost(DataSet: TDataSet); begin DBISaveChanges(Table1.handle); end;

Extrair o número do registro atual em tabelas Paradox ou Dbase Inclua a unit BDE na clausula uses do seu form.

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField); var CP: CurProps; RP: RecProps; RecID: Longint; begin with Table1 do begin UpdateCursorPos; Check(DbiGetCursorProps(Handle, CP)); Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @RP)); if StrComp(CP.szTableType, szDBASE) = 0 then RecID := RP.iPhyRecNum else if StrComp(CP.szTableType, szPARADOX) = 0 then RecID := RP.iSeqNum else raise EDatabaseError.Create('ERRO! Não é uma tabela Paradox ou dBASE.'); end; Label1.Caption:= IntToStr(RecID) +' de '+ IntToStr(Table1.recordcount); end;

Página 29


Alterando Idapi32.Cfg Via Programa Substitua AliasName pelo nome do alias que você quer criar e em AliasPath pelo path dos arquivos de dados que você quer no seu alias. Inclua na cláusula "USES" as units BD e BDE. Check(DbiAddAlias(Nil, PChar(' AliasName '), Nil, PChar(' AliasPath'), True));

Criando tabelas

var Tabela: TTable; Indices: TIndexOptions; begin Tabela:= TTable.Create; Indices:= [ixPrimary, IxUnique]; with Tabela do begin active:= false; databasename:= 'c:\teste'; tablename:= 'Tabela'; tabletype:= ttDefault; fielddefs.clear; fielddefs.add('Codigo', ftInteger, 0, false); ... indexdefs.clear; indexdefs.add('Codigo_Chave', 'codigo', Indices); CreateTable; end;

Página 30


Data por extenso no Quickr eport var nrdia: Integer; diasemana: array[1..7] of String; meses: array[1..12] of String; dia, mes, ano: Word; begin diasemana[1]:= 'Domingo'; diasemana[2]:= 'Segunda-feira'; diasemana[3]:= 'Terça-feira'; diasemana[4]:= 'Quarta-feira'; diasemana[5]:= 'Quinta-feira'; diasemana[6]:= 'Sexta-feira'; diasemana[7]:= 'Sábado'; meses[1]:= 'Janeiro'; meses[2]:= 'Fevereiro'; meses[3]:= 'Março'; meses[4]:= 'Abril'; meses[5]:= 'Maio'; meses[6]:= 'Junho'; meses[7]:= 'Julho'; meses[8]:= 'Agosto'; meses[9]:= 'Setembro'; meses[10]:= 'Outubro'; meses[11]:= 'Novembro'; meses[12]:= 'Dezembro'; DecodeDate(DATE,ano,mes,dia); nrdia:= DayOfWeek(DATE); QRLabel1.Caption:= diasemana[nrdia]+', '+INTTOSTR(dia)+' de '+meses[mes]+' de '+INTTOSTR(ano);

Filtrando registros com o Quickrepor t (Delphi 2)

Você deve usar o evento OnFilter do componente Quickreport. O mesmo possui a variável PrintRecord do tipo Boolean. Para que o registro não seja impresso, basta atribuir False a esta variável. procedure TForm1.QuickReport1Filter(var PrintRecord: Boolean); begin PrintRecord:= ( table1salario.value > 200 ); end;

Página 31


Extraindo o ano, mês ou dia de uma data via SQL Select * from nome_tabela where extract(year from campo_data) = 1997 Você pode extrair o mês (MONTH) ou o dia (DAY).

Cria um clone Monocromático de um outr o Bitmap function CreateDisabledBitmap(FOriginal: TBitmap; OutlineColor: TColor): TBitmap; // Use-a assim: // image2.picture.Bitmap := CreateDisabledBitmap(Image1.Picture.Bitmap, clBtnFace); const ROP_DSPDxax = $00E20746; var MonoBmp: TBitmap; IRect: TRect; begin IRect := Rect(0, 0, FOriginal.Width, FOriginal.Height); Result := TBitmap.Create; try Result.Width := FOriginal.Width; Result.Height := FOriginal.Height; MonoBmp := TBitmap.Create; try with MonoBmp do begin Assign(FOriginal); {$IFDEF S_D3} HandleType := bmDDB; {$ENDIF} Canvas.Brush.Color := clBlack; if Monochrome then begin Canvas.Font.Color := clWhite; Monochrome := False; Canvas.Brush.Color := clWhite; end; Monochrome := True; end; with Result.Canvas do begin Brush.Color := OutlineColor; FillRect(IRect); Brush.Color := clBtnHighlight; SetTextColor(Handle, clBlack); SetBkColor(Handle, clWhite); Página 32


BitBlt(Handle, 1, 1, IRect.Right - IRect.Left, IRect.Bottom - IRect.Top, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax); Brush.Color := clBtnShadow; SetTextColor(Handle, clBlack); SetBkColor(Handle, clWhite); BitBlt(Handle, 0, 0, IRect.Right - IRect.Left, IRect.Bottom - IRect.Top, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax); End; finally MonoBmp.Free; end; except Result.Free; raise; end; end;

Gerar Planilha no Excel Var Excel : Variant; Linha : Inteiro; begin QryExtrato.Open; Excel := CreateOleObject('Excel.Application'); Excel.Visible := True; Excel.Workbooks.Add; Excel.WorkBooks[1].Sheets[1].Cells[1,1] := 'Código'; Excel.WorkBooks[1].Sheets[1].Cells[1,2] := 'Vendedor'; Excel.WorkBooks[1].Sheets[1].Cells[1,3] := 'Tipo Negociação'; Excel.WorkBooks[1].Sheets[1].Cells[1,4] := 'Cliente'; Excel.WorkBooks[1].Sheets[1].Cells[1,5] := 'Nº Tit.'; // adicione os campos desejados, seguindo a seqüência acima Linha := 2; // começando a lançar dados na segunda linha With QryExtrato do while not EOF do begin Excel.WorkBooks[1].Sheets[1].Cells[Linha,1] := QuotedStr(FieldByName('cdbeneficiario').AsString); Excel.WorkBooks[1].Sheets[1].Cells[Linha,2] := FieldByName('novendedor').Value; Excel.WorkBooks[1].Sheets[1].Cells[Linha,3] := FieldByName('notiponegociacao').Value; Excel.WorkBooks[1].Sheets[1].Cells[Linha,4] := FieldByName('nome').Value; Página 33


Excel.WorkBooks[1].Sheets[1].Cells[Linha,5] := FieldByName('num_titular').AsInteger;\ // adicione os campos desejados, seguindo a seqüência acima Linha := Linha + 1; Next; end; Excel.WorkBooks[1].SaveAs('caminho do arquivo a ser salvo');

DBGrid, Ocultando Colunas Dinamicamente com Popup procedure Tform1.AjustarColunasDoGrid( Grid : TDBGrid; PopMenu : TPopupMenu); var vItemMenu : TMenuItem; vCont : Integer; begin { Faz um loop nas colunas do menu } for vCont := 0 to Grid.Columns.Count -1 do begin { Cria um item de menu e define algumas propriedades } vItemMenu := TMenuItem.Create(Self); vItemMenu.Caption := Grid.Columns[ vCont].DisplayName; { Caption } vItemMenu.Checked := True; { Marcado } vItemMenu.Name := 'PM' + Grid.Name + '_' + IntToStr(vCont); { Nome não muito aconselhável por o nome, mas fica mais fácil achar ele depois } vItemMenu.OnClick := MenuClick; { Associa o evento do clique } PopMenu.Items.Add( vItemMenu); { Adiciona o mesmo ao menu } end; { Associa o grid ao menu } Grid.PopupMenu := PopMenu; end; procedure Tform1.MenuClick(Sender : TObject); var vNomeMenu : String; vNomeGrid : String; vNroColum : Integer; vGrid : TDBGrid; begin { Aqui pega o nome do item de menu } vNomeMenu := (Sender as TMenuItem).Name; { Pega o nome do grid } Página 34


vNomeGrid := Copy(vNomeMenu, 3, Pos('_', vNomeMenu) - 3); { Pega o numero da coluna, aumente o 3 no final se tiver mais que 999 colunas... } vNroColum := StrToInt( Copy( vNomeMenu, Pos('_', vNomeMenu) + 1 , 3)); { Pega uma referencia o componente grid associado } vGrid := (Self.FindComponent(vNomeGrid) as TDBGrid); { Ajusta o check do item de menu... marca se estiver desmarcado ou vice versa } (Sender as TMenuItem).Checked := not (Sender as TMenuItem).Checked; { enfim, mostra ou oculta a coluna de acordo com o menu } vGrid.Columns[ vNroColum].Visible := (Sender as TMenuItem).Checked; end; procedure Tform1.FormCreate(Sender: TObject); begin { Chame a função passando apenas o nome do grid e do popup menu } AjustarColunasDoGrid( grdiProduto, PopupMenu); end;

Transformar de minutos para horas function MinutesToHours(const Min: integer): string; const MinSeparator: array[boolean] of string = (':', ':0'); begin Result := FormatFloat('0,', Min div 60) + MinSeparator[Min mod 60 < 10] + IntToStr(Min mod 60); end;

Campo auto incremento no Oracle e no Interbase É interessante coloc ar o código no evento B eforeOpen ou em OnNewRecord Exemplo no Oracle: Var qry_Codigo : TADOQuery; begin if DseVenda.state in [DsInsert] then begin //Recupera o código da venda do banco de dados utilizando a sequencia criada qry_Codigo := TADOQuery.Create(Self); qry_Codigo.Connection := frm_Menu.Connection; qry_Codigo.SQL.Add('Select custom.seq_venda.nextval from dual'); qry_Codigo.Open; DseVenda.FieldByName('cdvenda').Value :=

Página 35


qry_Codigo.FieldByName('NEXTVAL').Value; qry_Codigo.Free; end; Exemplo no Interbase: Var Qry_ID : TADOQuery; begin Try Qry_ID := TADOQuery.Create(Self); Qry_ID.Connection := frm_Menu.Connection; Qry_ID.SQL.Add('select gen_id(GEN_CLIENTE, 1) from rdb$database'); Qry_ID.Open; DsePrincipal.FieldByName('id').AsInteger := Qry_ID.FieldByName('gen_id').AsInteger; DsePrincipal.FieldByName('dtcadastro').AsDateTime := Date; CmbClassificacao.SetFocus; Qry_ID.Free; except ShowMessage('Erro ao gerar ID. Contacte o suporte técnico.'); Qry_ID.Free; end;

Como desativar a proteção de tela Na seção Private do form adicione: procedure AppMsg(var Msg: TMsg; var Handled: Boolean); Na seção Implementation adicione : procedure TForm1.AppMsg(var Msg: TMsg; var Handled: Boolean); begin if (Msg.Message = wm_SysCommand) and (Msg.wParam = sc_ScreenSave) then Handled := true; end; No evento OnCreate do form adicione: Application.OnMessage := AppMsg; Coloque o seguinte código no evento onClick de um TButton: procedure TForm1.Button1Click(Sender: TObject); begin SendMessage(Application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0); end; Página 36


Gira o texto Procedure TForm1.Button1Click(Sender: TObject); var lf : TLogFont; tf : TFont; i : integer; begin with Form1.Canvas do begin Font.Name := 'Verdana'; Font.Size := 16; tf := TFont.Create; tf.Assign(Font); GetObject(tf.Handle, sizeof(lf), @lf); lf.lfOrientation := 1000; end; For i:= 50000 Downto 1 do Begin lf.lfEscapement := i; tf.Handle := CreateFontIndirect(lf); Form1.Canvas.Font.Assign(tf); Form1.Canvas.TextOut(200, Height div 2, 'Edgar da Cruz'); //Sleep(10); Este pode cria um Delay na execução

end; tf.Free; end;

Hint Redondo unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Commctrl, ExtCtrls; type TForm1 = class(TForm) Memo1: TMemo; Button1: TButton; Button2: TButton; Button3: TButton; Panel1: TPanel; procedure FormCreate(Sender: TObject); Página 37


private { Private declarations } public { Public declarations } end; const TTS_BALLOON = $40; TTM_SETTITLE = (WM_USER + 32); var Form1: TForm1; hTooltip: Cardinal; ti: TToolInfo; buffer : array[0..255] of char; implementation {$R *.DFM} procedure CreateToolTips(hWnd: Cardinal); begin hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or TTS_BALLOON, Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), hWnd, 0, hInstance, nil); if hToolTip <> 0 then begin SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); ti.cbSize := SizeOf(TToolInfo); ti.uFlags := TTF_SUBCLASS; ti.hInst := hInstance; end; end; procedure AddToolTip(hwnd: dword; lpti: PToolInfo; IconType: Integer; Text, Title: PChar); var Item: THandle; Rect: TRect; begin Item := hWnd; if (Item <> 0) AND (GetClientRect(Item, Rect)) then Página 38


begin lpti.hwnd := Item; lpti.Rect := Rect; lpti.lpszText := Text; SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti)); FillChar(buffer, sizeof(buffer), #0); lstrcpy(buffer, Title); if (IconType > 3) or (IconType < 0) then IconType := 0; SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer)); end; end; procedure TForm1.FormCreate(Sender: TObject); begin CreateToolTips(Form1.Handle); //A linha abaixo usa o hint definido no objeto //A linha abaixo usa um hint mais personalizado AddToolTip(Memo1.Handle, @ti, 0, 'Saiba mais...'+chr(13)+ 'Esta caixa contém algumas dicas sobre:'+chr(13)+ 'Como enviar sua mensagem...'+chr(13)+ 'Como receber suas mensagens...'+chr(13)+ 'e muito mais...', 'Mensagem a ser enviada'); AddToolTip(Button1.Handle, @ti, 1, 'Incluir dados', ''); // AddToolTip(Button2.Handle, @ti, 2, 'Excluir dados', ''); // AddToolTip(Button3.Handle, @ti, 2, 'Alterar dados', 'Mensagem'); end; end. end. Observação: TipoDoIcone pode ser:

0 - Sem Ícone 1 - Informação 2 - Aviso 3 - Erro A unit COMMCTRL deve ser acrescentada.

Página 39


Informar a velocidade do Processador

Esta interessante função recupera a velocidade de processamento aproximada da CPU: const ID_BIT=$200000; // EFLAGS ID bit function GetCPUSpeed: Double; const DelayTime = 500; var TimerHi, TimerLo: DWORD; PriorityClass, Priority: Integer; begin try PriorityClass := GetPriorityClass(GetCurrentProcess); Priority := GetThreadPriority(GetCurrentThread); SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS); SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL); Sleep(10); asm dw 310Fh // rdtsc mov TimerLo, eax mov TimerHi, edx end; Sleep(DelayTime); asm dw 310Fh // rdtsc sub eax, TimerLo sbb edx, TimerHi mov TimerLo, eax mov TimerHi, edx end; SetThreadPriority(GetCurrentThread, Priority); SetPriorityClass(GetCurrentProcess, PriorityClass); Result := TimerLo / (1000.0 * DelayTime); except end; end; No evento OnClick, basta atribuir a saída da funçao a uma string: procedure TForm1.Button1Click(Sender: TObject); Página 40


var cpuspeed:string; begin cpuspeed:=Format('%f MHz', [GetCPUSpeed]); edit1.text := cpuspeed; end;

Instalar quickreport no delphi 7 Vai em Component / Install Packages, clique em "ADD" abra seguinte pasta : C:\Arquivos ProgramasBorlandDelphi7_in. selecione o arquivo " dclqrt70.bpl " clique em Abrir Pronto! CRIANDO UMA MARCA D´AGUA Procedure TForm1.Button1Click(Sender: TObject); var X, Y : Integer; begin brush.style := bsClear; for y:=0 to image1.height-1 do for x:=0 to image1.width-1 do begin if (x mod 2)=(y mod 2) then image1.canvas.pixels[x,y]:=clWhite; end; end;

Mostra e esconde ícones da área de trabalho Para esconder: ShowWindow(FindWindow(ni l ,'Program Manager'),SW_HIDE); Para mostrar: ShowWindow(FindWindow(ni l ,'Program Manager'),SW_SHOW);

Alterando o papel de parede Program wallpapr;

uses Registry, WinProcs; procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean ); var reg : TRegIniFile; begin Página 41


// Mudando o Registro HKEY_CURRENT_USER // Control Panel\Desktop // TileWallpaper (REG_SZ) // Wallpaper (REG_SZ) reg := TRegIniFile.Create('Control Panel\Desktop' ); with reg do begin WriteString( '', 'Wallpaper',sWallpaperBMPPath ); if( bTile )then begin WriteString( '', 'TileWallpaper', '1' ); end else begin WriteString( '', 'TileWallpaper', '0' ); end; end; reg.Free; // Mostrar que o parametro do sistema foi alterado SystemParametersInfo( SPI_SETDESKWALLPAPER,0, Nil, SPIF_SENDWININICHANGE ); end; begin SetWallpaper( 'c:\winnt\winnt.bmp', False ); end.

Salvar a tela em BMP function CaptureScreenRect( ARect: TRect ): TBitmap; var ScreenDC: HDC; begin Result := TBitmap.Create; with Result, ARect do begin Width := Right - Left; Height := Bottom - Top; ScreenDC := GetDC( 0 ); try BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY ); finally ReleaseDC( 0, ScreenDC ); end; // Palette := GetSystemPalette;

end; end; Como util izar: Image1.picture.Assign(CaptureScreenRect(Rect(0,0,Width,Height)));

Página 42


Usando o Word dentr o do Delphi procedure TFrmFactoring.ActnContratoExecute(Sender: TObject); var MSWord : variant; begin Msword:=createoleObject('Word.Basic'); Msword.AppShow; Msword.fileopen('c: actoringdocscontrato.doc'); end; Observação: Incluir COMOBJ na cláusula Uses.

Usando as setas para navegar nos campos procedure TFrm._Exemplo_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (key = 40) then // seta para baixo begin key := 0; Selectnext((Sender As TWinControl),true,true); // proximo end; if (key = 38) then // seta para cima begin key := 0; Selectnext((Sender As TWinControl),false,true); // anterior end; end; Observação: Usar no evento KeyDown de um determinado Edit

Função para validar o PIS function validapis(Dado : String) : boolean; {Testa se o número do pis é válido ou não} var i, wsoma, Wm11, Wdv,wdigito : Integer; begin if AllTrim(Dado) <> '' Then begin wdv := strtoint(copy(Dado, 11, 1)); wsoma := 0; wm11 := 2; for i := 1 to 10 do Página 43


begin wsoma := wsoma + (wm11 *strtoint(copy(Dado,11 - I, 1))); if wm11 < 9 then begin wm11 := wm11+1 end else begin wm11 := 2; end; end; wdigito := 11 - (wsoma MOD 11); if wdigito > 9 then begin wdigito := 0; end; if wdv = wdigito then begin validapis := true; end else begin validapis := false; end; end; end;

Calcular a idade usando o MaskEdit Primeiro coloque em seu form um componente MasKEdit e mude a mascara dele no campo Edita Mask, para ##/##/####, depois coloque um edit e um button altere os nomes deles como o exemplo abaixo procedure TForm1.Button1Click(Sender: TObject); var DataHoje,DataNasc:TDate; HAno,HMes,HDia,NAno,NMes,NDia:Word; Dia,Mes,Ano:Integer; begin DataHoje:=Now; DecodeDate(DataHoje,HAno,HMes,HDia); DataNasc:=StrToDate(Nasc.Text); DecodeDate(DataNasc,NAno,NMes,NDia); Dia:=(HDia - NDia); Página 44


Mes:=(HMes - NMes); Ano:=(HAno - NAno); if(Mes < 0)and(Dia < 0)then begin ID.Clear; ID.Text:=IntToStr(Ano - 1); end else if (Mes < 0)and(Dia >=0)then begin ID.Clear; ID.Text:=IntToStr(Ano - 1); end else if (Mes > 0)and(Dia >= 0)then begin ID.Clear; ID.Text:=IntToStr(Ano); end else if (Mes > 0)and(Dia < 0)then begin ID.Clear; ID.Text:=IntToStr(Ano); end else if(Mes = 0)and(Dia >= 0)then begin ID.Clear; ID.Text:=IntToStr(Ano); end else if(Mes = 0)and(Dia < 0)then begin ID.Clear; ID.Text:=IntToStr(Ano - 1); end; end;

Como definir seu próprio hotkey (Tecla Quente) Primeiro fixe a propriedade KeyPreview do Form para TRUE procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (ssCtrl in Shift) and (chr(Key) in [‘A’, ‘a’]) then ShowMessage(‘Ctrl-A’); end;

Página 45


Como interceptar as teclas de funções no programa

Primeiro, coloque a propriedade KeyPreview do formulário como TRUE. Depois, insira este código no evento OnKeyDown do formulário: procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_F5 then showMessage(‘I pressed the F5 key’); end; Você também pode usar as variáveis VK_F1 até VK_F12 referentes as outras teclas de função.

DbGrid zebrado O exemplo abaixo mostra como deixar cada linha do componente DBGrid de uma cor diferente, dando assim um efeito zebrado. O controle é feito no evento OnDrawColumnCell. unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, StdCtrls; type TForm1 = class(TForm) Button1: TButton; DBGrid1: TDBGrid; Table1: TTable; DataSource1: TDataSource; procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin Página 46


If odd(Table1.RecNo) then begin DBGrid1.Canvas.Font.Color:= clWhite; DBGrid1.Canvas.Brush.Color:= clGreen; end else begin DBGrid1.Canvas.Font.Color:= clBlack; DBGrid1.Canvas.Brush.Color:= clWhite; end; DBGrid1.Canvas.FillRect(Rect); DBGrid1.Canvas.TextOut(Rect.Left+2,Rect.Top,Column.Field.AsString); end;

Retorna o espaço livre em disco Esta função só funciona em Fat16 function DiskSpace( drive: byte ): String; var bytes: longint; begin bytes := DiskFree(drive); if ( bytes >= 0 ) then result := inttostr( bytes div 1024 ) +' KB' else result := '> 2GB'; end;

Para que o seu Form não seja redimensionado Inclua o código abaixo no Form que não deseja redimensionar. type TForm1 = class(TForm) private { Private declarations } procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO; procedure WMInitMenuPopup(var Msg: TWMInitMenuPopup); message WM_INITMENUPOPUP; procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest; public { Public declarations } end; var Form1: TForm1; Página 47


implementation {$R *.DFM} procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); TWMGetMinMaxInfo); begin inherited; with Msg.MinMaxInfo^ do begin ptMinTrackSize.x:= form1.width; ptMaxTrackSize.x:= ptMaxTrackSize.x:= form1.width; ptMinTrackSize.y:= ptMinTrackSize.y:= form1.height; ptMaxTrackSize.y:= ptMaxTrackSize.y:= form1.height; end; end; procedure TForm1.WMInitMenuPopup(var Msg: TWMInitMenuPopup); TWMInitMenuPopup); begin inherited; if Msg.SystemMenu then EnableMenuItem(Msg.MenuPopup, EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_GRAYED) end; procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest); TWMNCHitTest); begin inherited; with Msg do if Result in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,HTBOTTOMLEFT, HTBOTTOMRIGHT,HTBOTTOMLEFT, HTTOP, HTTOPRIGHT, HTTOPLEFT] then Result:= HTNOWHERE end;

Como mover mov er um componente compo nente em em Run-time No exemplo abaixo deve ser incluído um componente Button. Para testar este exemplo mantenha a tecla CTRL pressionada clique com o mouse no componente Button. Feito isto, basta arrastar o componente Button para qualquer lado. type TForm1 = class(TForm) Button1: TButton; procedure Button1MouseDown(Sender: TObject; Button: TMouseButton; TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button1MouseMove(Sender: Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Button1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } Página 48


public { Public declarations } MouseDownSpot : TPoint; Capturing : bool; end; var Form1: TForm1; implementation {$R *.DFM} // Evento OnMouseDown do Form procedure TForm1.Button1MouseDown(Sender: TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if ssCtrl in Shift then begin SetCapture(Button1.Handle); Capturing := true; MouseDownSpot.X MouseDownSpot.X := x; MouseDownSpot.Y MouseDownSpot.Y := Y; end; end; // Evento OnMouseMove do Form procedure TForm1.Button1MouseMove(Sender: TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if Capturing then begin Button1.Left:= Button1.Left:= Button1.Left-(MouseDownSpot. Button1.Left-(MouseDownSpot.x-x); x-x); Button1.Top:= Button1.Top:= Button1.Top - (MouseDownSpot.-y); (MouseDownSpot.-y); end; end; // Evento OnMouseUp do Form procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Capturing then begin ReleaseCapture; Capturing := false; Button1.Left := Button1.Left - (MouseDownSpot.x -x); Button1.Top := Button1.Top Button1.Top - (MouseDownSpot.y (MouseDownSpot.y - y); end; end;

Página 49


Como verificar verif icar se a tecla tecla TAB TAB foi f oi pressi p ressionada onada

Para testar o exemplo abaixo inclua alguns componentes Edit em seu form. type TForm1 = class(TForm) Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; procedure FormCreate(Sender: TObject); private { Private declarations } procedure ProcessaMsg(var Msg: TMsg; var Handled: Boolean); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.ProcessaMsg(var TForm1.ProcessaMsg(var Msg: TMsg; var Handled: Boolean); begin if Msg.message = WM_KEYDOWN then begin if Msg.wParam = VK_TAB then Caption := ‘Tecla Tab’; end; end; // Evento OnCreate procedure TForm1.FormCreate(Sender: TObject); begin Application.OnMessage Application.OnMessage := ProcessaMsg; end;

Executar Executar um u m AVI AVI no Form procedure TForm1.BitBtn1Click(Sender: TObject); begin with MediaPlayer1 do begin FileName := ‘c:\windows\help\scroll.avi’; ‘c:\windows\help\scroll.avi’; Open; Display := Form2; Form2.Show; Play; end; end; Página 50


Colocar zeros a esquerda de um valor digitado no componente Edit procedure TForm1.Edit1Exit(Sender: TObject); begin Edit1.Text := FormatFloat(‘000000’,StrToFloat(Edit1.Text)); end;

Cancelar o pressionamento de uma tecla

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin if Key = ‘,’ then Key := #0; end; Obs. O exemplo acima cancela o pressionamento de uma virgula em um componente EDIT.

Utilizar o MessageBox com parâmetros var Button: Integer; Mensagem1 : Array[0..79] of Char; Mensagem2 : Array[0..79] of Char; begin StrPCopy(Mensagem1, Edit1.Text + ‘ ‘ + Edit2.Text); StrPCopy(Mensagem2, Edit3.Text + ‘ ‘ + Edit4.Text); Button := Application.MessageBox (Mensagem2,Mensagem1, MB_YESNOCANCEL+ mb_DefButton1+MB_ICONQUESTION); end;

Retorna a cor de um determinado componente no formato string procedure TForm1.BitBtn1Click(Sender: TObject); begin // Retorna a cor do form Caption := ColorToString(Form1.Color); // Muda a cor do form Form1.Color := StringToColor(‘clBlack’); end;

Página 51


Verifica se existe o diretório

procedure TForm1.Button1Click(Sender: TObject); begin if DirectoryExists(Edit1.Text) then Label1.Caption := Edit1.Text + ‘ exists’ else Label1.Caption := Edit1.Text + ‘ does not exist’; end;

Bloquear a tecla Ctrl+Del do DBGrid

procedure TForm1.DBGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if ((Shift = [ssCtrl]) and (key = vk_delete)) THEN Abort; end;

Para criar uma janela não retangular Você deve criar uma Região do Windows e usar a função da API SetWindowRgn, desta maneira (isto funciona apenas em D2/D3): var hR : THandle; begin {cria uma Região elíptica} hR := CreateEllipticRgn(0,0,100,200); SetWindowRgn(Handle,hR,True); end;

Fecha todos os arquivos var i: integer; begin with Session do for i:= 0 to DatabaseCount - 1 do Databases[I].Close; end;

Hint com quebra de linhas Para incluir mais de uma linha no Hint você deve utilizar o evento OnMouseMove de cada componente. Veja abaixo como ficará o código em um Edit por exemplo. procedure TForm1.Edit1MouseMove(Sender: TObject; Shift: TShiftState; X, Página 52


Y: Integer); begin Edit1.hint := ‘Primeira Linha’+#13+’Segunda Linha’+#13+ ‘Terceira Linha’+#13+’Quarta Linha’; end; Obs. Não esquecer de mudar para TRUE o evento ShowHint.

Imprimindo sem passar pelo gerenciador de impressão procedure TForm1.Button1Click(Sender: TObject); var F : TextFile; i : integer; begin AssignFile(F,’LPT1'); Rewrite(F); i := 0; Writeln(F,’Teste de impressao - Linha 0'); Writeln(F,’Teste de impressao - Linha 1'); Writeln(F,#27#15+’Teste de Impressão - Linha 2'); Writeln(F,’Teste de impressao - Linha 3'); Writeln(F,#27#18+’Teste de Impressão - Linha 4'); Writeln(F,’Teste de impressao - Linha 5'); Writeln(F,#12); // Ejeta a página CloseFile(F); end;

Fechar um aplicativo Delphi a partir de outro aplicativo Delphi procedure TForm1.Button1Click(Sender: TObject); var Win : THandle; begin Win := FindWindow(nil,’Form1'); if Win <> 0 then PostMessage(Win,WM_CLOSE,0,0) else ShowMessage(‘Programa não encontrado’); end; Obs. No exemplo acima foi utilizado o POSTMESSAGE para enviar uma mensagem WM_CLOSE para a janela principal.

Mostrar o HINT num Panel

procedure TForm1.FormCreate(Sender: TObject); begin Página 53


Application.OnHint := DisplayHint; end; procedure TForm1.DisplayHint(Sender: TObject); begin Panel1.Caption := Application.Hint; end; Obs. Não é necessário Atribuir True para o ShowHint

Retornar o nome do usuário que esta editando o registro procedure TForm1.BitBtn1Click(Sender: TObject); begin try Table1.Edit; except on E:EDBEngineError do if E.Errors[0].ErrorCode = 10241 then begin ShowMessage(‘Mensagem de erro’+E.Errors[0].Message ); ShowMessage( ‘Arquivo com erro’+E.Errors[1].Message ); ShowMessage( ‘Nome do usuario’+ E.Errors[2].Message ); end; end; end;

Retornar o nome do usuário que esta com a tabela Exclusiva procedure TForm1.BitBtn1Click(Sender: TObject); begin try Table1.Close; Table1.Exclusive := True; Table1.Open; except on E:EDBEngineError do if E.Errors[0].ErrorCode = 10243 then begin ShowMessage(‘Mensagem de erro’+E.Errors[0].Message ); ShowMessage( ‘Arquivo com erro’+E.Errors[1].Message ); ShowMessage( ‘Nome do usuario’+ E.Errors[2].Message ); end end; end;

Configuração do BDE para ambiente de rede

Para o seu aplicativo feito em Delphi rodar em rede, você deve instalar o BDE em todas as estações. No BDE de cada estação, você deve colocar no parâmetro NET Página 54


DIR do drive PARADOX o local onde estão as bases de dados e na PATH do Alias especificar o caminho das base de dados. Mas muita atenção, todas as estações devem estar com a mesma configuração do BDE. Veja o exemplo abaixo para configuração do parâmetro NET DIR do drive PARADOX e o PATH do Alias. Estação n.1 NET DIR F:\ Path do Alias F:\DIRETORIO Estação n.2 NET DIR F:\ Path do Alias F:\DIRETORIO Estação n.3 NET DIR F:\ Path do Alias F:\DIRETORIO Não é aconselhável que os aplicativos feitos em Delphi 1, sejam executados no servidor da base de dados, pois o PARADOX apresenta problemas de corrupção de arquivos e índices neste caso. É aconselhável que no servidor você coloque somente as bases de dados. Mas caso você tenha necessidade de utilizar o servidor você pode utilizar uma solução alternativa para o problema do PARADOX, esta solução esta sendo satisfatória na maioria dos casos. Digamos que a letra do drive de rede que você vai acessar o servidor, seja a letra “F:”, então, faça o seguinte: Coloque a linha abaixo no arquivo AUTOEXEC.BAT, do servidor. SUBST F: C: Configure o BDE do servidor para que ele acesse o drive “F:” Esta linha deverá ser colocada apenas no servidor, com isso você passa a ter em seu servidor, um drive virtual para acessar o drive C:, evitando o problema do PARADOX. No Delphi 2 e Delphi 3, você deve utilizar um instalador de programas. No CD do Delphi 2 e Delphi 3 existe um instalador chamado InstallShield para fazer a instalação e configuração do aplicativo e do BDE. Veja abaixo os exemplos da configuração do BDE p/ Delphi 2 e 3: Servidor Estação 1 NET DIR \\SERVIDOR\C NET DIR \\SERVIDOR\C PATH DO ALIAS \\SERVIDOR\C\DIRETORIO PATH DO ALIAS \\SERVIDOR\C\DIRETORIO LOCAL SHARE TRUE LOCAL SHARE FALSE Estação 2 Estação 3 NET DIR \\SERVIDOR\C NET DIR \\SERVIDOR\C PATH DO ALIAS \\SERVIDOR\C\DIRETORIO PATH DO ALIAS \\SERVIDOR\C\DIRETORIO LOCAL SHARE FALSE LOCAL SHARE FALSE DICA: O executável pode ser colocado em cada máquina da rede, diminuindo assim o tráfego de rede.

Página 55


Como criar um Form de Apresentação (Splash Form) como o do WORD Para você criar um pequeno Form de apresentação enquanto seu programa é carregado ou enquanto sua aplicação gera indices, etc. Crie seu Form de Apresentação (ApresForm) e depois no menu View opção Project Source, inclua o seguinte código: program Mastapp; uses Forms, Apres in ‘APRES.PAS’ {ApresForm}, Aplicacao01 in ‘APLIC01.PAS’ {Aplic01Form}, Aplicacao02 in ‘APLIC02.PAS’ {Aplic02Form}; {$R *.RES} begin ApresForm := TApresForm.Create(Application); ApresForm.Show; ApresForm.Update; Application.CreateForm(TAplic01Form, Aplic01Form); Application.CreateForm(TAplic01Form, Aplic02Form); ApresForm.Hide; ApresForm.Free; Application.Run; end.

Verifica se o Form, já esta ativo, Delphi1, Delphi2 e Delphi3 procedure TForm1.Button1Click(Sender: TObject); var Found,i : Integer; begin Found := -1; for i := 0 to Screen.FormCount - 1 do if Screen.Forms[i] is TForm2 then Found := i; if Found >= 0 then Screen.Forms[Found].Show else begin Form2 := TForm2.Create(Self); Form2.Show; end; end;

Converter a primeira letra de um Texto em maiúscula procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin

Página 56


with Sender as TEdit do if (SelStart = 0) or (Text[SelStart] = ‘ ‘) then if Key in [‘a’..’z’] then Key := UpCase(Key); end;

Verifica se o Form, já esta ativo procedure TForm1.Button1Click(Sender: TObject); var Found,i : Integer; begin Found := -1; for i := 0 to Screen.FormCount - 1 do if Screen.Forms[i] is TForm2 then Found := i; if Found >= 0 then Screen.Forms[Found].Show else begin Form2 := TForm2.Create(Self); Form2.Show; end; end;

Mostrar as fontes TrueType instaladas no Windows Para testar o exemplo abaixo inclua em seu formulário um componente ListBox, um componente Label e um componente ListBox. // Evento OnClick do componente LisBox procedure TForm1.ListBox1Click(Sender: TObject); begin { Atribui a propriedade Caption do componente Label o nome da fonte selecionada apenas para visualização} Label1.Caption := ListBox1.Items[ListBox1.ItemIndex]; { Atribui ao componente Label1 na propriedade Name da propriedade Font o nome da fonte selecionada para que o componente Label para utilizar a mesma fonte } Label1.Font.Name := ListBox1.Items[ListBox1.ItemIndex]; end; // Evento OnClick do componente Button. procedure TForm1.Button1Click(Sender: TObject); begin {Carrega as fontes instaladas no Windows para o componente ListBox} ListBox1.Items := Screen.Fonts; end; Página 57


ShowMessage com quebra de linhas

procedure TForm1.Button1Click(Sender: TObject); var MSG : String; begin MSG := ‘Mensagem da Primeira Linha’+#13+’Mensagem da Segunda Linha’+#13+’Mensagem da Terceira Linha’; ShowMessage(MSG); end; ATENÇÃO. A quebra foi possível através do codigo #13.

Veja abaixo como retornar informações do ambiente DOS No exemplo abaixo deve ser incluído no form um componente Button, um componente StringGrid e um componente ListBox. type TForm1 = class(TForm) ListBox1: TListBox; Button1: TButton; StringGrid1: TStringGrid; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} // Evento OnClick do componente Button procedure TForm1.Button1Click(Sender: TObject); var Env : PChar; i : Integer; S : String; PosEq : Integer; begin Env := GetEnvironmentStrings; With ListBox1,StringGrid1 do begin While Env^ <> #0 do begin Items.Add(StrPas(Env)); Inc(Env,StrLen(Env)+1); end; RowCount := Items.Count; for i := 0 to Pred(Items.Count) do begin Página 58


PosEq := Pos(‘=’,Items[i]); Cells[0,i] := Copy(Items[i],1,PosEq-1); Cells[1,i] := Copy(Items[i],PosEq+1,Length(Items[i])); end; end; end;

Como colocar um componente ComboBox em um componente StringGrid Inclua no seu Form um componente ComboBox e um componente StringGrid. type TForm1 = class(TForm) StringGrid1: TStringGrid; ComboBox1: TComboBox; procedure FormCreate(Sender: TObject); procedure ComboBox1Change(Sender: TObject); procedure ComboBox1Exit(Sender: TObject); procedure StringGrid1SelectCell (Sender: TObject; Col, Row: Integer; var CanSelect: Boolean); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} // Evento OnCreate do Form procedure TForm1.FormCreate(Sender: TObject); begin { Ajusta a altura do ComboBox com a altura da linha do StringGrid} StringGrid1.DefaultRowHeight := ComboBox1.Height; {Esconde o ComboBox} ComboBox1.Visible := False; end; // Evento OnChange do componente ComboBox procedure TForm1.ComboBox1Change (Sender: TObject); begin StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row] := ComboBox1.Items[ComboBox1.ItemIndex]; Página 59


ComboBox1.Visible := False; StringGrid1.SetFocus; end; // Evento OnExit do componente ComboBox procedure TForm1.ComboBox1Exit (Sender: TObject); begin StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row] := ComboBox1.Items[ComboBox1.ItemIndex]; ComboBox1.Visible := False; StringGrid1.SetFocus; end; // Evento OnSelectCell do componente StringGrid procedure TForm1.StringGrid1SelectCell(Sender: TObject; Col, Row: Integer; var CanSelect: Boolean); var R: TRect; begin if ((Col = 3) AND (Row <> 0)) then begin R := StringGrid1.CellRect(Col, Row); R.Left := R.Left + StringGrid1.Left; R.Right := R.Right + StringGrid1.Left; R.Top := R.Top + StringGrid1.Top; R.Bottom := R.Bottom + StringGrid1.Top; ComboBox1.Left := R.Left + 1; ComboBox1.Top := R.Top + 1; ComboBox1.Width := (R.Right + 1) - R.Left; ComboBox1.Height := (R.Bottom + 1) - R.Top; ComboBox1.Visible := True; ComboBox1.SetFocus; end; CanSelect := True; end;

Como retornar A coluna ativa do DBGrid unit Unit1; interface use Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids; type TForm1 = class(TForm) DBGrid1: TDBGrid;

Página 60


Table1: TTable; DataSource1: TDataSource; procedure DBGrid1ColEnter(Sender: TObject); end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.DBGrid1ColEnter(Sender: TObject); begin Caption := DBGrid1.SelectedField.FieldName; end;

Como mover o conteudo da calculadora do Windows para um Edit Neste exemplo deve ser incluído um componente Timer. type TForm1 = class(TForm) Timer1: TTimer; procedure Timer1Timer(Sender: TObject); procedure FormPaint(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); private Hour, Minute, Second: Word; {hora corrente} XCenter, YCenter, Radius: Integer; {tamanho atual do formulário} public procedure DrawHand (XCenter, YCenter, Radius, BackRadius: Integer; Angle: Real); end; var Form1: TForm1; implementation {$R *.DFM} // Evento OnTimer do componente Timer procedure TForm1.Timer1Timer(Sender: TObject); var HSec: Word; {valor temporário, não utilizado} begin {obtém a hora do sistema} DecodeTime (Time, Hour, Minute, Second, HSec); Refresh; end; // Evento OnPaint do componente Form

Página 61


procedure TForm1.FormPaint(Sender: TObject); var Angle: Real; I, X, Y, Size: Integer; begin {calcula o centro do formulário} XCenter := ClientWidth div 2; YCenter := ClientHeight div 2; if XCenter > YCenter then Radius := YCenter - 10 else Radius := XCenter - 10; {0. Desenha o marcador de horas} Canvas.Pen.Color := clYellow; Canvas.Brush.Color := clYellow; Size := Radius div 50 + 1; for I := 0 to 11 do begin Angle := 2 * Pi * I / 12; X := XCenter - Round (Radius * Cos (Angle)); Y := YCenter - Round (Radius * Sin (Angle)); Canvas.Ellipse (X - Size, Y - Size, X + Size, Y + Size); end; {1. Desenha o ponteiro dos minutos} Canvas.Pen.Width := 2; Canvas.Pen.Color := clBlue; Angle := 2 * Pi * Minute / 60; DrawHand (XCenter, YCenter, Radius * 90 div 100, 0, Angle); {2. Desenha o ponteiro das horas: percentual dos minutos adicionado à hora para mover o ponteiro suavemente} Angle := 2 * Pi * (Hour + Minute / 60) / 12; DrawHand (XCenter, YCenter, Radius * 70 div 100, 0, Angle); {3. Desenha o ponteiro dos segundos} Canvas.Pen.Width := 1; Canvas.Pen.Color := clRed; Angle := 2 * Pi * Second / 60; DrawHand (XCenter, YCenter, Radius, Radius * 30 div 100, Angle); end; procedure TForm1.DrawHand (XCenter, YCenter, Radius, BackRadius: Integer; Angle: Real); begin Angle := (Angle + 3*Pi/2); Página 62

Delphi Funcoes

Recommend Documents