Funes para o Delphi

APOSTILA
DICAS DE PROGRAMAO DELPHI

Professor Edgar Caldeira da Cruz

Araras/SP 2013
Pgina 1

Funes para o Delphi

SUMRIO
Acessando arquivos Paradox em rede ............................................................................................................. 5 Confirmar o diretrio............................................................................................................................................. 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 usurio 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 subdiretrio...................................................................................................................................... 14 Testar a impressora ........................................................................................................................................... 14 Validar datas........................................................................................................................................................ 15 Procurar arquivos ............................................................................................................................................... 15 Abrir arquivos com aplicativo associado ......................................................................................................... 16 Fazer um TEdit aceitar apenas nmeros ........................................................................................................ 17 Alterar o papel de parede do Windows ........................................................................................................... 17 Extrair o nmero de cores do modo de vdeo 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 executvel ..................................................................................................................... 19 Verificando a memria ....................................................................................................................................... 19 Nmero de srie do hd ...................................................................................................................................... 20 Mapear uma pasta na rede ............................................................................................................................... 20 Pegar nome do usurio 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 Exponenciao.................................................................................................................................................... 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 de um form ........................................................................................................ 25

Pgina 2

Funes para o Delphi

Formatar nmeros com zeros esquerda ...................................................................................................... 26 Obrigar a digitao de caracteres maisculos num campo memo ............................................................. 26 Imprimindo um campo memo via Canvas ....................................................................................................... 26 Procura e substituio de string num campo memo ..................................................................................... 27 Pegando a linha e coluna atuais de um memo .............................................................................................. 27 Trocando a cor de uma clula 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 nmero 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, ms ou dia de uma data via SQL ....................................................................................... 32 Cria um clone Monocromtico 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 proteo 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 Funo para validar o PIS ................................................................................................................................. 43 Calcular a idade usando o MaskEdit ............................................................................................................... 44 Como definir seu prprio hotkey (Tecla Quente) ........................................................................................... 45 Como interceptar as teclas de funes no programa ................................................................................... 46 DbGrid zebrado ................................................................................................................................................... 46 Retorna o espao livre em disco ...................................................................................................................... 47 Para que o seu Form no 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 parmetros.......................................................................................................... 51 Retorna a cor de um determinado componente no formato string.............................................................. 51 Verifica se existe o diretrio .............................................................................................................................. 52 Bloquear a tecla Ctrl+Del do DBGrid ............................................................................................................... 52 Para criar uma janela no retangular .............................................................................................................. 52 Fecha todos os arquivos.................................................................................................................................... 52 Hint com quebra de linhas ................................................................................................................................. 52 Imprimindo sem passar pelo gerenciador de impresso .............................................................................. 53 Fechar um aplicativo Delphi a partir de outro aplicativo Delphi ................................................................... 53 Mostrar o HINT num Panel................................................................................................................................ 53 Retornar o nome do usurio que esta editando o registro ........................................................................... 54 Retornar o nome do usurio que esta com a tabela Exclusiva ................................................................... 54

Pgina 3

Funes para o Delphi

Configurao do BDE para ambiente de rede ............................................................................................... 54 Como criar um Form de Apresentao (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 maiscula ................................................................................. 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 informaes 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

Pgina 4

Funes para o Delphi

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 pgina DRIVERS 3. Selecionar o driver PARADOX e alterar o parmetro NET DIR para o local onde sero gravados os arquivos de controle para compartilhamento. Por exemplo, "G:\MEUAPLIC", onde G : corresponde ao drive de rede e MEUAPLIC, o diretrio aonde est o aplicativo (executvel) 4. Depois selecionar a pgina SYSTEM 5. Alterar o parmetro LOCAL SHARE para TRUE. Aps isto o BDE controlar o compartilhamento de arquivos PARADOX em rede.

Confirmar o diretrio
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 cdigo 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. No 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 Pgina 5

Funes para o Delphi 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('No 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 usurio 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;

Pgina 6

Funes para o Delphi

Como criar uma tela de abertura (Splash Screen)

Aps ter criado o formulrio principal, crie um Formulrio 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 opo 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 criao 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 Memria} 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 botes 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; Pgina 7

Funes para o Delphi

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 ms a data de hoje: Edit1.text:= DATETOSTR(INCMONTH(DATE,1)); // Para subtrair s colocar o nmero de meses negativo

Data por extenso

Edit1.text:= FormatDateTime('"So 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;

Pgina 8

Funes para o Delphi

// 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;

Pgina 9

Funes para o Delphi

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)); Pgina 10

