Apostila_ Delphi

Prévia do material em texto

Funções para o Delphi 
 
 
 
Página 1 
 
 
 
 
 
 
APOSTILA 
DICAS DE PROGRAMAÇÃO DELPHI 
 
 
 
 
 
 
 
 
 
 
 
 
Professor Edgar Caldeira da Cruz 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
Araras/SP 
2013 
 
Funções para o Delphi 
 
 
 
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 como “TAB” .................................................................................................. 7 
Capturar tela .......................................................................................................................................................... 8 
Subtrair/adicionar N meses a uma data ............................................................................................................ 8 
Data por extenso................................................................................................................................................... 8 
Habilitar e desabiliar a senha do protetor de tela ............................................................................................ 8 
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 
Comolimpar todos os edits de um form ........................................................................................................ 25 
Funções para o Delphi 
 
 
 
Página 3 
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 
Funções para o Delphi 
 
 
 
Página 4 
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 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 5 
Acessando arquivos 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 quebra 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 
Funções para o Delphi 
 
 
 
Página 6 
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; 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 7 
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; 
Funções para o Delphi 
 
 
 
Página 8 
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 protetor 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; 
 
Funções para o Delphi 
 
 
 
Página 9 
 
// 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; 
 
Funções para o Delphi 
 
 
 
Página 10 
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 utilizar: 
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)); 
Funções para o Delphi 
 
 
 
Página 11 
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 utilizar: 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
If IsRecordLocked(Table1,True) then 
Showmessage('Registro Travado!'); 
end; 
 
 
 
 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 12 
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 
Funções para o Delphi 
 
 
 
Página 13 
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 aplicativo 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. 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 14 
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 utilizar: 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
DeleteDir( Self.Handle,'C:\TESTE'); 
end; 
 
Testar a impressora 
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; 
Funções para o Delphi 
 
 
 
Página 15 
mov nResult,ah; 
end; 
PrinterOnLine := (nResult and $80) = $80; 
end; 
 
Como utilizar: 
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 
{ Sepegou nome de SubDiretorio } 
begin 
Result := FindNext( SearchRec ); 
Continue; 
end; 
ADirList.Add( SearchRec.Name ); 
Result := FindNext( SearchRec ); 
end; 
FindClose( SearchRec ); 
ADirList.Sort; 
end; 
 
 
 
Funções para o Delphi 
 
 
 
Página 16 
Como utilizar: 
procedure TForm1.Button1Click(Sender: TObject); 
var 
contador: Integer; 
lista: TStringlist; 
begin 
lista:= TStringlist.create; 
DirList('C:\*.*', lista); 
end; 
 
Abrir arquivos 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; 
 
 
Funções para o Delphi 
 
 
 
Página 17 
Como utilizar: 
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; 
 
Funções para o Delphi 
 
 
 
Página 18 
// 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 ctrl+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; 
Funções para o Delphi 
 
 
 
Página 19 
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 utilizar: 
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} 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 20 
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.' ); 
Funções para o Delphi 
 
 
 
Página 21 
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 utilizar: 
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); 
Funções para o Delphi 
 
 
 
Página 22 
try 
if DiskSize(DriveNumero-$40) <> -1 then 
Result := true 
else 
messagebeep(0); 
finally 
SetErrorMode(EMode); 
end; 
end; 
 
Como utilizar: 
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 componente 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); 
Funções para o Delphi 
 
 
 
Página 23 
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 utilizar: 
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)); 
 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 24 
Aguardar um determinado 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 
Funções para o Delphi 
 
 
 
Página 25 
... 
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; 
 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 26 
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; 
 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 27 
Procura e substituição de string num campo 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 utilizar: 
Procedure TForm1.Button1Click (Sender: TObject); 
Begin 
FindReplace(Edit1.Text,Edit2.Text, Memo1); 
end; 
 
Pegando a linha 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 
Funções para o Delphi 
 
 
 
Página 28 
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 mais 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; 
 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 29 
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; 
 
 
 
Funções para o Delphi 
 
 
 
Página 30 
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; 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 31 
Data por extenso no Quickreport 
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 Quickreport (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; 
 
 
 
Funções para o Delphi 
 
 
 
Página 32 
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 outro 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); 
Funções para o Delphi 
 
 
 
