CRIAR E APAGAR PASTASUse as funes CreateDirectory e RemoveDirectory para criar e remover pastas, ou se preferir para criar diretrio use tambm a funo MKDIR.. Begin mkdir('C:\diretrio1'); end; COLOCAR O PROGRAMA NO MENU INICIARPartindo-se do princpio que o menu iniciar uma pasta do hd, s vc localiz-la e fazer uma cpia do programa para ela, usando o WinExec, por exemplo. A localizao da pasta, se no me engano, :C:\WINDOWS\MENU INICIAR\PROGRAMAS\INICIARCop2yFileA(Endereo do seu executavel','C:\WINDOWS\Menu Iniciar\Programas\Project1.exe',true);Procurar um Texto Dentro de OutroUse a funcao POS, unit System: function Pos(Substr: String; S: String): Byte; ObservaesProcura pela "Substr" dentro da "S" e retorna um valor inteiro que o indice do primeiro caracter da "Substr" dentro da "S".Caso a "Substr" nao esteja dentro da "S" a funcao retorna Zero. Veja o Help do Delphi que tem algum exemplo l. MANDAR E-MAIL COM ASSUNTO E MANSAGEMInclua a API "ShellExecute" no Uses do seu programa.Depois insira o cdigo.shellexecute(Handle,'open','mailto: andrev@provida.org.br ?subject=Assunto &body= Mensagem',nil,'',Sw_ShowNormal); SABER QUAL O CDIGO DA TECLA PRESSIONADAColoque um Label no form (Label1);Mude a propriedade KeyPreview do form para true;Altere o evento OnKeyDown do form como abaixo:procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);beginLabel1.Caption :=Format('O cdigo da tecla pressionada : %d', [Key]);end;ObservaesPara testar execute e observe o Label enquanto pressiona as teclas desejadas. ALTERAR O CURSOR PARA UM CURSOR PERSONALISADOAltere o evento OnCreate do Form conforme abaixo:procedure TForm1.FormCreate(Sender: TObject);begin Screen.Cursors[1] := LoadCursorFromFile('c:\win95\cursors\globe.ani'); Button1.Cursor := 1;end;ObservaesPara este exemplo necessrio ter o arquivo de cursor conforme apontado e tambm ter, no form, um Button1. Para usar este cursor em outros componentes basta atribuir propriedade Cursor do componente em questo o valor 1 (um). Exemplo: Edit1.Cursor := 1; Form1.Cursor := 1;, etc. CHAMAR A CALCULADORA VIA PROGRAMAOwinexec ('c:\windows\calc.exe',1); EXECUTAR UM PROGRAMA E AGUARDAR SUA FINALIZAO ANTES DE CONTINUARInclua na seo uses: Windows{ Esta funo faz isto. }function ExecAndWait(const FileName, Params: string; const WindowState: Word): boolean;var SUInfo: TStartupInfo; ProcInfo: TProcessInformation; CmdLine: string;begin { Coloca o nome do arquivo entre aspas. Isto necessrio devido aos espaos contidos em nomes longos } CmdLine := '"' + Filename + '"' + Params; FillChar(SUInfo, SizeOf(SUInfo), #0); with SUInfo do begin cb := SizeOf(SUInfo); dwFlags := STARTF_USESHOWWINDOW; wShowWindow := WindowState; end; Result := CreateProcess(nil, PChar(CmdLine), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, PChar(ExtractFilePath(Filename)), SUInfo, ProcInfo); { Aguarda at ser finalizado } if Result then begin WaitForSingleObject(ProcInfo.hProcess, INFINITE); { Libera os Handles } CloseHandle(ProcInfo.hProcess); CloseHandle(ProcInfo.hThread); end;end;- Exemplo de uso:ExecAndWait('c:\windows\notepad.exe', '', SW_SHOW);ObservaesNo se esquea de informar o caminho (path) do arquivo completo. Esta funo foi desenvolvida para Delphi 32 bits (2, 3, 4,...). Incio da pginaSIMULAR O PRESSIONAMENTO DE UMA COMBINAO DE TECLAS (EX: CTRL+F2)Inclua na seo uses: Windows{ Mantm pressionada CTRL }keybd_event(VK_CONTROL, 0, KEYEVENTF_EXTENDEDKEY or 0, 0);{ Pressiona F2 }keybd_event(VK_F2, 0, 0, 0);{ Libera (solta) CTRL }keybd_event(VK_CONTROL, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);ObservaesNeste exemplo pressionamos Ctrl+F2. No se esquea das teclas que precisam manter pressionadas: Ctrl, Alt, Shift. Incio da pginaSIMULAR O PRESSIONAMENTO DE UMA TECLAInclua na seo uses: WindowsA API keybd_event do Windows serve para fazer isto. No exemploabaixo estamos simulando o pressionamento da tecla F2:keybd_event(VK_F2, 0, 0, 0);Para testar faa o exemplo a seguir:- Mude a propriedade KeyPreview do form para true.- Escreva no evento OnKeyDown do form como abaixo:procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);begin if Key = VK_F2 then ShowMessage('F2 pressionada');end;- Coloque um boto e escreva no OnClick (do boto) como abaixo:procedure TForm1.Button1Click(Sender: TObject);begin keybd_event(VK_F2, 0, 0, 0);end;ObservaesConsulte as constantes para os cdigos das teclas (ex: VK_RETURN, VK_DOWN, etc). Incio da pginaLIGAR E DESLIGAR A TECLA CAPS LOCKInclua na seo uses: Windows{ Esta funo liga/desliga Caps Lock, conforme o parmetro State }procedure tbSetCapsLock(State: boolean);begin if (State and ((GetKeyState(VK_CAPITAL) and 1) = 0)) or ((not State) and ((GetKeyState(VK_CAPITAL) and 1) = 1)) then begin keybd_event(VK_CAPITAL, $45, KEYEVENTF_EXTENDEDKEY or 0, 0); keybd_event(VK_CAPITAL, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0); end;end;{ Exemplos de uso: }tbSetCapsLock(true); { Liga Caps Lock }tbSetCapsLock(false); { Desliga Caps Lock }ObservaesAparentemente, podemos usar esta mesma tcnica para ligar/desligar Num Lock. Neste caso trocaramos VK_CAPITAL por VK_NUMLOCK. Por incrvel que parea no funcionou (pelo menos no teste que fiz). E tem mais: isto est na documentao do (R)Windows. Incio da pginaVERIFICAR SE UMA DETERMINADA TECLA EST PRESSIONADAInclua na seo uses: Windows{ Esta funo retorna true se a tecla informada estiver pressionada. False em caso contrrio. }function tbKeyIsDown(const Key: integer): boolean;begin Result := GetKeyState(Key) and 128 > 0;end;{ Exemplos de uso: }if tbKeyIsDown(VK_CONTROL) then { Tecla Ctrl pressionada }if tbKeyIsDown(VK_MENU) then { Tecla Alt pressionada }if tbKeyIsDown(VK_SHIFT) then { Tecla Shift pressionada }if tbKeyIsDown(VK_F2) then { Tecla F2 pressionada }ObservaesQualquer tecla pode ser verificada. Para isto basta saber o cdigo virtual (Virtual Key Code) da tecla. Incio da pginaVERIFICAR O ESTADO DE NUMLOCK E CAPSLOCKInclua na seo uses: Windows{ Esta funo retorna true se a tecla informada estiver ligada. False em caso contrrio }function tbKeyIsOn(const Key: integer): boolean;begin Result := GetKeyState(Key) and 1 > 0;end;{ Exemplo de uso: }if tbKeyIsOn(VK_NUMLOCK) then { ... NumLock est ligada }else { ... NumLock est desligada }ObservaesQualquer tecla que possua os estados On/Off pode ser verificada. Basta, para isto, saber seu cdigo. O cdigo de CapsLock VK_CAPITAL. Incio da pginaCONFIGURAR LINHAS DE DIFERENTES ALTURAS EM STRINGGRID- Coloque o StringGrid no form.- No evento OnCreate do form coloque o cdigo abaixo:procedure TForm1.FormCreate(Sender: TObject);begin StringGrid1.RowHeights[0] := 15; StringGrid1.RowHeights[1] := 20; StringGrid1.RowHeights[2] := 50; StringGrid1.RowHeights[3] := 35;end;ObservaesCuidado para no especificar uma linha inexistente. Incio da pginaADICIONAR O EVENTO ONCLICK DO DBGRIDProblema:Meu programa precisa processar algo quando o usurio clicarno DBGrid em um determinado form. O problema que o DBGrid nopossui o evento OnClick. possvel adicionar este evento no DBGrid?Soluo: possvel sim. Afinal muito simples. Siga os passos abaixopara resolver seu problema:- Monte seu form normalmente, colocando o DBGrid e demais componentes;- V na seo "private" da unit e declare a procedure abaixo:private procedure DBGridClick(Sender: TObject);- Logo aps a palavra "implementation", escreva a procedure:implementation{$R *.DFM}procedure TForm1.DBGridClick(Sender: TObject);begin ShowMessage('Clicou no DBGrid.');end;- Coloque as instrues abaixo no evento OnCreate do Form:procedure TForm1.FormCreate(Sender: TObject);begin DBGrid1.ControlStyle := DBGrid1.ControlStyle + [csClickEvents]; TForm(DBGrid1).OnClick := DBGridClick;end;- E pronto. Execute e teste.ObservaesO segredo principal desta dica est OnCreate do Form. A primeira instruo ativa o evento OnClick. A segunda instruo acessa o manipulador do evento OnClick. Para isto precisamos tratar o DBGrid como se fosse Form, pois o evento OnClick est declarado como protegido (protected) na classe TDBGrid. Incio da pginaCRIAR CAIXAS DE DILOGO EM TEMPO DE EXECUOEM TEMPO DE EXECUOInclua na seo uses: Forms, StdCtrls, ButtonsA funo abaixo demonstra a criao de uma caixa de dilogoque pode ser usada para permitir ao usurio digitar o seunome:{ Esta funo retorna true se for pressionado OK e false em caso contrrio. Se for OK, o texto digitado pelo usurio ser copiado para a varivel Nome }function ObterNome(var Nome: string): boolean;var Form: TForm; { Varivel para o Form } Edt: TEdit; { Varivel para o Edit }begin Result := false; { Por padro retorna false } { Cria o form } Form := TForm.Create(Application); try { Altera algumas propriedades do Form } Form.BorderStyle := bsDialog; Form.Caption := 'Ateno'; Form.Position := poScreenCenter; Form.Width := 200; Form.Height := 150; { Coloca um Label } with TLabel.Create(Form) do begin Parent := Form; Caption := 'Digite seu nome:'; Left := 10; Top := 10; end; { Coloca o Edit } Edt := TEdit.Create(Form); with Edt do begin Parent := Form; Left := 10; Top := 25; { Ajusta o comprimento do Edit de acordo com a largura do form } Width := Form.ClientWidth - 20; end; { Coloca o boto OK } with TBitBtn.Create(Form) do begin Parent := Form; { Posiciona de acordo com a largura do form } Left := Form.ClientWidth - (Width * 2) - 20; Top := 80; Kind := bkOK; { Boto Ok } end; { Coloca o boto Cancel } with TBitBtn.Create(Form) do begin Parent := Form; Left := Form.ClientWidth - Width - 10; Top := 80; Kind := bkCancel; { Boto Cancel } end; { Exibe o form e aguarda a ao do usurio. Se for OK... } if Form.ShowModal = mrOK then begin Nome := Edt.Text; Result := true; end; finally Form.Free; end;end;Para chamar esta funo siga o exemplo abaixo:procedure TForm1.Button1Click(Sender: TObject);var S: string;begin if ObterNome(S) then Edit1.Text := S;end;ObservaesOs componentes Label, Edit (var Edt) e BitBtn's (botes) no so destrudos explicitamente (Componente.Free). Isto no necessrio, pois ao cri-los informei como proprietrio o Form (ex: TLabel.Create(Form)). Neste caso, estes componentes so destrudos automaticamente ao destruir o Form (Form.Free). Incio da pginaCONVERTER A PRIMEIRA LETRA DE UM EDIT PARA MAISCULOwith Edit2 doif Text '' then Text := AnsiUpperCase(Text[1]) + Copy(Text, 2, Length(Text));Isto pode ser colocado, por exemplo, no OnExit do Edit.Voc pode tambm converter durante a digitao. Para isto coloque o cdigo abaixo no evento OnKeyPress do Edit:if Edit1.SelStart = 0 then Key := AnsiUpperCase(Key)[1]else Key := AnsiLowerCase(Key)[1];Incio da pginaVERIFICAR SE UMA STRING CONTM UMA HORA VLIDA- Use a funo abaixo:function StrIsTime(const S: string): boolean;begin try StrToTime(S); Result := true; except Result := false; end;end;Incio da pginaVERIFICAR SE UMA STRING CONTM UM VALOR NUMRICO VLIDO- Use uma das funes abaixo, conforme o tipo de dado que se quer testar:function StrIsInteger(const S: string): boolean;begin try StrToInt(S); Result := true; except Result := false; end;end;function StrIsFloat(const S: string): boolean;begin try StrToFloat(S); Result := true; except Result := false; end;end;Incio da pginaMOSTRAR UMA MENSAGEM DURANTE UM PROCESSAMENTOProblema:Um processamento em meu sistema bastante demorado e por istocolocar apenas o cursor de ampulheta continua deixando o usurio confuso, pensando que o sistema travou. possvelexibir uma mensagem enquanto um processamento demorado ocorre?Sim. E fcil. Vejamos:- Crie um form com a mensagem. Um pequeno form com um Label j suficiente. Aqui vou cham-lo de FormMsg.- V em Project|Options e passe o FormMsg de "Auto-create forms" para "Available forms".- Abaixo vou simular um processamento demorado, usando a API Sleep:procedure TForm1.Button1Click(Sender: TObject);var Form: TFormMsg; I: integer;begin Form := TFormMsg.Create(Self); try Form.Label1.Caption := 'Processamento demorado...'; Form.Show; for I := 1 to 5 do begin Form.UpDate; Sleep(1000); { Aguarda um segundo } end; finally Form.Free; end;end;ObservaesA funo Sleep uma API do Windows e serve para paralisar a aplicao por um determinado dempo. Este tempo em milisegundos. Incio da pginaMOSTRAR UM CURSOR DE AMPULHETA DURANTE UM PROCESSAMENTO- Salve o cursor atual- Defina o novo cursor (crHourGlass ampulheta)- Faa o processamento- Restaure o cursor.Vejamos:var PrevCur: TCursor;begin PrevCur := Screen.Cursor; try Screen.Cursor := crHourGlass; { Coloque aqui as instrues do processamento } finally Screen.Cursor := PrevCur; end;end; ObservaesExistem diversos outros cursores pr-definidos no Delphi. D uma olhada na propriedade Cursor de um componente visual para ver uma lista de todos eles. Voc poder tambm criar o seu prprio cursor. Incio da pginaLER E ESCREVER DADOS BINRIOS NO REGISTRO DO WINDOWSInclua na seo uses: Registry e windowsColoque no Form:- trs edits;- dois botes.Logo abaixo da palavra implementation declare:type { Declara um tipo registro } TFicha = record Codigo: integer; Nome: string[40]; DataCadastro: TDateTime; end;- Escreva o evento OnClick do Button1 conforme abaixo:procedure TForm1.Button1Click(Sender: TObject);var Reg: TRegistry; Ficha: TFicha;begin { Coloca alguns dados na varivel Ficha } Ficha.Codigo := StrToInt(Edit1.Text); Ficha.Nome := Edit2.Text; Ficha.DataCadastro := StrToDate(Edit3.Text); Reg := TRegistry.Create; try { Define a chave-raiz do registro } Reg.RootKey := HKEY_CURRENT_USER; { Abre uma chave (path). Se no existir cria e abre. } Reg.OpenKey('Cadastro\Pessoas\', true); { Grava os dados (o registro) } Reg.WriteBinaryData('Dados', Ficha, SizeOf(Ficha)); finally Reg.Free; end;end;- Escreva o evento OnClick do Button2 conforme abaixo:procedure TForm1.Button2Click(Sender: TObject);var Reg: TRegistry; Ficha: TFicha;begin Reg := TRegistry.Create; try { Define a chave-raiz do registro } Reg.RootKey := HKEY_CURRENT_USER; { Se existir a chave (path)... } if Reg.KeyExists('Cadastro\Pessoas') then begin { Abre a chave (path) } Reg.OpenKey('Cadastro\Pessoas', false); { Se existir o valor... } if Reg.ValueExists('Dados') then begin { L os dados } Reg.ReadBinaryData('Dados', Ficha, SizeOf(Ficha)); Edit1.Text := IntToStr(Ficha.Codigo); Edit2.Text := Ficha.Nome; Edit3.Text := DateToStr(Ficha.DataCadastro); end else ShowMessage('Valor no existe no registro.') end else ShowMessage('Chave (path) no existe no registro.'); finally Reg.Free; end;end;ObservaesQualquer tipo de dado pode ser gravado e lido de forma binria no registro do Windows. Para isto voc precisa saber o tamanho do dado. Para dados de tamanho fixo, use SizeOf(). Lembrete: no grave dados muito extensos no Registro do Windows (ex: imagens), pois isto prejudicar o desempenho do sistema. Incio da pginaMUDAR A RESOLUO DO VDEO VIA PROGRAMAO- Coloque um ListBox no form- Modifique o OnCreate do form assim:procedure TForm1.FormCreate(Sender: TObject);var i : Integer; DevMode : TDevMode;begin i := 0; while EnumDisplaySettings(nil,i,Devmode) do begin with Devmode do ListBox1.Items.Add(Format('%dx%d %d Colors', [dmPelsWidth,dmPelsHeight, 1 shl dmBitsperPel])); Inc(i); end;end;- Coloque um boto no form- Altere o evento OnClick do boto conforme abaixo:procedure TForm1.Button1Click(Sender: TObject);var DevMode : TDevMode;begin EnumDisplaySettings(nil,Listbox1.ItemIndex,Devmode); ChangeDisplaySettings(DevMode,0);end;ObservaesNos testes que fiz, nem tudo funcionou adequadamente. Mas vale a pena experimentar. Incio da pginaLER E ESCREVER DADOS NO REGISTRO DO WINDOWSInclua na seo uses: Registry e Windows- Coloque no form dois edits e dois botes.- No evento OnClick do Button1 escreva o cdigo abaixo:procedure TForm1.Button1Click(Sender: TObject);var Reg: TRegistry;begin Reg := TRegistry.Create; try { Define a chave-raiz do registro } Reg.RootKey := HKEY_CURRENT_USER; { Abre a chave (path). Se no existir, cria e abre. } Reg.OpenKey('MeuPrograma\Configurao', true); { Escreve um inteiro } Reg.WriteInteger('Numero', StrToInt(Edit1.Text)); { Escreve uma string } Reg.WriteString('Nome', Edit2.Text); finally Reg.Free; end;end;- No evento OnClick do Button2, escreva:procedure TForm1.Button2Click(Sender: TObject);var Reg: TRegistry;begin Reg := TRegistry.Create; try Reg.RootKey := HKEY_CURRENT_USER; if Reg.KeyExists('MeuPrograma\Configurao') then begin Reg.OpenKey('MeuPrograma\Configurao', false); if Reg.ValueExists('Numero') then Edit1.Text := IntToStr(Reg.ReadInteger('Numero')) else ShowMessage('No existe valor com o nome "Numero"'); if Reg.ValueExists('Nome') then Edit2.Text := Reg.ReadString('Nome') else ShowMessage('No existe valor com o nome "Nome"'); end else ShowMessage('No existe a chave no registro'); finally Reg.Free; end;end;ObservaesUser o aplicativo RegEdit.exe do windows para ver o registro. Cuidado para no alterar as configuraes do Windows! Incio da pginaADICIONAR BARRA DE ROLAGEM HORIZONTAL NO LISTBOX{ - Coloque um ListBox no form; - Altere o OnCreate do Form conforme abaixo:}procedure TForm1.FormCreate(Sender: TObject);var I, Temp, MaxTextWidth: integer;begin { Adiciona algumas linhas no ListBox } Listbox1.Items.Add('Linha 1'); Listbox1.Items.Add('Linha 2, longa para que seja necessria a barra de rolagem horizontal'); Listbox1.Items.Add('Linha 3'); if Listbox1.Items.Count > 1 then begin { Obtm o comprimento, em pixels, da linha mais longa } MaxTextWidth := 0; for I := 0 to Listbox1.Items.Count - 1 do begin Temp := ListBox1.Canvas.TextWidth(ListBox1.Items[I]); if Temp > MaxTextWidth then MaxTextWidth := Temp; end; { Acrescenta a largura de um "W" } MaxTextWidth := MaxTextWidth + Listbox1.Canvas.TextWidth('W'); { Envia uma mensagem ao ListBox } SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxTextWidth, 0); end;end;{ Para ocultar use a instruo abaixo: }SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, 0, 0);Incio da pginaSIMULAR UM CHARCASE NO DBGRIDPara converter a digitao para maisculo, coloque isto noevento OnKeyPress do DBGrid:Key := AnsiUpperCase(Key)[1];Para converter para minsculo, troque por:Key := AnsiLowerCase(Key)[1];Incio da pginaVERIFICAR SE UMA STRING UMA DATA VLIDAEscreva a funo abaixo:function tbStrIsDate(const S: string): boolean;begin try StrToDate(S); Result := true; except Result := false; end;end;Para testar:- Coloque um Edit no form;- Coloque um Button;- No evento OnClick do boto coloque o cdigo abaixo:if tbStrIsDate(Edit1.Text) then ShowMessage(Edit1.Text + ' data vlida.')else ShowMessage(Edit1.Text + ' NO data vlida.');Incio da pginaFAZER PESQUISA INCREMENTALProblema:Gostaria de montar um formulrio de pesquisa com um DBGrid eum Edit de modo que, enquanto o usurio digita um nome doEdit, o registro vai sendo localizado no DBGrid. Como fazer?- Crie um ndice na tabela com campo a ser usado na pesquisa.Coloque no Form:- Um DataSource- Um Table- Um DBGrid- Um EditAltere as seguintes propriedades:- DataSource1.DataSet = Table1- Table1.DatabaseName = 'NomeDoAlias'- Table1.TableName = 'NomeDaTabela'- Table1.IndexFieldNames = 'NomeDoCampo'- Table1.Active = true- DBGrid1.DataSource = DataSource1Escreva a instruo abaixo no evento OnChange do Edit:Table1.FindNearest([Edit1.Text]);ObservaesEste exemplo considera que o campo seja tipo string. Para outros tipos de campos pode ocorrer erro dependendo dos valores digitados no Edit1. Incio da pginaADICIONAR ZEROS ESQUERDA DE UM NMEROExistem vrias formas. Vejamos uma:function tbStrZero(const I: integer; const Casas: byte): string;var Ch: Char;begin Result := IntToStr(I); if Length(Result) > Casas then begin Ch := '*'; Result := ''; end else Ch := '0'; while Length(Result) < Casas do Result := Ch + Result;end;{ Exemplo de como us-la: }var S: string; Numero: integer; {...}begin {...} S := tbStrZero(Numero, 6); {...}end; ObservaesSe o comprimento desejado (Casas) no for suficiente para conter o nmero, sero colocados asteriscos. Incio da pginaLIMPAR UM CAMPO TIPO DATA VIA PROGRAMAOTable1.FieldByName('Data').Clear;{ ou }Table1.FieldByName('Data').AsString := '';ObservaesPodemos usar este recurso para limpar tambm campos numricos, string, etc. Incio da pginaIMPLEMENTAR UM CAMPO AUTO-INCREMENTAL VIA PROGRAMAOInclua na seo uses: dbTablesprocedure tbAutoInc(Table: TTable; const FieldName: string);var Q: TQuery;begin if not Table.FieldByName(FieldName).IsNull then Exit; Q := TQuery.Create(nil); try Q.DatabaseName := Table.DatabaseName; Q.SQL.Add('select max(' + FieldName + ') from ' + Table.TableName); Q.Open; try Table.FieldByName(FieldName).AsInteger := Q.Fields[0].AsInteger +1; finally Q.Close; end; finally Q.Free; end;end;{ Chame esta procedure no evento BeforePost de um Table: }procedure TForm1.Table1BeforePost(DataSet: TDataSet);begin tbAutoInc(Table1, 'Codigo');end;ObservaesA funo acima incrementa o campo somente se estiver vazio. Assim podemos dar ao usurio a opo de digitar neste campo ou deix-lo vazio para que seja auto-incrementado. Existem vrias outras formas de implementar este recurso. Incio da pginaOBTER O ENDEREO IP DO DIAL-UPInclua na seo uses: WinSock{ Esta funo retorna o endereo IP do Dial-Up. }function GetLocalIP : string;type TaPInAddr = array [0..10] of PInAddr; PaPInAddr = ^TaPInAddr;var phe : PHostEnt; pptr : PaPInAddr; Buffer : array [0..63] of char; I : Integer; GInitData : TWSADATA;begin WSAStartup($101, GInitData); Result := ''; GetHostName(Buffer, SizeOf(Buffer)); phe :=GetHostByName(buffer); if phe = nil then Exit; pptr := PaPInAddr(Phe^.h_addr_list); I := 0; while pptr^[I] nil do begin result:=StrPas(inet_ntoa(pptr^[I]^)); result := StrPas(inet_ntoa(pptr^[I]^)); Inc(I); end; WSACleanup;end;ObservaesSe o endereo IP for designado pelo servidor, a cada coneco teremos um endereo IP diferente e, obviamente, se no estivermos conectados, no conseguiremos obt-lo. Incio da pginaEXIBIR A CAIXA DE DILOGO PADRO DE SOLICITAO DE SENHA DO BANCO DE DADOSInclua na seo uses: DbPwDlg{ Coloque um boto no form e escreve seu evento OnClick como abaixo }procedure TForm1.Button1Click(Sender: TObject);var pw: TPasswordDialog;begin pw := TPasswordDialog.Create(Self); try pw.Caption := 'Banco de Dados'; pw.GroupBox1.Caption := 'Senha'; pw.AddButton.Caption := '&Adicionar'; pw.RemoveButton.Caption := '&Remover'; pw.RemoveAllButton.Caption := 'Remover &Tudo'; pw.OKButton.Caption := '&OK'; pw.CancelButton.Caption := '&Cancelar'; pw.ShowModal; finally pw.Free; end;end;ObservaesAs senhas adicionadas nesta caixa de dilogo so adicionadas na sesso (TSession) atual. Isto til quando colocamos senha em tabelas Paradox, ou mesmo quando trabalhamos com banco de dados Client Servidor, e queremos que o usurio digite a senha de acesso. Se no fizermos desta forma, nem adicionarmos via programao as senhas necessrias, esta caixa de dilogo ser mostrada quando o programa tentar abrir uma tabela com senha. A grande vantagem aqui que podemos traduzir os Caption's dos componentes. Incio da pginaOBTER A VERSO DA BIBLIOTECA COMCTL32.DLL (USADA NA UNIT COMCTRLS DO DELPHI)Inclua na seo uses: ComCtrls{ A verso desta biblioteca determina a aparncia de alguns controles do Delphi, tais como ToolBar e CoolBar. O exemplo abaixo obtm a verso desta biblioteca. Para este exemplo, coloque um TEdit e um TButton no Form. O evento OnClick do boto escreva o cdigo abaixo: }procedure TForm1.Button1Click(Sender: TObject);var Ver: Cardinal; MaiorVer, MenorVer: Word;begin Ver := GetComCtlVersion; MaiorVer := HiWord(Ver); MenorVer := LoWord(Ver); Edit1.Text := IntToStr(MaiorVer) + '.' + IntToStr(MenorVer);end;ObservaesNormalmente, a verso 4.72 est presente quando o Internet Explorer 4 est instalado. Incio da pginaIMPLEMENTAR ROTINAS ASSEMBLY EM PASCAL{ O Delphi permite a implementao de rotinas assembly mescladas ao cdigo Pascal. No entrarei em detalhes minuciosos, mas darei alguns exemplos bsicos de como implementar rotinas simples que retornam nmeros inteiros.}{ Soma dois inteiros de 8 bits }function Soma8(X, Y: byte): byte;asm mov al, &X add al, &Yend;{ Soma dois inteiros de 16 bits }function Soma16(X, Y: Word): Word;asm mov ax, &X add ax, &Yend;{ Soma dois inteiros de 32 bits }function Soma32(X, Y: DWord): DWord;asm mov eax, &X add eax, &Yend;{ A chamada a estas funes so feitas da mesma forma que chamamos uma funo Pascal. Exemplo: }var A: byte;begin A := Soma8(30, 25); { A = 55 }end;Incio da pginaEXIBIR O DILOGO ABOUT DO WINDOWSInclua na seo uses: Windows{ About padro do Windows }ShellAbout(Handle, 'Windows', '', 0);{ Personalizada }ShellAbout(Handle, 'NomePrograma', 'Direitos autorais reservados a'#13'Fulano de Tal', Application.Icon.Handle);Incio da pginaOBTER A LINHA ATUAL DE UM TMEMO{ Esta procedure obtm a linha e coluna atual de um TMemo }procedure tbGetMemoLinCol(Memo: TMemo; var Lin, Col: Cardinal);begin with Memo do begin Lin := Perform(EM_LINEFROMCHAR, SelStart, 0); Col := SelStart - Perform(EM_LINEINDEX, Lin, 0); end;end;{ Use-a como abaixo: }var Lin, Col: Cardinal;begin tbGetMemoLinCol(Memo1, Lin, Col); { ... }end;Incio da pginaEXIBIR UM ARQUIVO DE AJUDA DO WINDOWSInclua na seo uses: Windows{ Voc precisa saber: - Caminho e nome do arquivo; - A estrutura do arquivo de Help. No exemplo abaixo abre o arquivo de ajuda da Calculadora do Windows e vai para o tpico n. 100}procedure TForm1.Button1Click(Sender: TObject);begin WinHelp(0, 'c:\Win95\Help\Calc.hlp', HELP_CONTEXT, 100);end;ObservaesPara utilizar um arquivo de ajuda em seu programa desenvolvido em Delphi, basta usar os recursos do prprio Delphi. O exemplo acima somente para mostrar o uso de uma API para este fim. Incio da pginaOBTER O VALOR DE UMA VARIVEL DE AMBIENTEInclua na seo uses: Windows{ Esta funo recebe o nome da varivel de ambiente que queremos acessar e retorna uma string com seu valor, ou uma string vazia se a varivel no existir. } function tbGetEnvVar(const VarName: string): string;var I: integer;begin Result := ''; { Obtm o comprimento da varivel } I := GetEnvironmentVariable('PATH', nil, 0); if I > 0 then begin SetLength(Result, I); GetEnvironmentVariable('PATH', PChar(Result), I); end;end;{ Para us-la, faa como neste exemplo: }Edit1.Text := tbGetEnvVar('PATH');Incio da pginaDETERMINAR SE UMA JANELA (FORM) EST MAXIMIZADAInclua na seo uses: Windowsif IsZoomed(Form1.Handle) then { Form1 est maximizado }else { Form2 NO est maximizado }ObservaesVeja a pergunta n. 78. Incio da pginaDETERMINAR SE O CURSOR DO MOUSE EST EM DETERMINADO CONTROLEInclua na seo uses: Windows{ Os exemplos abaixo verificam se o cursor do mouse est em Button1: }{ Soluo 1: }var Pt: TPoint; Rct: TRect;begin GetCursorPos(Pt); GetWindowRect(Button1.Handle, Rct); if PtInRect(Rct, Pt) then { Est no boto } else { NO est no boto }end;{ Soluo 2: }var Pt: TPoint;begin GetCursorPos(Pt); if WindowFromPoint(Pt) = Button1.Handle then { Est no boto } else { No est no boto }end;ObservaesA API GetWindowRect obtm o retngulo (TRect) ocupado por uma janela. Podemos usar GetClientRect para obter o somente da parte cliente da janela. Podemos tambm usar a propriedade BoundsRect que existe na maioria dos componentes visuais, ou mesmo informar qualquer outro retngulo da tela. Se usarmos a propriedade BoundsRect, precisaremos converter as coordenadas clientes para coordenadas de tela (com a funo ClientToScreen). Um lembrete: a soluo 2 s poder ser aplicada a controles ajanelados. Incio da pginaDETERMINAR SE O APLICATIVO EST MINIMIZADOInclua na seo uses: Windowsif IsIconic(Application.Handle) then { Minimizado }else { No minimizado }ObservaesPode-se verificar qualquer janela (form). S um lembrete: quando clicamos no boto de minimizar do form principal, na verdade ele oculto e o Application que minizado. Incio da pginaFECHAR UM APLICATIVO COM UMA MENSAGEM DE ERRO FATALInclua na seo uses: Windowsprocedure TForm1.Button1Click(Sender: TObject);begin FatalAppExit(0, 'Erro fatal na aplicao.');end;ObservaesA funo FatalAppExit uma API do Windows. Esta mostra uma caixa de dilogo (normalmente branca) com a mensagem passada no segundo parmetro. Quando a caixa de dilogo fechada a aplicao finalizada. O evento OnCloseQuery dos forms no so chamados quando usamos esta funo. Incio da pginaUSAR O EVENTO ONGETTEXT DE UM TFIELD Problema: Tenho um sistema de contas a receber, onde um campo chamado "Tipo" contm um nmero inteiro que indica o tipo do documento conforme abaixo: 1 - Promissria 2 - Duplicata 3 - Boleto Gostaria que, ao exibir os dados (num DBGrid por exemplo), fosse exibido o nome e no o nmero, ou seja, "Promissria" em vez de "1". Soluo: Isto pode ser feito de vrias formas, mas aqui vou mostrar como resolver usando o evento OnGetText do TField. Vejamos: - Adicione todos os campos no Field Editor; - Clique no campo "Tipo"; - V ao Object Inspector e d um duplo-click no evento OnGetText; - Neste evento, digite o cdigo abaixo:procedure TForm1.Table1TipoGetText(Sender: TField; var Text: String; DisplayText: Boolean);begin if DisplayText then begin case Table1Tipo.AsInteger of 1: Text := 'Promissria'; 2: Text := 'Duplicata'; 3: Text := 'Boleto'; else Text := 'Desconhecido'; end; end else Text := Table1Tipo.AsString;end;ObservaesAo exibir ser exibido os nomes. Mas ao digitar continue com os 1, 2, 3, etc. Para usar este recurso em relatrios, acesse a propriedade DisplayText em vez de AsString para obter o valor do campo. Incio da pginaMAXIMIZAR UM FORM DE FORMA QUE CUBRA TODA A TELA, INCLUSIVE A BARRA DE TAREFAS{ um "maximizar" com jeitinho brasileiro... mas funciona. No evento OnShow do form coloque o cdigo abaixo: }Top := 0;Left := 0;Width := Screen.Width;Height := Screen.Height;ObservaesNos testes que fiz, mesmo com a barra de tarefas marcada como "Sempre Visvel", funcionou perfeitamente. Fiz os testes usando o Win95. Talvez em novas verses, possa apresentar problemas. Incio da pginaVERIFICAR, VIA PROGRAMAO, SE LOCAL SHARE DO BDE EST TRUEInclua na seo uses: Registry, SysUtils, Windows{ Esta funo retorna true se Local Share estiver "TRUE". Caso contrrio, retorna false. }function tbBDELocalShare: boolean;const BdeKey = 'SOFTWARE\Borland\Database Engine\Settings\SYSTEM\INIT'; Ident = 'LOCAL SHARE';var Reg: TRegistry;begin Result := false; Reg := TRegistry.Create; try Reg.RootKey := HKEY_LOCAL_MACHINE; if Reg.OpenKey(BdeKey, False) then if Reg.ValueExists(Ident) then Result := UpperCase(Reg.ReadString(Ident)) = 'TRUE'; finally Reg.Free; end;end;{ Use-a como abaixo: }if tbBDELocalShare then { Local Share est TRUE }else { Local Share est FALSE }ObservaesA funo acima faz a verificao no registro do Windows. Por isto est sujeita a falha caso o BDE coloque as configuraes em outro local ( o caso do BDE salvar as configuraes no formato do Windows 3.x). O ideal seria usar uma API do BDE, mas at o momento no conheo uma que retorne esta informao. Caso algum saiba, queira por gentileza nos informar. Incio da pginaCRIAR UM EXE QUE SEJA EXECUTADO APENAS ATRAVS DE OUTRO EXE CRIADO POR MIMInclua na seo uses: Windows Problema: Gostaria que um determinado programa (Prog1.EXE) fosse executado apenas atravs de outro programa (Prog2.EXE). Soluo: Antes da linha "Application.Initialize;" de Prog1.dpr (programa a ser chamado), coloque o cdigo abaixo:if ParamStr(1) 'MinhaSenha' then begin { Para usar ShowMessage, coloque Dialogs no uses } ShowMessage('Execute este programa atravs de Prog2.EXE'); Halt; { Finaliza }end;{ No Form1 de Prog2 (programa chamador) coloque um boto e escreva o OnClick deste boto como abaixo:}procedure TForm1.Button1Click(Sender: TObject);var Erro: Word;begin Erro := WinExec('Pro2.exe MinhaSenha', SW_SHOW); if Erro 0 then with Memo1.Lines do begin if (Attr and FILE_ATTRIBUTE_ARCHIVE) > 0 then Add('Archive'); if (Attr and FILE_ATTRIBUTE_COMPRESSED) > 0 then Add('Compressed'); if (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0 then Add('Directory'); if (Attr and FILE_ATTRIBUTE_HIDDEN) > 0 then Add('Hidden'); if (Attr and FILE_ATTRIBUTE_NORMAL) > 0 then Add('Normal'); if (Attr and FILE_ATTRIBUTE_OFFLINE) > 0 then Add('OffLine'); if (Attr and FILE_ATTRIBUTE_READONLY) > 0 then Add('ReadOnly'); if (Attr and FILE_ATTRIBUTE_SYSTEM) > 0 then Add('System'); if (Attr and FILE_ATTRIBUTE_TEMPORARY) > 0 then Add('Temporary'); end;end;Incio da pginaOBTER O ESPAO TOTAL E LIVRE DE UM DISCOInclua na seo uses: Windows{ - Coloque um memo (TMemo) no form; - Coloque um boto e altere seu OnClick como abaixo: }procedure TForm1.Button1Click(Sender: TObject);var SetoresPorAgrup, BytesPorSetor, AgrupLivres, TotalAgrup: DWord;begin Memo1.Clear; if GetDiskFreeSpace('C:\', SetoresPorAgrup, BytesPorSetor, AgrupLivres, TotalAgrup) then with Memo1.Lines do begin Add('Setores por agrupamento: ' + IntToStr(SetoresPorAgrup)); Add('Bytes por setor: ' + IntToStr(BytesPorSetor)); Add('Agrupamentos livres: ' + IntToStr(AgrupLivres)); Add('Total de agrupamentos: ' + IntToStr(TotalAgrup)); Add('----- Resumo -----'); Add('Total de bytes: ' + IntToStr(TotalAgrup * SetoresPorAgrup * BytesPorSetor)); Add('Bytes livres: ' + IntToStr(AgrupLivres * SetoresPorAgrup * BytesPorSetor)); end;end;{ O exemplo acima retorna as medidas em Bytes, Setores e Agrupamentos. Se preferir algo mais simples, use funes do Delphi. Veja: }Memo1.Lines.Add('Total de bytes: ' + IntToStr(DiskSize(3)));Memo1.Lines.Add('Bytes livres: ' + IntToStr(DiskFree(3)));{ Onde o parmetro (3) o nmero da unidade, sendo 1=A, 2=B, 3=C, ... }ObservaesPara usar as funes DiskSize e DiskFree coloque SysUtils em uses. Incio da pginaOBTER O TIPO DE UM DRIVE (REMOVVEL, FIXO, CD-ROM, UNIDADE DE REDE, ETC)Inclua na seo uses: Windows, Dialogs{ - Coloque um edit (Edit1) e um boto no form; - Altere o OnClick do boto conforme abaixo: }procedure TForm1.Button1Click(Sender: TObject);var S: string; Tipo: byte;begin Tipo := GetDriveType(PChar(Edit1.Text[1] + ':\')); case Tipo of 0: S := 'Tipo indeterminado'; 1: S := 'Drive no existe'; DRIVE_REMOVABLE: S := 'Disco removvel'; DRIVE_FIXED: S := 'Disco Fixo'; DRIVE_REMOTE: S := 'Unidade de rede'; DRIVE_CDROM: S := 'CD-ROM'; DRIVE_RAMDISK: S := 'RAM Disk'; else S := 'Erro'; end; ShowMessage(S);end;{ Para pegar o tipo da unidade atual troque...} Tipo := GetDriveType(PChar(Edit1.Text[1] + ':\'));{ por } Tipo := GetDriveType(nil);ObservaesPara testar digite a letra do drive no Edit1 e clique no boto. A unit Dialogs foi colocada no uses apenas por causa da procedure ShowMessage. Para exibir todas as unidades existentes e seus respectivos tipos, use a funo tbGetDrives (da pergunta 64) em conjunto com este exemplo. Incio da pginaOBTER INFORMAES DE UM VOLUME/DISCO (LABEL, SERIAL, SISTEMA DE ARQUIVOS, ETC)Inclua na seo uses: Windows, System{ - Coloque um memo (TMemo) no form; - Coloque um boto e escreve seu evento OnClick como abaixo: }procedure TForm1.Button1Click(Sender: TObject);var SLabel, SSysName: PChar; Serial, FileNameLen, X: DWord;begin Memo1.Clear; GetMem(SLabel, 255); GetMem(SSysName, 255); try GetVolumeInformation('C:\', SLabel, 255, @Serial, FileNameLen, X, SSysName, 255); with Memo1.Lines do begin Add('Nome do volume (Label): ' + string(SLabel)); Add('Nmero Serial: ' + IntToHex(Serial, 8)); Add('Tamanho mximo p/ nome arquivo: ' + IntToStr(FileNameLen)); Add('Sistema de Arquivos: ' + string(SSysName)); end; finally FreeMem(SLAbel, 255); FreeMem(SSysName, 255); end;end;Incio da pginaALTERAR O NOME DE VOLUME (LABEL) DE UM DISCOInclua na seo uses: Windows{ Da unidade C: }SetVolumeLabel('c:\', 'NovoLabel');{ Da unidade atual: }SetVolumeLabel(nil, 'NovoLabel');ObservaesVeja a pergunta n 66. Incio da pginaSABER QUAIS AS UNIDADES DE DISCO (DRIVES) ESTO PRESENTESInclua na seo uses: Windows{ A funo abaixo retorna uma string contendo as letras de unidades de discos presentes. }function tbGetDrives: string;var Drives: DWord; I: byte;begin Result := ''; Drives := GetLogicalDrives; if Drives 0 then for I := 65 to 90 do if ((Drives shl (31 - (I - 65))) shr 31) = 1 then Result := Result + Char(I);end;{ Para saber se uma determinada unidade est presente, basta fazer algo como: }if Pos('A', tbGetDrives) > 0 then ShowMessage('Unidade A: presente.')else ShowMessage('Unidade A: ausente.');ObservaesA string retornada pela funo tbGetDrives est sempre em letras maisculas. Incio da pgina"Truncar" Valores Reais Para Apenas N Casas Decimais{ s vezes voc precisa considerar apenas duas casas de valores reais, mas o Delphi no oferece algo pronto para isto. Se usarmos funes como Round que vem com o Delphi, o valor ser arredondado (e no truncado). Com Round() o valor abaixo ser 135.55 (e no 135.54) com duas casas decimais.}ValorReal := 135.54658;{ Somente a parte inteira - nenhuma casa decimal }X := Trunc(ValorReal); // X ser 135{ Duas casas }X := Trunc(ValorReal * 100) / 100; // X ser 135.54{ Trs casas }X := Trunc(ValorReal * 1000) / 1000; // X ser 135.5465ObservaesIsto pode no funcionar se ValorReal for muito alto. Isto por causa da multiplicao que poder estourar a capacidade do tipo em uso. Lembre-se: os tipos reais aceitam valores muuuiiiito altos. Incio da pginaEXCLUIR TODOS OS REGISTROS DE UMA TABELA (COMO DELETE ALL DO CLIPPER)procedure tbDBDeleteAll(const DataSet: TDataSet);begin with DataSet do while RecordCount > 0 do Delete;end;{ Chame-a como nos exemplos abaixo: }tbDBDeleteAll(Table1);outbDBDeleteAll(Query1);ObservaesSe houver um filtro ou range ativo, somente os registros filtrados sero excludos. Portanto diferente de Table1.EmptyTable. Esta funo poder ser chamada no evento BeforeDelete do Table (ou Query) principal em um formulrio mestre-detalhe para excluir os itens (da parte detalhe). Incio da pginaSABER SE O SISTEMA EST USANDO 4 DGITOS PARA O ANO{ Para no correr o risco de surpresas desagradveis, melhor que seu programa em Delphi verifique se o Windows est ajustado para trabalhar com 4 dgitos para o ano. Assim seu programa pode alertar o usurio quando o ano estiver sendo representado com apenas 2 dgitos. A funo abaixo retorna true se estiver ajustado para 4 dgitos.}function Is4DigitYear: Boolean;begin result:=(Pos('yyyy',ShortDateFormat)>0);end;Incio da pginaIMPRIMIR CARACTERES ACENTUADOS DIRETAMENTE PARA A IMPRESSORA{ Usando comandos da impressora podemos fazer isto de uma forma bastante simples. Quando enviamos o caractere ASCII nmero 8 (oito) para a impressora, a cabea de impresso retrocede uma posio, pois este caractere o BackSpace. Ento podemos imprimir a letra sem acento e, sem seguida, voltar e imprimir o acento desejado. Vejamos um exemplo: - Coloque um boto no form; - Altere o evento OnClick deste boto conforme abaixo:}procedure TForm1.Button2Click(Sender: TObject);var F: TextFile;begin AssignFile(F, 'LPT1'); Rewrite(F); try { Regra: caractere sem acento + chr(8) + acento } WriteLn(F, 'Este e' + #8 + '''' + ' um teste.'); WriteLn(F, 'Acentuac' + #8 + ',a' + #8 + '~o.'); WriteLn(F, 'Vovo' + #8 + '^'); WriteLn(F, 'U' + #8 + '''' + 'ltimo.'); WriteLn(F, #12); // Eject finally CloseFile(F); end;end;ObservaesUsando este recurso, a acentuao no fica excelente, mas melhora bastante. Incio da pginaIMPRIMIR TEXTO JUSTIFICADO COM FORMATAO NA IMPRESSORA EPSON LX-300{ A impressora Epson LX-300 dispe de um comando que justifica o texto. Este recurso interessante, pois com ele podemos continuar a enviar os comandos de formatao de caracteres como condensado, negrito, italico, expandido, etc. Para o exemplo abaixo: - Coloque um boto no form; - Altere o evento OnClick deste boto como abaixo: }procedure TForm1.Button1Click(Sender: TObject);const cJustif = #27#97#51; cEject = #12; { Tamanho da fonte } c10cpi = #18; c12cpi = #27#77; c17cpi = #15; cIExpandido = #14; cFExpandido = #20; { Formatao da fonte } cINegrito = #27#71; cFNegrito = #27#72; cIItalico = #27#52; cFItalico = #27#53;var Texto: string; F: TextFile;begin Texto := c10cpi + 'Este e um teste para impressora Epson LX 300. ' + 'O objetivo e imprimir texto justificado sem deixar ' + 'de usar formatacao, tais como: ' + cINegrito + 'Negrito, ' + cFNegrito + cIItalico + 'Italico, ' + cFItalico + c17cpi + 'Condensado (17cpi), ' + c10cpi + c12cpi + '12 cpi, ' + c10cpi + cIExpandido + 'Expandido.' + cFExpandido + ' Este e apenas um exemplo, mas voce podera adapta-lo ' + 'a sua realidade conforme a necessidade.'; AssignFile(F, 'LPT1'); Rewrite(F); try WriteLn(F, cJustif, Texto); WriteLn(F, cEject); finally CloseFile(F); end;end;ObservaesEste recurso de justificao da Epson LX-300 pode ser usado em qualquer linguagem de programao. Incio da pginaFORMATAR UM DISQUETE ATRAVS DE UM PROGRAMA DELPHI{ Coloque o cdigo abaixo imediatamente abaixo da palavra implementation: }const SHFMT_ID_DEFAULT = $FFFF; { Opes de formatao } SHFMT_OPT_QUICKFORMAT = $0000; { Formatao rpida } SHFMT_OPT_FULL = $0001; { Formatao completa } SHFMT_OPT_SYSONLY = $0002; { Copia sistema } { Cdigos de errros } SHFMT_ERROR = $FFFFFFFF; { Ocorreu erro } SHFMT_CANCEL = $FFFFFFFE; { Foi cancelado } SHFMT_NOFORMAT = $FFFFFFFD; { No formatou }function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive'{ Coloque um boto no form e altere o evento OnClick dele conforme abaixo: }procedure TForm1.Button3Click(Sender: TObject);var Erro: DWord; Msg: string;begin Erro := SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT); case Erro of SHFMT_ERROR: Msg := 'Ocorreu um erro.'; SHFMT_CANCEL: Msg := 'A formatao foi cancelada.'; SHFMT_NOFORMAT: Msg := 'No foi possvel formatar.'; else Msg := 'Disco formatado com sucesso.'; end; ShowMessage(Msg);end;ObservaesPara formatao completa troque SHFMT_OPT_QUICKFORMAT por SHFMT_OPT_FULL. O segundo parmetro (zero no exemplo) indica a unidade, sendo que A 0 (zero), B 1, etc. Incio da pginaALTERAR (E RESTAURAR) O TAMANHO DA PGINA NA IMPRESSORAInclua na seo uses: tbPrn{ - Peque em nosso Download o arquivo tbPrn.zip. Ele contm a unit tbPrn.pas, onde est a funo tbPrnSetPaperSize usada no exemplo abaixo; - Adicione a unit tbPrn.pas em seu projeto; - Siga o exemplo abaixo para criar seus relatrios usando o TPrinter.}procedure TForm1.Button1Click(Sender: TObject);var Papel: TtbPrnPaper;begin Papel.Size := 256; // 256 o tam. personalizado Papel.Width := 2100; // 21 cm Papel.Height := 1000; // 10 cm Papel := tbPrnSetPaperSize(Papel); try Printer.BeginDoc; try { coloque aqui os comandos para impresso } finally Printer.EndDoc; end; finally tbPrnSetPaperSize(Papel); // Restaura o tamanho end;end;{ Papel.Size refere-se ao tamanho do papel. Veja alguns: 0 - Default 1 - Letter 5 - Legal 8 - A3 9 - A4 11 - A5 256 - Custom (personalizado) }ObservaesS ser necessrio informar Papel.Height e Papel.Width quando Papel.Size for 256. Incio da pginaREPRODUZIR UM ARQUIVO DE SOM WAV SEM O TMEDIAPLAYERInclua na seo uses: MMSystem{ Sncrona: aguarda terminar a reproduo para continuar: }SndPlaySound('C:\Win95\Media\Office97\Lembrete.wav', SND_SYNC);{ Assncrona: a execuo continua normalmente enquanto ocorre a reproduo: }SndPlaySound('C:\Win95\Media\Office97\Lembrete.wav', SND_ASYNC);{ Contnua: a reproduo repetida num efeito de loop. Este tipo de reproduo precisa ser assncrona: }SndPlaySound('C:\Win95\Media\Office97\Lembrete.wav', SND_ASYNC or SND_LOOP);{ Interrompe uma reproduo contnua: }SndPlaySound(nil, 0);ObservaesA reproduo contnua pode ser usada, por exemplo, para altertar o usurio em uma situao extremamente crtica. Se o equipamento no possuir placa de som, o arquivo no ser reproduzido. Incio da pginaOBTER O NOME DO USURIO E DA EMPRESA INFORMADO DURANTE A INSTALAO DO WINDOWSInclua na seo uses: Registry{ Coloque um boto no form e altere seu evento OnCkick como abaixo: }procedure TForm1.Button1Click(Sender: TObject);var Reg: TRegIniFile; S: string;begin Reg := TRegIniFile.Create('SOFTWARE\MICROSOFT\MS SETUP (ACME)\'); try S := Reg.ReadString('USER INFO','DefName',''); S := S + #13; S := S + Reg.ReadString('USER INFO','DefCompany',''); ShowMessage(S); finally Reg.free; end; end; Incio da pginaCOPIAR ARQUIVOS USANDO O SHELL DO WINDOWSInclua na seo uses: ShellApi{ - Coloque um boto no form e altere o evento OnClick deste boto conforme abaixo: } procedure TForm1.Button1Click(Sender: TObject);var Dados: TSHFileOpStruct;begin FillChar(Dados,SizeOf(Dados), 0); with Dados do begin wFunc := FO_COPY; pFrom := PChar('c:\teste\*.txt'); pTo := PChar('a:\'); fFlags:= FOF_ALLOWUNDO; end; SHFileOperation(Dados);end;ObservaesEsta forma de copiar arquivos oferecem vrias vantagens. O Shell avisa para pr um prximo disco quando o atual estiver cheio. Mostra a barra de progresso. Pode copiar arquivos usando mscara de uma forma extremamente simples. Incio da pginaEVITAR QUE SEU PROGRAMA APAREA NA BARRA DE TAREFASInclua na seo uses: Windows{ Voc j observou a caixa "Propriedades", aquela que mostra as propriedades de um arquivo no Windows Explorer, no aparece na lista do Alt+Tab e tampouco na barra de tarefas? Isto ocorre porque ela funciona como uma ToolWindow, enquanto os demais aplicativos funcionam como AppWindow. Porm podemos mudar o comportamento de nossos programas feito em Delphi para que se comportem como uma ToolWindow tambm. Para experimentar, crie um novo projeto e altere o Project1.dpr como abaixo (no esquea do uses):}program Project1;uses Forms, Windows, Unit1 in 'Unit1.pas' {Form1};{$R *.RES}var ExtendedStyle : Integer;begin Application.Initialize; ExtendedStyle := GetWindowLong(Application.Handle, gwl_ExStyle); SetWindowLong(Application.Handle, gwl_ExStyle, ExtendedStyle or ws_Ex_ToolWindow and not ws_Ex_AppWindow); Application.CreateForm(TForm1, Form1); Application.Run;end.ObservaesAo executar observe a barra de tarefas e teste o Alt+Tab (seu programa no estar l!). Incio da pginaUSAR EVENTOS DE SOM DO WINDOWS{ Evento Som Padro }MessageBeep(0); { ou Beep; }{ Evento Parada Crtica }MessageBeep(16);{ Evento Pergunta }MessageBeep(32);{ Evento Exclamao }MessageBeep(48);{ Evento Asterisco }MessageBeep(64);Incio da pginaMUDAR A COLUNA ATIVA EM UM DBGRID VIA PROGRAMAO{ Usando nmero da coluna (zero a primeira coluna): }DBGrid1.SelectedIndex := 0;{ Usando o nome do campo }DBGrid1.SelectedField := Table1.FieldByName(Edit2.Text);ObservaesAconselho usar o nome do campo quando o que importa o campo e no a posio. Use o nmero da coluna somente quando o que importa a posio, e no o campo. Incio da pginaENVIAR UM ARQUIVO PARA A LIXEIRAInclua na seo uses: ShellApi{ Coloque a procedure abaixo na seo implementation }procedure ArqParaLixeira(const NomeArq: string; var MsgErro: string);var Op: TSHFileOpStruct;begin MsgErro := ''; if not FileExists(NomeArq) then begin MsgErro := 'Arquivo no encontrado.'; Exit; end; FillChar(Op, SizeOf(Op), 0); with Op do begin wFunc := FO_DELETE; pFrom := PChar(NomeArq); fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT; end; if ShFileOperation(Op) 0 then MsgErro := 'No foi possvel enviar o arquivo para a lixeira.';end;{ - Coloque um boto no Form; - Altere o evento OnClick do boto conforme abaixo: }procedure TForm1.Button1Click(Sender: TObject);var S: string;begin ArqParaLixeira('c:\Diretorio\Teste.doc', S); if S = '' then ShowMessage('O arquivo foi enviado para a lixeira.') else ShowMessage(S);end;Incio da pginaOBTER O NMERO DO REGISTRO ATUALTable1.RecNo()Incio da pginaTRABALHAR COM FILTER DE FORMA MAIS PRTICASe voc est habituado a usar este cdigo no filter...Table1.Filter := 'Nome = '''+ Edit1.Text + '''';ouTable1.Filter := 'Data = ''' + DateToStr(Date) + '''';Tente usar este:Table1.Filter := 'Nome = ' + QuotedStr(Edit1.Text);ouTable1.Filter := 'Data = ' + QuotedStr(DateToStr(Date));ObservaesA funo QuitedStr() coloca apstrofos envolvendo a string. Se houver um apstrofo como parte da string, ela o subtitui por dois apstrofos, para que seja corretamente interpretado. Incio da pginaREPRODUZIR UM ARQUIVO WAVInclua na seo uses: MMSystemPlaySound('C:\ArqSom.wav', 1, SND_ASYNC);ObservaesTroque o nome do arquivo (C:\ArqSom.wav) pelo arquivo desejado. Incio da pginaEXECUTAR UM PROGRAMA DOS E FECH-LO EM SEGUIDA{ Coloque isto no evento OnClick de um boto: }WinExec('command.com /c programa.exe',sw_ShowNormal);{ Se quizer passar parmetros pasta adicion-los aps o nome do programa. Exemplo: }WinExec('command.com /c programa.exe param1 param2',sw_ShowNormal);ObservaesSe quizer que a janela do programa no aparea, troque sw_ShowNormal por sw_Hide. Incio da pgina41 - FECHAR UM PROGRAMA A PARTIR DE UM PROGRAMA DELPHI{ - Coloque um boto no form e altere seu evento OnClick conforme abaixo: }procedure TForm1.Button1Click(Sender: TObject);var Janela: HWND;begin Janela := FindWindow('OpusApp'), nil); if Janela = 0 then ShowMessage('Programa no encontrado') else PostMessage(Janela, WM_QUIT, 0, 0);end;ObservaesEste exemplo fecha o MS Word 97 se estiver aberto. A mensagem WM_QUIT fecha o programa da forma "ignorante". Isto significa que se houver dados no salvos, o programa a ser fechado no oportunidade para salv-los. Uma alternativa mais suave trocar a mensagem WM_QUIT por WM_CLOSE. Veja as perguntas 18 e 36. Incio da pginaCOLOCAR HINT'S DE VRIAS LINHAS{ - Coloque um TButton no Form; - Altere o evento OnCreate do Form como abaixo: }procedure TForm1.FormCreate(Sender: TObject);begin Button1.Hint := 'Linha 1 da dica' + #13 + 'Linha 2 da dica' + #13 + 'Linha 3 da dica'; Button1.ShowHint := true;end;Incio da pginaREPRODUZIR UM VDEO AVI em foco. JEM UM FORM{ - Crie um novo projeto. Este j dever ter o Form1; - Adicione um novo Form (Form2); - Coloque, no Form1, um TMediaPlayer (paleta System) e um boto; - Altere o evento OnClick do boto como abaixo: } procedure TForm1.Button1Click(Sender: TObject);begin with MediaPlayer1 do begin FileName := 'c:\speedis.avi'; Open; { Ajusta tamanho do Form } with MediaPlayer1.DisplayRect do begin Form2.ClientHeight := Bottom - Top; Form2.ClientWidth := Right - Left; end; Display := Form2; Form2.Show; Play; end;end;ObservaesEm vez de ajustar o Form ao vdeo, podemos ajustar o vdeo ao Form. Para isto troque o trecho with..end; por MediaPlayer1.DisplayRect := Form2.ClientRect; Incio da pginaSEPARAR (FILTRAR) CARACTERES DE UMA STRING{ Abaixo da palavra implementation digite: }type TChars = set of Char;function FilterChars(const S: string; const ValidChars: TChars): string;var I: integer;begin Result := ''; for I := 1 to Length(S) do if S[I] in ValidChars then Result := Result + S[I];end;{ Para usar a funo: - Coloque um boto no Form; - Altere o evento OnClick deste boto conforme abaixo: }procedure TForm1.Button4Click(Sender: TObject);begin { Pega s letras } ShowMessage(FilterChars('D63an*%i+/e68l13', ['A'..'Z', 'a'..'z'])); { Pega s nmeros } ShowMessage(FilterChars('D63an*%i+/e68l13', ['0'..'9']));end;ObservaesSe quizer usar este funo em outras unit's, coloque a declarao do tipo TChars na seo interface. Coloque a tambm uma declarao da funo FilterChars. E no se esquea da clusula uses. Incio da pginaCOLOCAR ZEROS ESQUERDA DE NMEROS{ Isto coloca zeros esquerda do nmero at completar 6 casas }S := FormatFloat('000000', 5); Observaes"S" precisa ser uma varivel string. Incio da pginaCOPIAR ARQUIVOS USANDO CURINGAS (*.*){ - Coloque um Button no Form; - Altere o evento OnClick deste Button conforme abaixo: }procedure TForm1.Button2Click(Sender: TObject);var SR: TSearchRec; I: integer; Origem, Destino: string;begin I := FindFirst('c:\Origem\*.*', faAnyFile, SR); while I = 0 do begin if (SR.Attr and faDirectory) faDirectory then begin Origem := 'c:\Origem\' + SR.Name; Destino := 'c:\Destino\' + SR.Name; if not CopyFile(PChar(Origem), PChar(Destino), true) then ShowMessage('Erro ao copiar ' + Origem + ' para ' + Destino); end; I := FindNext(SR); end;end;ObservaesNo exemplo acima, se o arquivo j existir no destino, a funo falha (no copia). Para que a funo possa sobreescrever o arquivo destino (caso exista), altere o ltimo parmetro de CopyFile para false. CUIDADO! Se um arquivo for sobreescrito, estar perdido para sempre! Veja as perguntas n 35 e 53. Incio da pginaCOPIAR ARQUIVOS{ - Coloque um Button no Form; - Altere o evento OnClick deste Button conforme abaixo: }procedure TForm1.Button2Click(Sender: TObject);var Origem, Destino: string;begin Origem := 'c:\Origem\NomeArq.txt'; Destino := 'c:\Destino\NomeArq.txt'; if not CopyFile(PChar(Origem), PChar(Destino), true) then ShowMessage('Erro ao copiar ' + Origem + ' para ' + Destino);end;ObservaesNo exemplo acima, se o arquivo j existir no destino, a funo falha (no copia). Para que a funo possa sobreescrever o arquivo destino (caso exista), altere o ltimo parmetro de CopyFile para false. CUIDADO! Se um arquivo for sobreescrito, estar perdido para sempre! Veja as perguntas n 36 e 53. Incio da pginaTRABALHAR COM CORES NO FORMATO STRINGprocedure TForm1.Button3Click(Sender: TObject);begin { Exibe as cores atuais dos Edit's } ShowMessage(ColorToString(Edit1.Color)); ShowMessage(ColorToString(Edit2.Color)); { Altera as cores dos Edit's } Edit1.Color := StringToColor('clBlue'); Edit2.Color := StringToColor('$0080FF80');end;Incio da pginaVERIFICAR SE DETERMINADO PROGRAMA EST EM EXECUO (WORD, DELPHI, ETC){ Coloque um Button no Form e altere o evento OnClick deste como abaixo: }procedure TForm1.Button1Click(Sender: TObject);begin { Verifica o Delphi } if FindWindow('TAppBuilder', nil) > 0 then ShowMessage('O Delphi est aberto') else ShowMessage('O Delphi NO est aberto'); { Verifica o Word } if FindWindow('OpusApp', nil) > 0 then ShowMessage('O Word est aberto') else ShowMessage('O Word NO est aberto'); { Verifica o Excell } if FindWindow('XLMAIN', nil) > 0 then ShowMessage('O Excell est aberto') else ShowMessage('O Excell NO est aberto');end;ObservaesH uma margem de erro nesta verificao: pode haver outros programas que possuam uma janela com os mesmos nomes. Voc mesmo pode criar aplicativos em Delphi e, propositadamente, criar uma janela com um destes nomes. Veja a pergunta n 18. Incio da pginaEXCLUIR ARQUIVOS USANDO CURINGAS (*.*){ - Coloque um Button no Form; - Altere o evento OnClick do Button conforme abaixo: }procedure TForm1.Button2Click(Sender: TObject);var SR: TSearchRec; I: integer;begin I := FindFirst('c:\Teste\*.*', faAnyFile, SR); while I = 0 do begin if (SR.Attr and faDirectory) faDirectory then if not DeleteFile('c:\Teste\' + SR.Name) then ShowMessage('No consegui excluir c:\Teste\' + SR.Name); I := FindNext(SR); end;end;ObservaesNo exemplo acima todos os arquivos do diretrio c:\Teste sero excludos. CUIDADO! Arquivos excludos desta forma no vo para a lixeira. Veja a pergunta n 46. Incio da pginaGERAR UMA TABELA NO WORD ATRAVS DO DELPHIInclua na seo uses: ComObj{ - Coloque um boto no Form; - Altere o evento OnClick do boto conforme abaixo: }procedure TForm1.Button1Click(Sender: TObject);var Word: Variant;begin { Abre o Word } Word := CreateOleObject('Word.Application'); try { Novo documento } Word.Documents.Add; try { Adiciona tabela de 2 linhas e 3 colunas } Word.ActiveDocument.Tables.Add( Range := Word.Selection.Range, NumRows := 2, NumColumns := 3); { Escreve na primeira clula } Word.Selection.TypeText(Text := 'Linha 1, Coluna 1'); { Prxima clula } Word.Selection.MoveRight(12); { Escreve } Word.Selection.TypeText(Text := 'Linha 1, Coluna 2'); Word.Selection.MoveRight(12); Word.Selection.TypeText(Text := 'Linha 1, Coluna 3'); Word.Selection.MoveRight(12); Word.Selection.TypeText(Text := 'Linha 2, Coluna 1'); Word.Selection.MoveRight(12); Word.Selection.TypeText(Text := 'Linha 2, Coluna 2'); Word.Selection.MoveRight(12); Word.Selection.TypeText(Text := 'Linha 2, Coluna 3'); { Auto-Formata } Word.Selection.Tables.Item(1).Select; { Seleciona a 1 tabela } Word.Selection.Cells.AutoFit; { auto-formata } { Imprime 1 cpia } Word.ActiveDocument.PrintOut(Copies := 1); ShowMessage('Aguarde o trmino da impresso...'); { Para salvar... } Word.ActiveDocument.SaveAs(FileName := 'c:\Tabela.doc'); finally { Fecha documento } Word.ActiveDocument.Close(SaveChanges := 0); end; finally { Fecha o Word } Word.Quit; end;end;ObservaesForam usados neste exemplo o Delphi4 e MS-Word97. Incio da pginaOBTER A QUANTIDADE DE REGISTROS TOTAL E VISVEL DE UMA TABELAInclua na seo uses: DbiProcsOs componentes TTable e TQuery possuem a propriedadeRecordCount que indicam a quantidade de registros da tabela.No entanto esta propriedade dependente de filtros, ou seja, se tivermos uma tabela com dez registros com campo "Codigo" de em foco. J1 a 10 e aplicarmos o filtro mostrado a seguir,a propriedade RecordCount retornar 5 e no 10.Table1.Filter := 'Codigo = 0;end;{ - Coloque no Form1 um TEdit (Edit1) - Coloque no Form1 um TButton - Altere o evento OnClick do Button1 conforme abaixo: }procedure TForm1.Button1Click(Sender: TObject);begin if DriveOk(Edit1.Text[1]) then ShowMessage('Drive no preparado') else ShowMessage('Drive OK');end;ObservaesPara testar voc dever executar o exemplo e digitar no Edit a letra do drive a ser testado (no precisa os dois-pontos). Aps digitar, clique no Button1. Incio da pginaSALVAR/RESTAURAR O TAMANHO E POSIO DE FORM'S{ Crie uma nova Unit conforme abaixo: }unit uFormFunc;interfaceuses Forms, IniFiles, SysUtils, Messages, Windows;procedure tbLoadFormStatus(Form: TForm; const Section: string);procedure tbSaveFormStatus(Form: TForm; const Section: string);implementationprocedure tbSaveFormStatus(Form: TForm; const Section: string);var Ini: TIniFile; Maximized: boolean;begin Ini := TIniFile.Create(ChangeFileExt( ExtractFileName(ParamStr(0)),'.INI')); try Maximized := Form.WindowState = wsMaximized; Ini.WriteBool(Section, 'Maximized', Maximized); if not Maximized then begin Ini.WriteInteger(Section, 'Left', Form.Left); Ini.WriteInteger(Section, 'Top', Form.Top); Ini.WriteInteger(Section, 'Width', Form.Width); Ini.WriteInteger(Section, 'Height', Form.Height); end; finally Ini.Free; end;end;procedure tbLoadFormStatus(Form: TForm; const Section: string);var Ini: TIniFile; Maximized: boolean;begin Maximized := false; { Evita msg do compilador } Ini := TIniFile.Create(ChangeFileExt( ExtractFileName(ParamStr(0)),'.INI')); try Maximized := Ini.ReadBool(Section, 'Maximized', Maximized); Form.Left := Ini.ReadInteger(Section, 'Left', Form.Left); Form.Top := Ini.ReadInteger(Section, 'Top', Form.Top); Form.Width := Ini.ReadInteger(Section, 'Width', Form.Width); Form.Height := Ini.ReadInteger(Section, 'Height', Form.Height); if Maximized then Form.Perform(WM_SIZE, SIZE_MAXIMIZED, 0); { A propriedade WindowState apresenta Bug. Por isto usei a mensagem WM_SIZE } finally Ini.Free; end;end;end.{Em cada formulrio que deseja salvar/restaurar: - Inclua na seo uses: uFormFunc - No evento OnShow digite: tbLoadFormStatus(Self, Self.Name); - No evento OnClose digite: tbSaveFormStatus(Self, Self.Name);}ObservaesO arquivo INI ter o nome do executvel e extenso INI e ser salvo no diretrio do Windows. A palavra Self indica o Form relacionado com a unit em foco. Jem questo. Poderia ser, por exemplo, Form1, Form2, etc. Onde aparece Self.Name poder ser colocado um nome a sua escolha. Este nome ser usado como SectionName no arquivo INI e deve ser idntico no evento OnShow e OnClose de um mesmo Form, porm para cada Form dever ser usado um nome diferente. Incio da pginaDEFINIR A QUANTIDADE DE REGISTROS A SER IMPRESSA em foco. JEM UMA PGINA DO QUICKREPORTOu seja, gostaria que, ao visualizar ou imprimir um relatriodo Quick Report, saia em cada pgina apenas um registro,mesmo que o espao permita mais de um.Existem pelo menos duas formas de resolver este problema:em foco. J1. A forma mais simples consiste em alterar a altura (Height) da banda Detail do nosso relatrio de modo que a altura total da pgina seja inferior a duas vezes a altura da banda. Desta forma, cada registro ser impresso em uma nova pgina, teoricamente por falta de espao na pgina atual.2. Uma outra forma mais sofisticada usar o evento AfterPrint da banda Detail. Nele testamos se ainda no chegou no fim da tabela e, caso positivo, pedimos uma nova pgina: if not Table1.EOF then QuickRep1.NewPage;Deve existir outras alternativas, mas as duas anterioresfuncionaram bem nos testes realizados.Incio da pginaPARA QUE SERVEM ONGETEDITMASK, ONGETEDITTEXT E ONSETEDITTEXT DO TSTRINGGRIDO evento OnGetEditMask ocorre quando entramos no modo de edio.Neste momento podemos verificar em qual linha/coluna se encontra o cursor e ento, se quiser, poder especificar umamscara de edio. Exemplo:procedure TForm1.StringGrid1GetEditMask(Sender: TObject; ACol, ARow: Integer; var Value: String);begin if (ARow = 1) and (ACol = 1) then Value := '(999) 999-9999;1;_'; // Telefoneend;O evento OnGetEditText ocorre tambm quando entramos no modode edio. Neste momento podemos manipularmos o texto daclula atual (linha/coluna) e ento podemos simular algo talcomo uma tabela onde opes podem ser digitadas atravsde nmeros. Exemplo:procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer; var Value: String);begin if (ARow = 1) and (ACol = 2) then begin if StringGrid1.Cells[ACol, ARow] = 'timo' then Value := '1' else if StringGrid1.Cells[ACol, ARow] = 'Regular' then Value := '2' else if StringGrid1.Cells[ACol, ARow] = 'Ruim' then Value := '3'; end;end;O evento evento OnSetEditText ocorre quando samos do modo deedio. Neste momento podemos manipular a entrada e trocarpor um texto equivalente. Normalmente usamos este evento emconjunto com o evento OnGetEditText. Exemplo:procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);begin if (ARow = 1) and (ACol = 2) then begin if Value = '1' then StringGrid1.Cells[ACol, ARow] := 'timo' else if Value = '2' then StringGrid1.Cells[ACol, ARow] := 'Regular' else if Value = '3' then StringGrid1.Cells[ACol, ARow] := 'Ruim' end;end;ObservaesPara testar o exemplo anterior crie um novo projeto e coloque no Form1 um TStringGrid. Mude os trs eventos mencionados conforme os exemplos. Execute e experimente digitar nas cluas 1 e 2 da primeira linha (na parte no fixada, claro!). Incio da pginaMOSTRAR UM FORM DE LOGON ANTES DO FORM PRINCIPAL{* Crie um novo Projeto. Este certamente ter o Form1. * Adicione um novo Form (Form2). * Coloque no Form2 dois botes TBitBtn. * Mude a propriedade Kind do BitBtn1 para bkOK. * Mude a propriedade Kind do BitBtn2 para bkCancel. * V no menu "Project/Options" na aba "Forms" e passe o Form2 de "Auto-create Forms" para "Available Forms". * Abra o arquivo Project.dpr (menu Project/View Source). * Altere o contedo deste arquivo conforme abaixo:}program Project1;uses Forms, Controls, Unit1 in 'Unit1.pas' {Form1}, Unit2 in 'Unit2.pas' {Form2};{$R *.RES}var F: TForm2;begin F := TForm2.Create(Application); try if F.ShowModal = mrOK then begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end; finally F.Free; end;end.ObservaesO Form2 do exemplo o Form de LogOn. Este dever ser preparado para que se possa escolher o usurio, digitar a senha, etc. Incio da pginaLIMITAR A REGIO DE MOVIMENTAO DO MOUSEInclua na seo uses: Windows{ Coloque um boto no form e altera o evento OnClick dele conforme abaixo: }procedure TForm1.Button1Click(Sender: TObject);var R: TRect;begin { Pega o retngulo da rea cliente do form } R := GetClientRect; { Converte as coordenadas do form em coordenadas da tela } R.TopLeft := ClientToScreen(R.TopLeft); R.BottomRight := ClientToScreen(R.BottomRight); { Limita a regio de movimentao do mouse } ClipCursor(@R); ShowMessage('Tente mover o mouse para fora da rea cliente do Form'); { Libera a movimentao } ClipCursor(nil);end;ObservaesCuidado! Isto pode irritar o usurio do seu programa. Incio da pginaDESCOBRIR O NOME DE CLASSE DE UMA JANELA DO WINDOWSMuitas vezes precisamos saber qual o nome de classede uma determinada janela. Quando so janelas desenvolvidaspor ns, voc olha no cdigo-fonte. Mas e se no for, como o caso do Delphi?Por exemplo:Para verificar se o Delphi est sendo executado, procuramosno Windows pela janela cujo nome de classe seja TAppBuilder.Mas como verificar ento se o Internet Explorer est sendo executado? Precisaremos saber o nome de classe da janela deste programa. Ento o que fazer?Use o TBWinName. Pegue-o no download de www.ulbrajp.com.br/usuario/tecnobyteIncio da pginaOCULTAR/EXIBIR A BARRA DE TAREFAS DO WINDOWSInclua na seo uses: Windows{ Coloque no Form dois Botes: BotaoOcultar e BotaoExibir. No evento OnClick do BotaoOcultar escreva: }procedure TForm1.BotaoOcultarClick(Sender: TObject);var Janela: HWND;begin Janela := FindWindow('Shell_TrayWnd', nil); if Janela > 0 then ShowWindow(Janela, SW_HIDE);end;{ No evento OnClick do BotaoExibir escreva: }procedure TForm1.BotaoExibirClick(Sender: TObject);var Janela: HWND;begin Janela := FindWindow('Shell_TrayWnd', nil); if Janela > 0 then ShowWindow(Janela, SW_SHOW);end;{ Execute e teste, clicando em ambos os botes }ObservaesA tarefa mais difcil descobrir o nome de classe da janela da barra de tarefa do Windows, mas isto fcil se voc usar o TBWinName. Pegue-o no link download de www.ulbrajp.com.br/usuario/tecnobyte O resto usar as APIs do Windows para manipulao de Janelas. Veja a pergunta n 18. Incio da pginaEVITAR A PROTEO DE TELA DURANTE SEU PROGRAMAInclua na seo uses: Windows{ Na seo "private" do Form principal acrescente: }procedure AppMsg(var Msg: TMsg; var Handled: Boolean);{ Na seo "implementation" acrescente (troque TForm1 para o nome do seu form principal): }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 principal, coloque: }Application.OnMessage := AppMsg;Incio da pginaFAZER A BARRA DE TTULO FICAR INTERMITENTE (PISCANTE)Inclua na seo uses: Windows{ Coloque um TTimer no Form desejado. Define a propriedade Interval do Timer para 1000 (1 segundo). Modifique o evento OnTimer do Timer conforme abaixo: }procedure TForm1.Timer1Timer(Sender: TObject);begin FlashWindow(Handle, true); FlashWindow(Application.Handle, true);end;Incio da pginaPOSICIONAR O CURSOR DO MOUSE em foco. JEM UM CONTROLEInclua na seo uses: Windows{ Digite a procedure abaixo imediatamente aps a palavra implementation no cdigo do seu formulrio. }procedure MouseParaControle(Controle: TControl);var IrPara: TPoint;begin IrPara.X := Controle.Left + (Controle.Width div 2); IrPara.Y := Controle.Top + (Controle.Height div 2); if Controle.Parent nil then IrPara := Controle.Parent.ClientToScreen(IrPara); SetCursorPos(IrPara.X, IrPara.Y);end;{ Para testar, coloque no Form um boto e troque o name dele para btnOK e modifique o evento OnShow do Form conforme abaixo: }procedure TForm1.FormShow(Sender: TObject);begin MouseParaControle(btnOk);end;ObservaesA funo "MouseParaControle" recebe um parmetro do tipo TControl. Isto significa que voc poder passar para ela qualquer controle do Delphi, tais como: TEdit, TButton, TSpeedButton, TPanel, etc. Pode ser at mesmo o prprio Form. Incio da pginaCRIAR CORES PERSONALIZADAS (SISTEMA RGB){ Coloque um TButton no form e escreva o evento OnClick deste como abaixo: }procedure TForm1.Button1Click(Sender: TObject);var Vermelho, Verde, Azul: byte; MinhaCor: TColor;begin Vermelho := 0; Verde := 200; Azul := 150; MinhaCor := TColor(RGB(Vermelho, Verde, Azul)); Form1.Color := MinhaCor;end;ObservaesA quantidade de cada cor primria um nmero de em foco. J0 a 255. Observe que a cor retornada pela funo RGB() est no formato do Windows (ColorRef); por isto que fiz a converso TColor(RGB(...)). Incio da pginaADICIONAR UMA NOVA FONTE NO WINDOWS{ Coloque o cdigo abaixo no OnClick de um boto }AddFontResource(PChar('c:\MyFonts\Monospac.ttf'));ObservaesTroque o nome do arquivo do exemplo anterior pelo nome desejado. Arquivos de fonte possuem uma das seguintes extenses: FON, FNT, TTF, FOT. Veja tambm a pergunta n 10. Incio da pginaSABER SE A IMPRESSORA ATUAL POSSUI DETERMINADA FONTEInclua na seo uses: Printers{ Coloque este cdigo no OnClick de um boto }with Printer.Fonts do if IndexOf('Draft 10cpi') >= 0 then ShowMessage('A impressora possui a fonte.') else ShowMessage('A impressora NO possui a fonte.');ObservaesIsto pode ser til quando queremos usar fonte da impressora quando for uma matricial ou fonte do Windows quando for uma Jato de Tinta ou Laser. Veja tambm a pergunta n 10. Incio da pginaSABER SE DETERMINADA FONT EST INSTALADA NO WINDOWS{ Coloque este cdigo no OnClick de um boto }with Screen.Fonts do if IndexOf('Courier New') >= 0 then ShowMessage('A fonte est instalada.') else ShowMessage('A fonte no est instalada.'); ObservaesVeja tambm a pergunta n 11. Incio da pginaACERTAR A DATA E HORA DO SISTEMA ATRAVS DO PROGRAMA{ Coloque dois TEdit no form. Coloque um TButton no form e altere o evento OnClick deste boto como abaixo:}procedure TForm1.Button1Click(Sender: TObject);var DataHora: TSystemTime; Data, Hora: TDateTime; Ano, Mes, Dia, H, M, S, Mil: word;begin Data := StrToDate(Edit1.Text); Hora := StrToTime(Edit2.Text); DecodeDate(Data, Ano, Mes, Dia); DecodeTime(Hora, H, M, S, Mil); with DataHora do begin wYear := Ano; wMonth := Mes; wDay := Dia; wHour := H; wMinute := M; wSecond := S; wMilliseconds := Mil; end; SetLocalTime(DataHora);end;ObservaesNo Edit1 digite a nova data e no Edit2 digite a nova hora. Incio da pginaENTER em foco. JEM VEZ DE TAB NO FORMULRIO, NO DBGRID E NO STRINGGRID{ Mude a propriedade "KeyPreview" do Form para true. }{ No evento "OnKeyPress" do Form acrescente o cdigo abaixo: }procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);begin if Key = #13 then begin Key := #0; Perform(WM_NEXTDLGCTL, 1, 0); end;end;{ Em StringGrid, escreva o evento OnKeyPress como abaixo: }procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);begin if Key = #13 then StringGrid1.Perform(WM_KEYDOWN, VK_TAB, 0);end;{ Em DBGrid, escreva o evento OnKeyPress como abaixo: }procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);begin if Key = #13 then DBGrid1.Perform(WM_KEYDOWN, VK_TAB, 0);end;Observaes bom lembrar que a tecla ENTER no Windows tem seu papel j bem definido quando se trata de caixa de dilogo: executar a ao padro, normalmente o boto OK. Se no tomar cuidado poder confundir o usurio, em vez de ajud-lo. Incio da pginaSIMULAR A VRGULA ATRAVS DO PONTO DO TECLADO NUMRICO{ Na seo "private" do Form principal acrescente: }procedure AppMsg(var Msg: TMsg; var Handled: Boolean);{ Na seo "implementation" acrescente (troque TForm1 para o nome do seu form principal): }procedure TForm1.AppMsg(var Msg: TMsg; var Handled: Boolean);begin if Msg.Message = WM_KEYDOWN then if Msg.wParam = 110 then Msg.wParam := 188;end;{ No evento "OnCreate" do form principal, coloque: }Application.OnMessage := AppMsg;{ Uma segunda alternativa (Jos Geraldo - ES): Coloque o cdigo abaixo no evento OnKeyPress do componente onde se quer a converso (Edit, DBEdit, etc). Neste caso a converso funcionar apenas neste componente (bvio). } if Key = '.' then Key = DecimalSeparator;ObservaesNa primeira alternativa, sempre que for pressionado o ponto do teclado numrico (da direita do teclado), este ser convertido para vrgula, independentemente do controle que estiver em foco. Jem foco. J na segunda, o ponto pode ser de qualquer lugar do teclado. Incio da pginaPARALIZAR UM PROGRAMA DURANTE N SEGUNDOSInclua na seo uses: Windows{ Pausa por 1 segundo }Sleep(1000);{ Pausa por 10 segundos }Sleep(10000);ObservaesEsta pausa no interrompida pelo pressionamento de alguma tecla, como acontecia com InKey() do Clipper. Incio da pginaCRIAR UMA TABELA (DB, DBF) ATRAVS DO SEU PROGRAMAInclua na seo uses: dbTables, DBprocedure CriaTabelaClientes;var Tabela: TTable;begin Tabela := TTable.Create(Application); try Tabela.DatabaseName := 'C:\'; { ou Tabela.DatabaseName := 'NomeAlias'; } Tabela.TableName := 'Clientes.DB'; Tabela.TableType := ttParadox; { ou ttDBase } { Somente Delphi4 } if Tabela.Exists then { Se a tabela j existe... } Exit; {***} { Cria a tabela } Tabela.FieldDefs.Add('Codigo', ftInteger, 0, true); Tabela.FieldDefs.Add('Nome', ftString, 30, true); Tabela.FieldDefs.Add('DataNasc', ftDate, 0, false); Tabela.FieldDefs.Add('RendaMes', ftCurrency, 0, false); Tabela.FieldDefs.Add('Ativo', ftBoolean, 0, true); { etc, etc, etc } Tabela.CreateTable; { Cria os ndices } Tabela.AddIndex('ICodigo', 'Codigo', [ixPrimary, ixUnique]); Tabela.AddIndex('INome', 'Nome', [ixCaseInsensitive]); { etc, etc, etc } finally Tabela.Free; end;end;ObservaesPara verificar se o arquivo j existe na verso 3 ou anterior do Delphi, voc dever usar a funo "FileExists" do Delphi. Incio da pginaVERIFICAR SE UM DIRETRIO EXISTEInclua na seo uses: FileCtrl, Dialogsif DirectoryExists('C:\MEUSDOCS') then ShowMessage('O diretrio existe')else ShowMessage('O diretrio no existe'); Incio da pginaVERIFICAR SE UM ARQUIVO EXISTEInclua na seo uses: SysUtils, Dialogsif FileExists('c:\carta.doc') then ShowMessage('O arquivo existe')else ShowMessage('O arquivo no existe');Incio da pginaCRIAR UM ALIAS TEMPORRIO ATRAVS DO SEU PROGRAMAInclua na seo uses: DB{ Enxergar somente configuraes da sesso atual }Session.ConfigMode := cmSession;{ Adicionar o Alias }Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX');ObservaesVeja a pergunta n 1. Incio da pginaCRIAR UM ALIAS ATRAVS DO SEU PROGRAMAInclua na seo uses: DB{ se o alias no existir... }if not Session.IsAlias('MeuAlias') then begin { Adiciona o alias } Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX'); { Salva o arquivo de configurao do BDE } Session.SaveConfigFile;end;ObservaesPara criar um alias do dBase troque a string 'PARADOX' por 'DBASE'. No caso acima usei como path o caminho "C:\DirProg", mas se voc quiser poder trocar este caminho por ExtractFilePath(ParamStr(0)) para que o alias seja direcionado para o local onde est seu .EXE. Neste ltimo caso ser necessrio incluir na seo uses: SysUtils, System. Incio da pgina