Funes para o Delphi 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;

Pgina 11

Funes para o Delphi

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 seo 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 seo 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 Pgina 12

Funes para o Delphi 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 configurao com vrias opes ser aberta. Configure a DLL32 para IDDA032.DLL ACESS 95 ou IDDA3532.DLL ACESS 97. Na opo SYSTEM DATABASE, aponte para o arquivo System.mdw do Acess que geralmente est no subdiretrio \Msoffice\Access. Salve a configurao e aps isto s criar seu alias (se j ouver algum criado, delete e configure de novo). Com essa informao em mos, faa o programa no 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.

Pgina 13

Funes para o Delphi

Apagar um subdiretrio
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; Pgina 14

Funes para o Delphi 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 Invlida!'); 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;

Pgina 15

Funes para o Delphi 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;

Pgina 16

Funes para o Delphi Como utilizar: procedure TForm1.Button1Click(Sender: TObject); begin ExecFile('c:\windows\ladrilhos.bmp'); end;

Fazer um TEdit aceitar apenas nmeros

Na rotina abaixo, o TEdit s aceitar nmeros de 0 a 9 e o BackSpace (Chr(8)). Se voc quiser a vrgula tambm, 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 nmero de cores do modo de vdeo 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;

Pgina 17

Funes para o Delphi // 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; Pgina 18

Funes para o Delphi

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 executvel

Inclua a unit Shellapi na clusula uses do seu form. Image1.Picture.Icon.Handle:= ExtractIcon(Handle,PChar('c:\windows\calc.exe'),0);

Verificando a memria
var MemoryStatus: TMemoryStatus; begin MemoryStatus.dwLength:= sizeof(MemoryStatus); GlobalMemoryStatus(MemoryStatus); Label1.Caption := 'Total de memria fsica : ' + IntToStr(MemoryStatus.dwTotalPhys); end; {typedef struct _MEMORYSTATUS DWORD dwLength; // sizeof(MEMORYSTATUS) DWORD dwMemoryLoad; // percentual de memria em uso DWORD dwTotalPhys; // bytes de memria fsica DWORD dwAvailPhys; // bytes livres de memria fsica DWORD dwTotalPageFile; // bytes de paginao de arquivo DWORD dwAvailPageFile; // bytes livres de paginao de arquivo DWORD dwTotalVirtual; // bytes em uso de espao de endereo DWORD dwAvailVirtual; // bytes livres}

Pgina 19

Funes para o Delphi

Nmero de srie 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 no so compatveis.' ); ERROR_BAD_DEVICE : ShowMessage ( 'Letra invlida.' ); ERROR_BAD_NET_NAME : ShowMessage ( 'Nome do servidor no vlido ou no pode ser localizado.' ); ERROR_BAD_PROFILE : ShowMessage ( 'Formato incorreto de parmetros.' ); ERROR_CANNOT_OPEN_PROFILE : ShowMessage ( 'Conexo permanente no disponvel.' ); ERROR_DEVICE_ALREADY_REMEMBERED : ShowMessage ( 'Uma entrada para o dispositivo especificado j est no perfil do usurio.' ); ERROR_EXTENDED_ERROR : ShowMessage ( 'Erro de rede.' ); ERROR_INVALID_PASSWORD : ShowMessage ( 'Senha especificada invlida.' ); ERROR_NO_NET_OR_BAD_PATH : ShowMessage ( 'A operao no foi concluda porque a rede no foi inicializada ou caminho invlido.' ); ERROR_NO_NETWORK : ShowMessage ( 'A rede no est presente.' ); Pgina 20

Funes para o Delphi else if Err > 0 then ShowMessage (IntToStr(Err)); end; end;

Pegar nome do usurio 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 funo getkeystate em conjunto com o cdigo 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); Pgina 21