Página 33 
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; 
Funções para o Delphi 
 
 
 
Página 34 
 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 } 
Funções para o Delphi 
 
 
 
Página 35 
 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 colocar o código no evento BeforeOpen 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 := 
Funções para o Delphi 
 
 
 
Página 36 
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; 
Funções para o Delphi 
 
 
 
Página 37 
 
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); 
Funções para o Delphi 
 
 
 
Página 38 
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 
Funções para o Delphi 
 
 
 
Página 39 
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. 
 
Funções para o Delphi 
 
 
 
Página 40 
 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); 
Funções para o Delphi 
 
 
 
Página 41 
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(nil,'Program Manager'),SW_HIDE); 
 
Para mostrar: 
ShowWindow(FindWindow(nil,'Program Manager'),SW_SHOW); 
 
Alterando o papel de parede 
Program wallpapr; 
 
uses Registry, WinProcs; 
 
procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean ); 
var 
reg : TRegIniFile; 
begin 
Funções para o Delphi 
 
 
 
Página 42 
// 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 utilizar: 
Image1.picture.Assign(CaptureScreenRect(Rect(0,0,Width,Height))); 
 
Funções para o Delphi 
 
 
 
Página 43 
Usando o Word dentro 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 
Funções para o Delphi 
 
 
 
Página 44 
 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); 
Funções para o Delphi 
 
 
 
Página 45 
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; 
Funções para o Delphi 
 
 
 
Página 46 
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 
Funções para o Delphi 
 
 
 
Página 47 
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; 
Funções para o Delphi 
 
 
 
Página 48 
implementation 
{$R *.DFM} 
procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);begin 
inherited; 
with Msg.MinMaxInfo^ do 
begin 
ptMinTrackSize.x:= form1.width; 
ptMaxTrackSize.x:= form1.width; 
ptMinTrackSize.y:= form1.height; 
ptMaxTrackSize.y:= form1.height; 
end; 
end; 
procedure TForm1.WMInitMenuPopup(var Msg: TWMInitMenuPopup); 
begin 
inherited; 
if Msg.SystemMenu then 
EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_GRAYED) 
end; 
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest); 
begin 
inherited; 
with Msg do 
if Result in [HTLEFT, HTRIGHT, HTBOTTOM, 
HTBOTTOMRIGHT,HTBOTTOMLEFT, HTTOP, 
HTTOPRIGHT, HTTOPLEFT] then 
Result:= HTNOWHERE 
end; 
 
Como mover um componente 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; 
Shift: TShiftState; X, Y: Integer); 
procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X, 
Y: Integer); 
procedure Button1MouseUp(Sender: TObject; Button: TMouseButton; 
Shift: TShiftState; X, Y: Integer); 
private 
{ Private declarations } 
Funções para o Delphi 
 
 
 
Página 49 
public 
{ Public declarations } 
MouseDownSpot : TPoint; 
Capturing : bool; 
end; 
var 
Form1: TForm1; 
implementation 
{$R *.DFM} 
// Evento OnMouseDown do Form 
procedure 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 := x; 
MouseDownSpot.Y := Y; 
end; 
end; 
// Evento OnMouseMove do Form 
procedure TForm1.Button1MouseMove(Sender: 
TObject; Shift: TShiftState; X, Y: Integer); 
begin 
if Capturing then begin 
Button1.Left:= Button1.Left-(MouseDownSpot.x-x); 
Button1.Top:= Button1.Top - (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 - (MouseDownSpot.y - y); 
end; 
end; 
 
 
 
 
Funções para o Delphi 
 
 
 
Página 50 
Como verificar se a tecla TAB foi pressionada 
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 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 := ProcessaMsg; 
end; 
 
Executar um AVI no Form 
procedure TForm1.BitBtn1Click(Sender: TObject); 
begin 
with MediaPlayer1 do 
begin 
FileName := ‘c:\windows\help\scroll.avi’; 
Open; 
Display := Form2; 
Form2.Show; 
Play; 
end; 
end; 
 
Funções para o Delphi 
 
 
 
Página 51 
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; 
 
 
Funções para o Delphi 
 
 
 
Página 52 
 
 
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, 
Funções para o Delphi 
 
 
 
Página 53 
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 
Funções para o Delphi 
 
 
 
Página 54 
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