Funes para o Delphi 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('No tem disco no drive A:'); end;

Executando programas externos

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

Reproduzindo sons wav, sem o componente mediaplayer

Coloque na clsula 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); Pgina 22

Funes para o Delphi ArqIni.WriteBool('Dados', 'Condio', 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', 'Condio', 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;

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

Pgina 23

Funes para o Delphi

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 botes 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 varivel 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. Aps ter criado um formulrio principal, crie um formulrio para a tela de abertura. Aqui iremos cham-lo de ABERTURAFORM. Depois de criar os dois formulrios, clique no menu VIEW, na opo PROJECT SOURCE, que permite que seja exibido o cdigo do arquivo principal do projeto. Localize no cdigo a linha em que o formulrio de abertura criado e apague-a (ou coloque em modo de observao, inserindo // no incio da linha). Linha que deve ser apagada: begin Pgina 24

Funes para o Delphi ... Application.CreateForm(TAberturaForm, AberturaForm); // Esta linha deve ser apagada ... end; Aps remover a linha acima, insira as linhas abaixo antes da criao dos demais formulrios do seu aplicativo: Linhas que devem ser inseridas: begin AberturaForm:= TAberturaForm.Create(Application); AberturaForm.show {Os demais formulrios devem ser criados aqui} ... AberturaForm.Hide; AberturaForm.Free; Application.Run; End; Os comandos... AberturaForm:= TAberturaForm.Create(Application); - cria o formulrio AberturaForm.Show - exibe o formulrio de abertura na tela AberturaForm.Hide; - esconde o formulrio de abertura AberturaForm.Free; - tira o formulrio da memria

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;

Pgina 25

Funes para o Delphi

Formatar nmeros com zeros esquerda

var Numero: Integer; begin Numero:= 123; Edit1.text:= Format('%5.5d',[Numero]); // resulta '00123'; end;

Obrigar a digitao de caracteres maisculos num campo memo

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char); begin Key:= Upcase(Key); end;

Imprimindo um campo memo via Canvas

Coloque na clsula 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;

Pgina 26

Funes para o Delphi

Procura e substituio 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 clula num DBGrid

No evento onDrawColumnCell do dbgrid coloque o cdigo para mudar a cor da fonte do dbgrid e a chave do mtodo 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 condio then // coloque aqui sua condio begin Pgina 27

Funes para o Delphi 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 cdigo para mudar a cor do font do dbgrid e a chave do mtodo para "desenhar" os dados. procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin If Condio 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 no 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;

Pgina 28

Funes para o Delphi

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 nmero 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! No uma tabela Paradox ou dBASE.'); end; Label1.Caption:= IntToStr(RecID) +' de '+ IntToStr(Table1.recordcount); end;

Pgina 29

Funes para o Delphi

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 clusula "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;

Pgina 30

Funes para o Delphi

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]:= 'Tera-feira'; diasemana[4]:= 'Quarta-feira'; diasemana[5]:= 'Quinta-feira'; diasemana[6]:= 'Sexta-feira'; diasemana[7]:= 'Sbado'; meses[1]:= 'Janeiro'; meses[2]:= 'Fevereiro'; meses[3]:= 'Maro'; 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 varivel PrintRecord do tipo Boolean. Para que o registro no seja impresso, basta atribuir False a esta varivel. procedure TForm1.QuickReport1Filter(var PrintRecord: Boolean); begin PrintRecord:= ( table1salario.value > 200 ); end;

Pgina 31

Funes para o Delphi

Extraindo o ano, ms ou dia de uma data via SQL

Select * from nome_tabela where extract(year from campo_data) = 1997 Voc pode extrair o ms (MONTH) ou o dia (DAY).

Cria um clone Monocromtico 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); Pgina 32

Funes para o Delphi 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] := 'Cdigo'; Excel.WorkBooks[1].Sheets[1].Cells[1,2] := 'Vendedor'; Excel.WorkBooks[1].Sheets[1].Cells[1,3] := 'Tipo Negociao'; 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 seqncia acima Linha := 2; // comeando a lanar 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; Pgina 33

Funes para o Delphi Excel.WorkBooks[1].Sheets[1].Cells[Linha,5] := FieldByName('num_titular').AsInteger;\ // adicione os campos desejados, seguindo a seqncia 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 no muito aconselhvel por o nome, mas fica mais fcil 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 } Pgina 34

Funes para o Delphi 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 funo 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 cdigo no evento BeforeOpen ou em OnNewRecord Exemplo no Oracle: Var qry_Codigo : TADOQuery; begin if DseVenda.state in [DsInsert] then begin //Recupera o cdigo 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 := Pgina 35

Funes para o Delphi 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 tcnico.'); Qry_ID.Free; end;

Como desativar a proteo de tela

Na seo Private do form adicione: procedure AppMsg(var Msg: TMsg; var Handled: Boolean); Na seo 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 cdigo no evento onClick de um TButton: procedure TForm1.Button1Click(Sender: TObject); begin SendMessage(Application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0); end; Pgina 36

Funes para o Delphi

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 execuo 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); Pgina 37

Funes para o Delphi 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 Pgina 38

Funes para o Delphi 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 contm 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. Observao: TipoDoIcone pode ser: 0 - Sem cone 1 - Informao 2 - Aviso 3 - Erro A unit COMMCTRL deve ser acrescentada.

Pgina 39

Funes para o Delphi

Informar a velocidade do Processador

Esta interessante funo 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 sada da funao a uma string: procedure TForm1.Button1Click(Sender: TObject); Pgina 40

Funes para o Delphi 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 DAGUA 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 Pgina 41

Funes para o Delphi // 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)));

Pgina 42

Funes para o Delphi

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; Observao: Incluir COMOBJ na clusula 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; Observao: Usar no evento KeyDown de um determinado Edit

Funo para validar o PIS

function validapis(Dado : String) : boolean; {Testa se o nmero do pis vlido ou no} 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 Pgina 43

Funes para o Delphi 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); Pgina 44

Funes para o Delphi 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 prprio 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; Pgina 45

Funes para o Delphi

Como interceptar as teclas de funes no programa

Primeiro, coloque a propriedade KeyPreview do formulrio como TRUE. Depois, insira este cdigo no evento OnKeyDown do formulrio: procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_F5 then showMessage(I pressed the F5 key); end; Voc tambm pode usar as variveis VK_F1 at VK_F12 referentes as outras teclas de funo.

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 Pgina 46

Funes para o Delphi 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 espao livre em disco

Esta funo 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 no seja redimensionado

Inclua o cdigo abaixo no Form que no 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; Pgina 47

Funes para o Delphi 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 includo 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 } Pgina 48

Funes para o Delphi 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;

Pgina 49

Funes para o Delphi

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;

Pgina 50

Funes para o Delphi

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 parmetros

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;

Pgina 51

Funes para o Delphi

Verifica se existe o diretrio

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 no retangular

Voc deve criar uma Regio do Windows e usar a funo da API SetWindowRgn, desta maneira (isto funciona apenas em D2/D3): var hR : THandle; begin {cria uma Regio elptica} 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 cdigo em um Edit por exemplo. procedure TForm1.Edit1MouseMove(Sender: TObject; Shift: TShiftState; X, Pgina 52

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

Imprimindo sem passar pelo gerenciador de impresso

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 Impresso - Linha 2'); Writeln(F,Teste de impressao - Linha 3'); Writeln(F,#27#18+Teste de Impresso - Linha 4'); Writeln(F,Teste de impressao - Linha 5'); Writeln(F,#12); // Ejeta a pgina 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 no 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 Pgina 53

Funes para o Delphi Application.OnHint := DisplayHint; end; procedure TForm1.DisplayHint(Sender: TObject); begin Panel1.Caption := Application.Hint; end; Obs. No necessrio Atribuir True para o ShowHint

Retornar o nome do usurio 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 usurio 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;

Configurao do BDE para ambiente de rede

Para o seu aplicativo feito em Delphi rodar em rede, voc deve instalar o BDE em todas as estaes. No BDE de cada estao, voc deve colocar no parmetro NET Pgina 54

Funes para o Delphi DIR do drive PARADOX o local onde esto as bases de dados e na PATH do Alias especificar o caminho das base de dados. Mas muita ateno, todas as estaes devem estar com a mesma configurao do BDE. Veja o exemplo abaixo para configurao do parmetro NET DIR do drive PARADOX e o PATH do Alias. Estao n.1 NET DIR F:\ Path do Alias F:\DIRETORIO Estao n.2 NET DIR F:\ Path do Alias F:\DIRETORIO Estao n.3 NET DIR F:\ Path do Alias F:\DIRETORIO No aconselhvel que os aplicativos feitos em Delphi 1, sejam executados no servidor da base de dados, pois o PARADOX apresenta problemas de corrupo de arquivos e ndices neste caso. aconselhvel que no servidor voc coloque somente as bases de dados. Mas caso voc tenha necessidade de utilizar o servidor voc pode utilizar uma soluo alternativa para o problema do PARADOX, esta soluo esta sendo satisfatria na maioria dos casos. Digamos que a letra do drive de rede que voc vai acessar o servidor, seja a letra F:, ento, faa 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 instalao e configurao do aplicativo e do BDE. Veja abaixo os exemplos da configurao do BDE p/ Delphi 2 e 3: Servidor Estao 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 Estao 2 Estao 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 executvel pode ser colocado em cada mquina da rede, diminuindo assim o trfego de rede.

Pgina 55

Funes para o Delphi

Como criar um Form de Apresentao (Splash Form) como o do WORD

Para voc criar um pequeno Form de apresentao enquanto seu programa carregado ou enquanto sua aplicao gera indices, etc. Crie seu Form de Apresentao (ApresForm) e depois no menu View opo Project Source, inclua o seguinte cdigo: 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 maiscula

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin Pgina 56

Funes para o Delphi 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 formulrio 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 visualizao} 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;

Pgina 57

Funes para o Delphi

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; ATENO. A quebra foi possvel atravs do codigo #13.

Veja abaixo como retornar informaes do ambiente DOS

No exemplo abaixo deve ser includo 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 Pgina 58

Funes para o Delphi 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]; Pgina 59

Funes para o Delphi 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; Pgina 60

Funes para o Delphi 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 includo 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 formulrio} 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 temporrio, no utilizado} begin {obtm a hora do sistema} DecodeTime (Time, Hour, Minute, Second, HSec); Refresh; end; // Evento OnPaint do componente Form Pgina 61

Funes para o Delphi procedure TForm1.FormPaint(Sender: TObject); var Angle: Real; I, X, Y, Size: Integer; begin {calcula o centro do formulrio} 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); Pgina 62

Funes para o Delphi Canvas.MoveTo ( XCenter - Round (BackRadius * Cos (Angle)), YCenter - Round (BackRadius * Sin (Angle))); Canvas.LineTo ( XCenter + Round (Radius * Cos (Angle)), YCenter + Round (Radius * Sin (Angle))); end; // Evento OnCreate do Form procedure TForm1.FormCreate(Sender: TObject); begin {l as horas antes do formulrio ser exibido} Timer1Timer (self); end; // Evento OnResize do Form procedure TForm1.FormResize(Sender: TObject); begin Refresh; end;

Pgina 63