Dicas de Delphi

001 - Ativar a proteção de tela do Windows Inclua na seção uses: Windows

{ Ativa a proteção de tela do Windows, 
  se estiver configurada. }

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);

Início da página

002 - Desligar/Ligar monitor

Inclua na seção uses: Windows

No Win95 podemos desligar o monitor afim de economizar 
energia elétrica. Normalmente este recurso é controlado pelo
próprio Windows. Porém sua aplicação Delphi também pode fazer
isto. O exemplo abaixo desliga o monitor, aguarde 5 segundos
e re-liga monitor.

SendMessage(Application.Handle, WM_SYSCOMMAND, 
  SC_MONITORPOWER, 0);
Sleep(5000); { Aguarde 5 segundos }
SendMessage(Application.Handle, WM_SYSCOMMAND, 
  SC_MONITORPOWER, -1);

Observações

Este recurso pode não funcionar dependendo da configuração do sistema.

Início da página

003 - Abrir e fechar o drive de CD-ROM

{ Para abrir }
mciSendString('Set cdaudio door open wait', nil, 0, handle);

{ Para fechar }
mciSendString('Set cdaudio door closed wait', nil, 0, handle);

Início da página

004 - Impedir que o form seja arrastado para fora das margens da tela

- Na seção Private declare a procedure abaixo:

private
  procedure WMMove(var Msg: TWMMove); message WM_MOVE;

- Abaixo da palavra implementation escreva a procedure
  abaixo:

procedure TForm1.WMMove(var Msg: TWMMove); 
begin
  if Left < 0 then
    Left := 0;
  if Top < 0 then
    Top := 0;
  if Screen.Width - (Left + Width) < 0 then
    Left := Screen.Width - Width;
  if Screen.Height - (Top + Height) < 0 then
    Top := Screen.Height - Height;
end;

Para testar:

- Execute o programa e tente arrastar o form para fora
  das margens da tela e veja o que acontece.

Início da página

005 - Mostrar mensagem mesmo que esteja no Prompt do DOS

Inclua na seção uses: Windows

SetForegroundWindow(Application.Handle);
ShowMessage('Teste');

Início da página

006 - Copiar todos os registros de uma tabela para o Clipboard

Inclua na seção uses: Clipbrd

procedure TForm1.Button1Click(Sender: TObject);
const
  SeparadorCampoValor = ': ';
  SeparadorCampo      = #13#10; { Quebra de linha }
  SeparadorRegistro   = '===========' + #13#10;
var
  S: string;
  I: integer;
begin
  S := '';
  Table1.First;
  while not Table1.EOF do begin
    for I := 0 to Table1.FieldCount -1 do
      S := S + Table1.Fields[I].FieldName + SeparadorCampoValor +
               Table1.Fields[I].AsString + SeparadorCampo;
    S := S + SeparadorRegistro;
    Table1.Next;
  end;
  Clipboard.AsText := S;
end;

Para testar:
- Execute este aplicativo;
- Clique no botão;
- Vá em outro aplicativo (ex: MS-Word) e mande colar (Ctrl+V).

Observações

CUIDADO! Não use este recurso com tabelas grandes, pois poderá usar memória demasiadamente. No teste que fiz, o tamanho da string S atingiu 20K e funcionou normalmente. Mas isto pode variar de uma máquina para outra.

Início da página

007 - Copiar um registro de uma tabela para o Clipboard

Inclua na seção uses: Clipbrd

procedure TForm1.Button1Click(Sender: TObject);
const
  SeparadorCampoValor = ': ';
  SeparadorCampo      = #13#10; { Quebra de linha }
var
  S: string;
  I: integer;
begin
  S := '';
  for I := 0 to Table1.FieldCount -1 do
    S := S + Table1.Fields[I].FieldName + SeparadorCampoValor +
             Table1.Fields[I].AsString + SeparadorCampo;

  Clipboard.AsText := S;
end;

Para testar:
- Execute este aplicativo;
- Clique no botão;
- Vá em outro aplicativo (ex: MS-Word) e mande colar (Ctrl+V).

Início da página

008 - Criar sub-diretório no diretório do EXE

Inclua na seção uses: FileCtrl, SysUtils

function CriaSubDir(const NomeSubDir: string): boolean;
var
  Caminho: string;
begin
  Caminho := ExtractFilePath(ParamStr(0)) + NomeSubDir;
  if DirectoryExists(Caminho) then
    Result := true
  else
    Result := CreateDir(Caminho);
end;

Exemplo de uso:
- Chame a função no evento OnCreate do form:

procedure TForm1.FormCreate(Sender: TObject);
begin
  if not CriaSubDir('MeuSubDir') then
    ShowMessage('Não foi possível criar o sub-diretório MeuSubDir.');
end;

Início da página

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

Início da página

010 - Personalizar a caixa de mensagem de exceções (erro) do Delphi

- Declare um método (procedure) na seção private do
  form principal conforme abaixo:

private
  procedure ManipulaExcecoes(Sender: TObject; E: Exception);

- Vá até a seção implementation e implemente este método, 
  conforme o exemplo:

procedure TForm1.ManipulaExcecoes(Sender: TObject; E: Exception);
begin
  MessageDlg(E.Message + #13#13 +
             'Suporte técnico:'#13 +
             'tecnobyte@ulbrajp.com.br',
             mtError, [mbOK], 0);
end;

- No evento OnCreate do Form principal escreva o código
  abaixo:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnException := ManipulaExcecoes;
end;

=== Para testar === 

- Coloque um Button no form;
- No evento OnClick deste botão coloque o código abaixo:

procedure TForm1.Button1Click(Sender: TObject);
begin
  StrToInt('ABCD'); { Isto provoca uma exception }
end;

Observações

Cuidado! Não coloque código que possa gerar exceção na rotina que manipula as exceções, pois se ocorrer uma exceção neste rotina, esta será chamada recursivamente até estourar a pilha.

Início da página

011 - Implementar procedure Delay do Pascal no Delphi

Inclua na seção uses: Windows, Forms

procedure Delay(MSec: Cardinal);
var
  Start: Cardinal;
begin
  Start := GetTickCount;
  repeat
    Application.ProcessMessages;
  until (GetTickCount - Start) >= MSec;
end;

=== Exemplos de uso: ===

Delay(1000); { Aguarda 1 segundo }
Delay(5000); { Aguarda 5 segundos }
Delay(60000); { Aguarda 60 segundos - 1 minuto }

Observações

Além da procedure Delay criada acima, o programador Delphi pode usar também a API do Windows Sleep. Há porém uma diferença: Delay permite que que o programa continue a processar as mensagens do Windows (mouse, teclado, etc).

Início da página

012 - Enviar comandos de rolagem vertical para um TMemo

Inclua na seção uses: Windows

SendMessage(Memo1.Handle, WM_VSCROLL, SBPAGEDOWN, 0);

Onde:
  Memo1.Handle = manipulador da janela do Memo1.
    WM_VSCROLL = Mensagem do Windows - rolagem vertical.
   SB_PAGEDOWN = Comanndo de rolagem - página para baixo.

Outros exemplos:

{ Página para cima }
SendMessage(Memo1.Handle, WM_VSCROLL, SBPAGEUP, 0);

{ Linha para baixo }
SendMessage(Memo1.Handle, WM_VSCROLL, SBLINEDOWN, 0);

{ Linha para cima }
SendMessage(Memo1.Handle, WM_VSCROLL, SBLINEUP, 0);

Observações

Além desta técnica existem API's do Windows que fazem um trabalho equivalente.

Início da página

013 - Criar uma DLL de Bitmaps e usá-la

Siga os passos abaixo para criar a DLL de bitmaps:

- Crie um arquivo de recursos (.RES) contendo os Bitmaps. 
  Use o Image Editor do Delphi para criar este arquivo.
  Salve-o com o nome BMPS.RES na pasta onde será salvo 
  o projeto do Delphi;
- Crie um novo projeto no Delphi;
- Remova todos os forms do projeto;
- Salve este projeto com o nome DLLBmp.dpr;
- Abra o arquivo de projeto (DLLBmp.dpr) e altere para 
  ficar somente com as linhas abaixo:

  {$R BMPS.RES}
  library DLLBmp;
  end.

- Compile o projeto (Ctrl+F9). Será criado o 
  arquivo DLLBmp.DLL.
- Feche o projeto atual e crie um novo projeto;
- Salve-o na mesma pasta que salvou o anterior, 
  mas com outro nome qualquer;
- Coloque no form um Edit e um Button;
- No evento OnClick do Button coloque o código abaixo:

procedure TForm1.Button1Click(Sender: TObject);
var
  Bmp: TBitmap;
  HandleDLL: THandle;
begin
  { Carrega a DLL }
  HandleDLL := LoadLibrary('DLLBmp.DLL');
  if HandleDLL = 0 then
    ShowMessage('Não foi possível carregar DLLBmp.DLL')
  else
    try
      Bmp := TBitmap.Create;
      try
        Bmp.Handle := LoadBitmap(HandleDLL, PChar(Edit1.Text));
        if Bmp.Handle = 0 then
          ShowMessage('Não foi possível carregar o Bitmap.')
        else
          { Pinta o Bitmap no form }
          Canvas.Draw(0, 0, Bmp);
      finally
        Bmp.Free;
      end;
    finally
      { Libera a DLL }
      FreeLibrary(HandleDLL);
    end;
end;

=== Para testar ===

- Execute este projeto;
- Digite no Edit1 o nome que foi dado ao Bitmap no arquivo
  de recursos (.RES);
- Clique no botão. O bitmap deverá ser pintado no form.

Observações

O arquivo DLL poderá ser colocado na pasta onde estiver o EXE, no diretório do Windows ou ainda no sub-diretório System do Windows. Além de bitmaps podemos colocar qualquer outro tipo de recurso em DLL's.

Início da página

014 Como extrair o icone de um executável

Inclua a unit Shellapi na cláusula uses do seu form.

Image1.Picture.Icon.Handle:= ExtractIcon(Handle,PChar('c:\windows\calc.exe'),0);

Início da página

015 - Criar form sem a barra de título que possa ser arrastado

- Crie um novo projeto;
- Mude as seguintes propriedades do Form1: 
  BorderStyle = bsNone, FormStyle = fsStayOnTop,
- Coloque um Label;
- Coloque um Timer;
- Altere o evento OnTimer do Timer1 conforme abaixo:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := TimeToStr(Time);
end;

- Altere o evento OnCreate do Form1 conforme abaixo:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Width := 80;
  Height := 40;
  Label1.Left := 10;
  Label1.Top := 10;
end;

- Vá na seção private do Form1 e declare a procedure abaixo:

private
  procedure WMNCHitTest(var Msg: TMessage); 
    message WM_NCHitTest;
public
  { Public declarations }
end;

- Vá na seção implementation e escreva a procedure abaixo:

implementation

{$R *.DFM}

procedure TForm1.WMNCHitTest(var Msg: TMessage);
begin
  if GetAsyncKeyState(VK_LBUTTON) < 0 then
    Msg.Result := HTCAPTION
  else
    Msg.Result := HTCLIENT;
end;

- Execute e experimente arrastar form com o mouse. 

Observações

Para fechar este aplicativo pressione Alt+F4. Uma alternativa mais elegante é colocar um menu local (PopupMenu) com um comando para fechar.

Início da página

016 - Obter status da memória do sistema

Inclua na seção uses: Windows, SysUtils

- Coloque um TMemo no form
- Coloque um TButton no form e altere seu OnClick 
  conforme abaixo:

procedure TForm1.Button1Click(Sender: TObject);
const
  cBytesPorMb = 1024 * 1024;
var
  M: TMemoryStatus;
begin
  M.dwLength := SizeOf(M);
  GlobalMemoryStatus(M);
  Memo1.Clear;
  with Memo1.Lines do begin
    Add(Format('Memória em uso: %d%%',
      [M.dwMemoryLoad]));
    Add(Format('Total de memória física: %f MB',
      [M.dwTotalPhys / cBytesPorMb]));
    Add(Format('Memória física disponível: %f MB',
      [M.dwAvailPhys / cBytesPorMb]));
    Add(Format('Tamanho máximo do arquivo de paginação: %f MB',
      [M.dwTotalPageFile / cBytesPorMb]));
    Add(Format('Disponível no arquivo de paginação: %f MB',
      [M.dwAvailPageFile / cBytesPorMb]));
    Add(Format('Total de memória virtual: %f MB',
      [M.dwTotalVirtual / cBytesPorMb]));
    Add(Format('Memória virtual disponível: %f MB',
      [M.dwAvailVirtual / cBytesPorMb]));
  end;
end;

Início da página

017 - Definir data/hora de um arquivo

Inclua na seção uses: SysUtils

{ Esta função altera a data e hora de um arquivo. Se obter
  sucesso retorna true, caso contrário retorna false. }

function DefineDataHoraArq(NomeArq: string; DataHora: TDateTime): boolean;
var
  F: integer;
begin
  Result := false;
  F := FileOpen(NomeArq, fmOpenWrite or fmShareDenyNone);
  try
    if F > 0 then
      Result := FileSetDate(F, DateTimeToFileDate(DataHora)) = 0;
  finally
    FileClose(F);
  end;
end;

{ Exemplo de uso 1: Usa a data atual do sistema (Now) }

if DefineDataHoraArq('c:\teste\logo.bmp', Now) then
  ShowMessage('Data/Hora do arquivo definida com sucesso.')
else
  ShowMessage('Não foi possível definir data/hora do arquivo.');

{ Exemplo de uso 2: Usa uma data fixa }
var
  DataHora: TDateTime;
begin
  { Define a data para 5-Fev-1999 e a hora para 10:30 }
  DataHora := EncodeDate(1999, 2, 5) + EncodeTime(10, 30, 0, 0);

  if DefineDataHoraArq('c:\teste\logo.bmp', DataHora) then
    ShowMessage('Data/Hora do arquivo definida com sucesso.')
  else
    ShowMessage('Não foi possível definir data/hora do arquivo.');
end;

Início da página

018 - Mostrar o diálogo About (Sobre) do Windows

Inclua na seção uses: ShellApi

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShellAbout(Handle, 'Sistema Financeiro', 'Marcelo Senger',
    Application.Icon.Handle);
end;

Observações

Dica enviada por: Marcelo Senger

Início da página

019 - Ocultar/exibir o cursor do mouse

Inclua na seção uses: Windows

- Escreva a função abaixo:

function MouseShowCursor(const Show: boolean): boolean;
var
  I: integer;
begin
  I := ShowCursor(LongBool(true));
  if Show then begin
    Result := I >= 0;
    while I < 0 do begin
      Result := ShowCursor(LongBool(true)) >= 0;
      Inc(I);
    end;
  end else begin
    Result := I < 0;
    while I >= 0 do begin
      Result := ShowCursor(LongBool(false)) < 0;
      Dec(I);
    end;
  end;
end;

- Exemplos de uso:

MouseShowCursor(false); { Oculta o cursor }

MouseShowCursor(true); { Exibe o cursor }

Início da página

020 - Converter de Hexadecimal para Inteiro

Inclua na seção uses: SysUtils

var
  I: integer;
begin
  I := StrToInt('$' + Edit1.Text);
  {...}
end;

Observações

No Delphi, um número na notação Hexadecimal deve iniciar com o símbolo $.

Início da página

021 - Mudar a cor de um DBEdit dentro de um DBCtrlGrid de acordo com uma condição

- Monte o form normalmente colocando DataSource, Table, 
  DBCtrlGrid e os DBEdit's, DBText's, etc.

- Escreva no manipulador do evento OnPaintPanel do 
  DBCtrlGrid conforme abaixo:

procedure TForm1.DBCtrlGrid1PaintPanel(DBCtrlGrid: TDBCtrlGrid;
  Index: Integer);
begin
  if Table.FieldByName('NomeDoCampo').AsFloat < 0 then
    DBEdit1.Font.Color := clRed
  else
    DBEdit1.Font.Color := clBlue;
end;

Observações

Neste exemplo mudamos a cor da fonte do componente DBEdit, Porém, pode-se também mudar a cor do próprio componente (DBEdit1.Color).

Início da página

022 - Colocar uma ProgressBar da StatusBar

- Coloque uma StatusBar no form.

- Adicione dois paineis na StatusBar (propriedade Panels).

- Ajuste as propriedades do primeiro painel conforme abaixo:
  Style = psOwnerDraw
  Width = 150

- Coloque uma ProgressBar no form e mude sua propriedade 
  Visible para false.

- No evento OnDrawPanel da StatusBar digite o código abaixo:

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  { Se for o primeiro painel... }
  if Panel.Index = 0 then begin
    { Ajusta a tamanho da ProgressBar de acordo com
      o tamanho do painel }
    ProgressBar1.Width := Rect.Right - Rect.Left +1;
    ProgressBar1.Height := Rect.Bottom - Rect.Top +1;
    { Pinta a ProgressBar no DC (device-context) da StatusBar }
    ProgressBar1.PaintTo(StatusBar.Canvas.Handle, Rect.Left, Rect.Top);
  end;
end;

- Coloque um Button no form
- Digite no evento OnClick do Button o código abaixo:

procedure TForm1.Button1Click(Sender: TObject);
var
  I: integer;
begin
  for I := ProgressBar1.Min to ProgressBar1.Max do begin
    { Atualiza a posição da ProgressBar }
    ProgressBar1.Position := I;
    { Repinta a StatusBar para forçar a atualização visual }
    StatusBar1.Repaint;
    { Aguarda 50 milisegundos }
    Sleep(50);
  end;

  { Aguarde 500 milisegundos }
  Sleep(500);
  { Reseta (zera) a ProgressBar }
  ProgressBar1.Position := ProgressBar1.Min;
  { Repinta a StatusBar para forçar a atualização visual }
  StatusBar1.Repaint;
end;

- Execute e clique no botão para ver o resultado.

Observações

Com um pouco de criatividade podemos fazer outras coisas interessantes usando o evento OnDrawPanel da StatusBar.

Início da página

023 - Executar um programa e aguardar sua finalização antes de continuar

Inclua na seção uses: Windows

{ Esta função 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 é necessário devido
    aos espaços 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);

Observações

Não se esqueça de informar o caminho (path) do arquivo completo. Esta função foi desenvolvida para Delphi 32 bits (2, 3, 4,...).

Início da página

024 - Simular o pressionamento de uma combinação de teclas (ex: Ctrl+F2)

Inclua na seção uses: Windows

{ Mantém 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);

Observações

Neste exemplo pressionamos Ctrl+F2. Não se esqueça das teclas que precisam manter pressionadas: Ctrl, Alt, Shift.

Início da página

025 - Simular o pressionamento de uma tecla

Inclua na seção uses: Windows

A API keybd_event do Windows serve para fazer isto. No exemplo
abaixo estamos simulando o pressionamento da tecla F2:

keybd_event(VK_F2, 0, 0, 0);

Para testar faça 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 botão e escreva no OnClick (do botão) como abaixo:

procedure TForm1.Button1Click(Sender: TObject);
begin
  keybd_event(VK_F2, 0, 0, 0);
end;

Observações

Consulte as constantes para os códigos das teclas (ex: VK_RETURN, VK_DOWN, etc).

Início da página

026 - Ligar/desligar a tecla Caps Lock

Inclua na seção uses: Windows

{ Esta função liga/desliga Caps Lock, conforme o parãmetro
  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 }

Observações

Aparentemente, podemos usar esta mesma técnica para ligar/desligar Num Lock. Neste caso trocaríamos VK_CAPITAL por VK_NUMLOCK. Por incrível que pareça não funcionou (pelo menos no teste que fiz). E tem mais: isto está na documentação do (R)Windows.

Início da página

027 - Verificar se uma determinada tecla está pressionada

Inclua na seção uses: Windows

{ Esta função retorna true se a tecla informada
  estiver pressionada. False em caso contrário. }

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 }

Observações

Qualquer tecla pode ser verificada. Para isto basta saber o código virtual (Virtual Key Code) da tecla.

Início da página

028 - Verificar o estado de NumLock e CapsLock

Inclua na seção uses: Windows

{ Esta função retorna true se a tecla informada estiver
  ligada. False em caso contrário }

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 }

Observações

Qualquer tecla que possua os estados On/Off pode ser verificada. Basta, para isto, saber seu código. O código de CapsLock é VK_CAPITAL.

Início da página

029 - Configurar linhas de diferentes alturas em StringGrid

- Coloque o StringGrid no form.
- No evento OnCreate do form coloque o código abaixo:

procedure TForm1.FormCreate(Sender: TObject);
begin
  StringGrid1.RowHeights[0] := 15;
  StringGrid1.RowHeights[1] := 20;
  StringGrid1.RowHeights[2] := 50;
  StringGrid1.RowHeights[3] := 35;
end;

Observações

Cuidado para não especificar uma linha inexistente.

Início da página

030 - Adicionar o evento OnClick do DBGrid

- Monte seu form normalmente, colocando o DBGrid e demais
  componentes;
- Vá na seção "private" da unit e declare a procedure abaixo:

private
  procedure DBGridClick(Sender: TObject);

- Logo após a palavra "implementation", escreva a procedure:

implementation

{$R *.DFM}

procedure TForm1.DBGridClick(Sender: TObject);
begin
  ShowMessage('Clicou no DBGrid.');
end;

- Coloque as instruções 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.

Observações

O segredo principal desta dica está OnCreate do Form. A primeira instrução ativa o evento OnClick. A segunda instrução 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.

Início da página

031 - Criar caixas de diálogo em tempo de execução

Inclua na seção uses: Forms, StdCtrls, Buttons

A função abaixo demonstra a criação de uma caixa de diálogo
que pode ser usada para permitir ao usuário digitar o seu
nome:

{ Esta função retorna true se for pressionado OK e false
  em caso contrário. Se for OK, o texto digitado pelo usuário
  será copiado para a variável Nome }

function ObterNome(var Nome: string): boolean;
var
  Form: TForm; { Variável para o Form }
  Edt: TEdit; { Variável para o Edit }
begin
  Result := false; { Por padrão retorna false }
  { Cria o form }
  Form := TForm.Create(Application);
  try
    { Altera algumas propriedades do Form }
    Form.BorderStyle := bsDialog;
    Form.Caption := 'Atenção';
    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 botão 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; { Botão Ok }
    end;
    { Coloca o botão Cancel }
    with TBitBtn.Create(Form) do begin
      Parent := Form;
      Left := Form.ClientWidth - Width - 10;
      Top := 80;
      Kind := bkCancel; { Botão Cancel }
    end;
    { Exibe o form e aguarda a ação do usuário. Se for OK... }
    if Form.ShowModal = mrOK then begin
      Nome := Edt.Text;
      Result := true;
    end;
  finally
    Form.Free;
  end;
end;

Para chamar esta função siga o exemplo abaixo:

procedure TForm1.Button1Click(Sender: TObject);
var
  S: string;
begin
  if ObterNome(S) then
    Edit1.Text := S;
end;

Observações

Os componentes Label, Edit (var Edt) e BitBtn's (botões) não são destruídos explicitamente (Componente.Free). Isto não é necessário, pois ao criá-los informei como proprietário o Form (ex: TLabel.Create(Form)). Neste caso, estes componentes são destruídos automaticamente ao destruir o Form (Form.Free).

Início da página

032 - Converter a primeira letra de um Edit para maiúsculo

with Edit2 do
if Text <> '' then
  Text := AnsiUpperCase(Text[1]) + Copy(Text, 2, Length(Text));

Isto pode ser colocado, por exemplo, no OnExit do Edit.

Você pode também converter durante a digitação. Para isto 
coloque o código abaixo no evento OnKeyPress do Edit:

if Edit1.SelStart = 0 then
  Key := AnsiUpperCase(Key)[1]
else
  Key := AnsiLowerCase(Key)[1];

Início da página

033 - Verificar se uma string contém uma hora válida

- Use a função abaixo:

function StrIsTime(const S: string): boolean;
begin
  try
    StrToTime(S);
    Result := true;
  except
    Result := false;
  end;
end;

Início da página

034 - Verificar se uma string contém um valor numérico válido

- Use uma das funções 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;

Início da página

035 - Mostrar uma mensagem durante um processamento

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

Observações

A função Sleep é uma API do Windows e serve para paralisar a aplicação por um determinado dempo. Este tempo é em milisegundos.

Início da página

036 - Mostrar um cursor de ampulheta durante um processamento

- Salve o cursor atual
- Defina o novo cursor (crHourGlass é ampulheta)
- Faça o processamento
- Restaure o cursor.


var
  PrevCur: TCursor;
begin
  PrevCur := Screen.Cursor;
  try
    Screen.Cursor := crHourGlass;
    { Coloque aqui as instruções do processamento }
  finally
    Screen.Cursor := PrevCur;
  end;
end; 

Observações

Existem 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á também criar o seu próprio cursor.

Início da página

037 - Ler e escrever dados binários no Registro do Windows

Inclua na seção uses: Registry

Coloque no Form:
- três edits;
- dois botões.

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 variável 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 não 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 não existe no registro.')
    end else
      ShowMessage('Chave (path) não existe no registro.');
  finally
    Reg.Free;
  end;
end;

Observações

Qualquer tipo de dado pode ser gravado e lido de forma binária no registro do Windows. Para isto você precisa saber o tamanho do dado. Para dados de tamanho fixo, use SizeOf(). Lembrete: não grave dados muito extensos no Registro do Windows (ex: imagens), pois isto prejudicará o desempenho do sistema.

Início da página

038 - Mudar a resolução do vídeo via programação

- 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 botão no form
- Altere o evento OnClick do botão conforme abaixo:

procedure TForm1.Button1Click(Sender: TObject);
var
  DevMode : TDevMode;
begin
  EnumDisplaySettings(nil,Listbox1.ItemIndex,Devmode);
  ChangeDisplaySettings(DevMode,0);
end;

Observações

Nos testes que fiz, nem tudo funcionou adequadamente. Mas vale a pena experimentar.

Início da página

039 - Ler e escrever dados no Registro do Windows

Inclua na seção uses: Registry

- Coloque no form dois edits e dois botões.
- No evento OnClick do Button1 escreva o código 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 não existir, cria e abre. }
    Reg.OpenKey('MeuPrograma\Configuração', 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\Configuração') then
    begin
      Reg.OpenKey('MeuPrograma\Configuração', false);

      if Reg.ValueExists('Numero') then
        Edit1.Text := IntToStr(Reg.ReadInteger('Numero'))
      else
        ShowMessage('Não existe valor com o nome "Numero"');

      if Reg.ValueExists('Nome') then
        Edit2.Text := Reg.ReadString('Nome')
      else
        ShowMessage('Não existe valor com o nome "Nome"');

    end else
      ShowMessage('Não existe a chave no registro');
  finally
    Reg.Free;
  end;
end;

Observações

User o aplicativo RegEdit.exe do windows para ver o registro. Cuidado para não alterar as configurações do Windows!

Início da página

040 - Adicionar 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 necessária a barra de rolagem horizontal');
  Listbox1.Items.Add('Linha 3');

  if Listbox1.Items.Count > 1 then begin

    { Obtém 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 instrução abaixo: }
SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, 0, 0);

Início da página

041 - Simular um CharCase no DBGrid

Para converter a digitação para maiúsculo, coloque isto no
evento OnKeyPress do DBGrid:

Key := AnsiUpperCase(Key)[1];

Para converter para minúsculo, troque por:

Key := AnsiLowerCase(Key)[1];

Início da página

042 - Verificar se uma string é uma data válida

Escreva a função 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 botão coloque o código abaixo:

if tbStrIsDate(Edit1.Text) then
  ShowMessage(Edit1.Text + ' é data válida.')
else
  ShowMessage(Edit1.Text + ' NÃO é data válida.');

Início da página

043 - Fazer pesquisa incremental

- Crie um índice na tabela com campo a ser usado na pesquisa.

Coloque no Form:

- Um DataSource
- Um Table
- Um DBGrid
- Um Edit

Altere as seguintes propriedades:

- DataSource1.DataSet = Table1
- Table1.DatabaseName = 'NomeDoAlias'
- Table1.TableName = 'NomeDaTabela'
- Table1.IndexFieldNames = 'NomeDoCampo'
- Table1.Active = true
- DBGrid1.DataSource = DataSource1

Escreva a instrução abaixo no evento OnChange do Edit:

Table1.FindNearest([Edit1.Text]);

Observações

Este exemplo considera que o campo seja tipo string. Para outros tipos de campos pode ocorrer erro dependendo dos valores digitados no Edit1.

Início da página

044 - Adicionar zeros à esquerda de um número

Existem várias 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; 

Observações

Se o comprimento desejado (Casas) não for suficiente para conter o número, serão colocados asteriscos.

Início da página

045 - Limpar um campo tipo data via programação

Table1.FieldByName('Data').Clear;

{ ou }

Table1.FieldByName('Data').AsString := '';

Observações

Podemos usar este recurso para limpar também campos numéricos, string, etc.

Início da página

046 - Implementar um campo auto-incremental via programação

Inclua na seção uses: dbTables

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

Observações

A função acima incrementa o campo somente se estiver vazio. Assim podemos dar ao usuário a opção de digitar neste campo ou deixá-lo vazio para que seja auto-incrementado. Existem várias outras formas de implementar este recurso.

Início da página

047 - Obter o endereço IP do Dial-Up

Inclua na seção uses: WinSock

{ Esta função retorna o endereço 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;

Observações

Se o endereço IP for designado pelo servidor, a cada conecção teremos um endereço IP diferente e, obviamente, se não estivermos conectados, não conseguiremos obtê-lo.

Início da página

048 - Exibir a caixa de diálogo padrão de solicitação de senha do banco de dados

Inclua na seção uses: DbPwDlg

{ Coloque um botão 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;

Observações

As senhas adicionadas nesta caixa de diálogo são adicionadas na sessão (TSession) atual. Isto é útil quando colocamos senha em tabelas Paradox, ou mesmo quando trabalhamos com banco de dados Client Servidor, e queremos que o usuário digite a senha de acesso. Se não fizermos desta forma, nem adicionarmos via programação as senhas necessárias, esta caixa de diálogo será mostrada quando o programa tentar abrir uma tabela com senha. A grande vantagem aqui é que podemos traduzir os Caption's dos componentes.

Início da página

049 - Obter a versão da biblioteca ComCtl32.DLL (usada na unit ComCtrls do Delphi)

Inclua na seção uses: ComCtrls

{ A versão desta biblioteca determina a aparência de alguns
  controles do Delphi, tais como ToolBar e CoolBar. O exemplo
  abaixo obtém a versão desta biblioteca.

  Para este exemplo, coloque um TEdit e um TButton no Form.
  O evento OnClick do botão escreva o código 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;

Observações

Normalmente, a versão 4.72 está presente quando o Internet Explorer 4 está instalado.

Início da página

050 - Implementar rotinas assembly em Pascal

{ O Delphi permite a implementação de rotinas assembly
  mescladas ao código Pascal. Não entrarei em detalhes
  minuciosos, mas darei alguns exemplos básicos de como
  implementar rotinas simples que retornam números inteiros.
}

{ Soma dois inteiros de 8 bits }
function Soma8(X, Y: byte): byte;
asm
  mov al, &X
  add al, &Y
end;

{ Soma dois inteiros de 16 bits }
function Soma16(X, Y: Word): Word;
asm
  mov ax, &X
  add ax, &Y
end;

{ Soma dois inteiros de 32 bits }
function Soma32(X, Y: DWord): DWord;
asm
  mov eax, &X
  add eax, &Y
end;

{ A chamada a estas funções são feitas da mesma forma 
  que chamamos uma função Pascal. Exemplo: }
var
  A: byte;
begin
  A := Soma8(30, 25); { A = 55 }
end;

Início da página

051 - Exibir o diálogo About do Windows

Inclua na seção uses: Windows

{ About padrão do Windows }
ShellAbout(Handle, 'Windows', '', 0);

{ Personalizada }
ShellAbout(Handle, 'NomePrograma',
  'Direitos autorais reservados a'#13'Fulano de Tal',
  Application.Icon.Handle);

Início da página

052 - Obter a linha e coluna atual em um TMemo

{ Esta procedure obtém 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;

Início da página

053 - Exibir um arquivo de ajuda do Windows

Inclua na seção 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 tópico n. 100
}

procedure TForm1.Button1Click(Sender: TObject);
begin
  WinHelp(0, 'c:\Win95\Help\Calc.hlp', HELP_CONTEXT, 100);
end;

Observações

Para utilizar um arquivo de ajuda em seu programa desenvolvido em Delphi, basta usar os recursos do próprio Delphi. O exemplo acima é somente para mostrar o uso de uma API para este fim.

Início da página

054 - Obter o valor de uma variável de ambiente

Inclua na seção uses: Windows

{ Esta função recebe o nome da variável de ambiente 
  que queremos acessar e retorna uma string com seu 
  valor, ou uma string vazia se a variável não existir. }
  
function tbGetEnvVar(const VarName: string): string;
var
  I: integer;
begin
  Result := '';

  { Obtém o comprimento da variável }
  I := GetEnvironmentVariable('PATH', nil, 0);

  if I > 0 then begin
    SetLength(Result, I);
    GetEnvironmentVariable('PATH', PChar(Result), I);
  end;
end;

{ Para usá-la, faça como neste exemplo: }
Edit1.Text := tbGetEnvVar('PATH');

Início da página

055 - Determinar se uma janela (form) está maximizada

Inclua na seção uses: Windows

if IsZoomed(Form1.Handle) then
  { Form1 está maximizado }
else
  { Form2 NÃO está maximizado }

Início da página

056 - Determinar se o cursor do mouse está em determinado controle

Inclua na seção uses: Windows

{ Os exemplos abaixo verificam se o cursor do mouse está em
  Button1: }

{ Solução 1: }
var
  Pt: TPoint;
  Rct: TRect;
begin
  GetCursorPos(Pt);
  GetWindowRect(Button1.Handle, Rct);
  if PtInRect(Rct, Pt) then
    { Está no botão }
  else
    { NÃO está no botão }
end;

{ Solução 2: }
var
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  if WindowFromPoint(Pt) = Button1.Handle then
    { Está no botão }
  else
    { Não está no botão }
end;

Observações

A API GetWindowRect obtém o retângulo (TRect) ocupado por uma janela. Podemos usar GetClientRect para obter o somente da parte cliente da janela. Podemos também usar a propriedade BoundsRect que existe na maioria dos componentes visuais, ou mesmo informar qualquer outro retângulo da tela. Se usarmos a propriedade BoundsRect, precisaremos converter as coordenadas clientes para coordenadas de tela (com a função ClientToScreen). Um lembrete: a solução 2 só poderá ser aplicada a controles ajanelados.

Início da página

057 - Determinar se o aplicativo está minimizado

Inclua na seção uses: Windows

if IsIconic(Application.Handle) then
  { Minimizado }
else
  { Não minimizado }

Observações

Pode-se verificar qualquer janela (form). Só um lembrete: quando clicamos no botão de minimizar do form principal, na verdade ele é oculto e o Application é que é minizado.

Início da página

058 - Fechar um aplicativo com uma mensagem de erro fatal

Inclua na seção uses: Windows

procedure TForm1.Button1Click(Sender: TObject);
begin
  FatalAppExit(0, 'Erro fatal na aplicação.');
end;

Observações

A função FatalAppExit é uma API do Windows. Esta mostra uma caixa de diálogo (normalmente branca) com a mensagem passada no segundo parâmetro. Quando a caixa de diálogo é fechada a aplicação é finalizada. O evento OnCloseQuery dos forms não são chamados quando usamos esta função.

Início da página

059 - Usar o evento OnGetText de um TField

 
procedure TForm1.Table1TipoGetText(Sender: TField; var Text: String;
  DisplayText: Boolean);
begin
  if DisplayText then begin
    case Table1Tipo.AsInteger of
      1: Text := 'Promissória';
      2: Text := 'Duplicata';
      3: Text := 'Boleto';
    else
      Text := 'Desconhecido';
    end;
  end else
    Text := Table1Tipo.AsString;
end;

Observações

Ao exibir será exibido os nomes. Mas ao digitar continue com os 1, 2, 3, etc. Para usar este recurso em relatórios, acesse a propriedade DisplayText em vez de AsString para obter o valor do campo.

Início da página

060 - Maximizar 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 código abaixo: }

Top := 0;
Left := 0;
Width := Screen.Width;
Height := Screen.Height;

Observações

Nos testes que fiz, mesmo com a barra de tarefas marcada como "Sempre Visível", funcionou perfeitamente. Fiz os testes usando o Win95. Talvez em novas versões, possa apresentar problemas.

Início da página

061 - Verificar, via programação, se Local Share do BDE está TRUE

Inclua na seção uses: Registry, SysUtils, Windows

{ Esta função retorna true se Local Share estiver "TRUE".
  Caso contrário, 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 }

Observações

A função acima faz a verificação no registro do Windows. Por isto está sujeita a falha caso o BDE coloque as configurações em outro local (é o caso do BDE salvar as configurações no formato do Windows 3.x). O ideal seria usar uma API do BDE, mas até o momento não conheço uma que retorne esta informação. Caso alguém saiba, queira por gentileza nos informar.

Início da página

062 - Criar um EXE que seja executado apenas através de outro EXE criado por mim

Inclua na seção uses: Windows

{ Antes da linha "Application.Initialize;" de Prog1.dpr (programa
  a ser chamado), coloque o código abaixo:

}

if ParamStr(1) <> 'MinhaSenha' then begin
  { Para usar ShowMessage, coloque Dialogs no uses }
  ShowMessage('Execute este programa através de Prog2.EXE');
  Halt; { Finaliza }
end;

{ No Form1 de Prog2 (programa chamador) coloque um botão e
  escreva o OnClick deste botão como abaixo:
}

procedure TForm1.Button1Click(Sender: TObject);
var
  Erro: Word;
begin
  Erro := WinExec('Pro2.exe MinhaSenha', SW_SHOW);
  if Erro <= 31 then { Se ocorreu erro... }
    ShowMessage('Erro ao executar o programa.');
end;

Observações

Aqui o parâmetro passado foi 'MinhaSenha'. Você deverá trocar 'MinhaSenha' por algo que apenas você saiba (uma senha). Caso uma pessoa conheça esta senha, será possível chamar este programa passando-a como parâmetro. Neste caso sua "trava" estará violada.

Início da página

063 - Multiplas Seleções em DBGrid

 var  contador: Integer;
 begin  
 With Dbgrid1 do
 Begin
 for contador:= 0 to Pred(SelectedRows.Count) do
 Begin
 {posiciona nos registros selecionados do DBGrid
 Dataset.Bookmark:= SelectedRows[contador];
 end;
 end;

Início da página

064 - Inverter os botões do mouse

Inclua na seção uses: Windows

{ Para inverter: }
SwapMouseButton(true);

{ Para voltar ao normal: }
SwapMouseButton(false);

Início da página

065 - Obter/definir o tempo máximo do duplo-click do mouse

Inclua na seção uses: Windows

{ - Coloque um botão no form e escreva seu OnClick como
    abaixo: }

procedure TForm1.Button6Click(Sender: TObject);
var
  Tempo: Cardinal;
begin
  { Obtém }
  Tempo := GetDoubleClickTime;
  ShowMessage(IntToStr(Tempo) + ' milisegundos');

  { Define }
  SetDoubleClickTime(300);
end;

Observações

Um duplo-click nada mais é que dois cliques consecutivos (óbvio). Porém estes dois cliques podem ser interpretados de duas formas: dois cliques isolados ou um duplo-click. Para o Windows resolver esta situação, ele usa o que chamo de "tempo máximo do duplo-click". Se o intervalo entre o primeiro e o segundo click for menor ou igual a esse tempo, então houve duplo-click. E você pode alterar este tempo. O padrão do Windows é 500 milisegundos. Um tempo muito curto (ex: 100), faz com que o duplo-click tenha que ser muito rápido (quase impossível), enquanto muito longo (ex: 2000) faz com que o Windows interprete dois clicks isolados como duplo-click.

Início da página

066 - Obter os atributos de um arquivo/diretório

Inclua na seção uses: Windows

{ No form:
  - Coloque um memo;
  - Coloque um edit;
  - Coloque um botão e escreva seu OnClick como abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
var
  Attr: DWord;
begin
  Memo1.Clear;
  Attr := GetFileAttributes(PChar(Edit1.Text));
  if Attr > 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;

Início da página

067 - Obter o espaço total e livre de um disco

Inclua na seção uses: Windows

{ - Coloque um memo (TMemo) no form;
  - Coloque um botão 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 funções do Delphi. Veja: }

Memo1.Lines.Add('Total de bytes: ' + IntToStr(DiskSize(3)));
Memo1.Lines.Add('Bytes livres: ' + IntToStr(DiskFree(3)));

{ Onde o parâmetro (3) é o número da unidade, sendo
  1=A, 2=B, 3=C, ... }

Observações

Para usar as funções DiskSize e DiskFree coloque SysUtils em uses.

Início da página

068 - Obter o tipo de um drive (removível, fixo, CD-ROM, unidade de rede, etc)

Inclua na seção uses: Windows, Dialogs

{ - Coloque um edit (Edit1) e um botão no form;
  - Altere o OnClick do botão 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 não existe';
    DRIVE_REMOVABLE: S := 'Disco removível';
    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);

Observações

Para testar digite a letra do drive no Edit1 e clique no botão. 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 função tbGetDrives (da pergunta 64) em conjunto com este exemplo.

Início da página

069 - Obter informações de um volume/disco (label, serial, sistema de arquivos, etc)

Inclua na seção uses: Windows, System

{ - Coloque um memo (TMemo) no form;
  - Coloque um botão 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('Número Serial: ' + IntToHex(Serial, 8));
      Add('Tamanho máximo p/ nome arquivo: ' +
        IntToStr(FileNameLen));
      Add('Sistema de Arquivos: ' + string(SSysName));
    end;
  finally
    FreeMem(SLAbel, 255);
    FreeMem(SSysName, 255);
  end;
end;

Início da página

070 - Alterar o nome de volume (Label) de um disco

Inclua na seção uses: Windows

{ Da unidade C: }
SetVolumeLabel('c:\', 'NovoLabel');

{ Da unidade atual: }
SetVolumeLabel(nil, 'NovoLabel');

Observações

Veja a pergunta nº 66.

Início da página

071 - Saber quais as unidades de disco (drives) estão presentes

Inclua na seção uses: Windows

{ A função 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.');

Observações

A string retornada pela função tbGetDrives está sempre em letras maiúsculas.

Início da página

072 - "truncar" valores reais para apenas n casas decimais

{ Às vezes você precisa considerar apenas duas casas de valores
  reais, mas o Delphi não oferece algo pronto para isto. Se
  usarmos funções como Round que vem com o Delphi, o valor será
  arredondado (e não truncado). Com Round() o valor abaixo será
  135.55 (e não 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

{ Três casas }
X := Trunc(ValorReal * 1000) / 1000; // X será 135.5465

Observações

Isto pode não funcionar se ValorReal for muito alto. Isto por causa da multiplicação que poderá estourar a capacidade do tipo em uso. Lembre-se: os tipos reais aceitam valores muuuiiiito altos.

Início da página

073 - Excluir 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);
ou
tbDBDeleteAll(Query1);

Observações

Se houver um filtro ou range ativo, somente os registros filtrados serão excluídos. Portanto é diferente de Table1.EmptyTable. Esta função poderá ser chamada no evento BeforeDelete do Table (ou Query) principal em um formulário mestre-detalhe para excluir os itens (da parte detalhe).

Início da página

074 - Saber se o sistema está usando 4 dígitos para o ano

{ Para não correr o risco de surpresas desagradáveis,
  é melhor que seu programa em Delphi verifique se
  o Windows está ajustado para trabalhar com 4 dígitos
  para o ano. Assim seu programa pode alertar o usuário 
  quando o ano estiver sendo representado com apenas 2 dígitos.
  A função abaixo retorna true se estiver ajustado para
  4 dígitos.
}

function Is4DigitYear: Boolean;
begin
  result:=(Pos('yyyy',ShortDateFormat)>0);
end;

Início da página

075 - Imprimir caracteres acentuados diretamente para a impressora

{ Usando comandos da impressora podemos fazer isto de uma
  forma bastante simples. Quando enviamos o caractere ASCII
  número 8 (oito) para a impressora, a cabeça de impressão 
  retrocede uma posição, pois este caractere é o BackSpace.
  Então podemos imprimir a letra sem acento e, sem seguida,
  voltar e imprimir o acento desejado. Vejamos um exemplo:

  - Coloque um botão no form;
  - Altere o evento OnClick deste botão 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;

Observações

Usando este recurso, a acentuação não fica excelente, mas melhora bastante.

Início da página

076 - Imprimir texto justificado com formatação na impressora Epson LX-300

{ A impressora Epson LX-300 dispõe de um comando que justifica
  o texto. Este recurso é interessante, pois com ele podemos
  continuar a enviar os comandos de formatação de caracteres
  como condensado, negrito, italico, expandido, etc.

  Para o exemplo abaixo:
  - Coloque um botão no form;
  - Altere o evento OnClick deste botão 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;
  { Formatação 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;

Observações

Este recurso de justificação da Epson LX-300 pode ser usado em qualquer linguagem de programação.

Início da página

077 - Formatar um disquete através de um programa Delphi

{ Coloque o código abaixo imediatamente abaixo da palavra
  implementation: }

const
  SHFMT_ID_DEFAULT = $FFFF;

  { Opções de formatação }
  SHFMT_OPT_QUICKFORMAT = $0000; { Formatação rápida }
  SHFMT_OPT_FULL = $0001;        { Formatação completa }
  SHFMT_OPT_SYSONLY = $0002;     { Copia sistema }

  { Códigos de errros }
  SHFMT_ERROR = $FFFFFFFF; { Ocorreu erro }
  SHFMT_CANCEL = $FFFFFFFE; { Foi cancelado }
  SHFMT_NOFORMAT = $FFFFFFFD; { Não formatou }

function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word):
  LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive'

{ Coloque um botão 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 formatação foi cancelada.';
    SHFMT_NOFORMAT: Msg := 'Não foi possível formatar.';
  else
    Msg := 'Disco formatado com sucesso.';
  end;
  ShowMessage(Msg);
end;

Observações

Para formatação completa troque SHFMT_OPT_QUICKFORMAT por SHFMT_OPT_FULL. O segundo parâmetro (zero no exemplo) indica a unidade, sendo que A é 0 (zero), B é 1, etc.

Início da página

078 - Executar um arquivo com extensão *.LNK

uses ShellApi;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(0,nil,'C:\WINDOWS\START MENU\DELPHI\Delphi3.lnk' ,nil, nil, SW_SHOWNORMAL);
end;

Início da página

079 - Reproduzir um arquivo de som WAV sem o TMediaPlayer

Inclua na seção uses: MMSystem

{ Síncrona: aguarda terminar a reprodução para continuar: }
SndPlaySound('C:\Win95\Media\Office97\Lembrete.wav', SND_SYNC);

{ Assíncrona: a execução continua normalmente enquanto
  ocorre a reprodução: }
SndPlaySound('C:\Win95\Media\Office97\Lembrete.wav', SND_ASYNC);

{ Contínua: a reprodução é repetida num efeito de loop. 
  Este tipo de reprodução precisa ser assíncrona: }
SndPlaySound('C:\Win95\Media\Office97\Lembrete.wav', 
  SND_ASYNC or SND_LOOP);

{ Interrompe uma reprodução contínua: }
SndPlaySound(nil, 0);

Observações

A reprodução contínua pode ser usada, por exemplo, para altertar o usuário em uma situação extremamente crítica. Se o equipamento não possuir placa de som, o arquivo não será reproduzido.

Início da página

080 - Obter o nome do usuário e da empresa informado durante a instalação do Windows

Inclua na seção uses: Registry

{ Coloque um botão 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; 

Início da página

081 - Mostrar uma barra de progresso enquanto copia arquivos

Veja a pergunta nº 53.

Início da página

082 - Copiar arquivos usando o Shell do Windows

Inclua na seção uses: ShellApi

{ - Coloque um botão no form e altere o evento OnClick
    deste botão 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;

Observações

Esta forma de copiar arquivos oferecem várias vantagens. O Shell avisa para pôr um próximo disco quando o atual estiver cheio. Mostra a barra de progresso. Pode copiar arquivos usando máscara de uma forma extremamente simples.

Início da página

083 - Descobrir o código ASCII de uma tecla

{ - Coloque 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);
begin
  Label1.Caption :=
    Format('O código da tecla pressionada é: %d', [Key]);
end;

Observações

Para testar execute e observe o Label enquanto pressiona as teclas desejadas.

Início da página

084 - Evitar que seu programa apareça na barra de tarefas

Inclua na seção uses: Windows

{ Você já observou a caixa "Propriedades", aquela que mostra
  as propriedades de um arquivo no Windows Explorer, não
  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. Porém podemos
  mudar o comportamento de nossos programas feito em Delphi
  para que se comportem como uma ToolWindow também.

  Para experimentar, crie um novo projeto e altere o
  Project1.dpr como abaixo (não esqueça 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.

Observações

Ao executar observe a barra de tarefas e teste o Alt+Tab (seu programa não estará lá!).

Início da página

085 - Usar eventos de som do Windows

{ Evento Som Padrão }
MessageBeep(0); { ou Beep; }

{ Evento Parada Crítica }
MessageBeep(16);

{ Evento Pergunta }
MessageBeep(32);

{ Evento Exclamação }
MessageBeep(48);

{ Evento Asterisco }
MessageBeep(64);

Início da página

086 - Mudar a coluna ativa em um DBGrid via programação

{ Usando número da coluna (zero é a primeira coluna): }
DBGrid1.SelectedIndex := 0;

{ Usando o nome do campo }
DBGrid1.SelectedField := Table1.FieldByName(Edit2.Text);

Observações

Aconselho usar o nome do campo quando o que importa é o campo e não a posição. Use o número da coluna somente quando o que importa é a posição, e não o campo.

Início da página

087 - Fechar o Windows a partir do seu programa

{ Reinicia o Windows }
ExitWindowsEx(EWX_REBOOT, 0);

{ Desliga o Windows }
ExitWindowsEx(EWX_SHUTDOWN, 0); 

{ Força todos os programa a desligarem-se }
ExitWindowsEx(EWX_FORCE, 0);

Início da página

088 - Carregar um cursor animado (.ani)

{ Altere 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;

Observações

Para este exemplo é necessário ter o arquivo de cursor conforme apontado e também ter, no form, um Button1. Para usar este cursor em outros componentes basta atribuir à propriedade Cursor do componente em questão o valor 1 (um). Exemplo: Edit1.Cursor := 1; Form1.Cursor := 1;, etc.

Início da página

089 - Enviar um arquivo para a lixeira

Inclua na seção uses: ShellApi

{ Coloque a procedure abaixo na seção implementation }

procedure ArqParaLixeira(const NomeArq: string; var MsgErro: string);
var
  Op: TSHFileOpStruct;
begin
  MsgErro := '';
  if not FileExists(NomeArq) then begin
    MsgErro := 'Arquivo não 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 := 'Não foi possível enviar o arquivo para a lixeira.';
end;

{ - Coloque um botão no Form;
  - Altere o evento OnClick do botão 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;

Início da página

090 - Obter o número do registro atual

Table1.RecNo()

Início da página

091 - Trabalhar com Filter de forma mais prática

Se você está habituado a usar este código no filter...

Table1.Filter := 'Nome = '''+ Edit1.Text + '''';
ou
Table1.Filter := 'Data = ''' + DateToStr(Date) + '''';

Tente usar este:

Table1.Filter := 'Nome = ' + QuotedStr(Edit1.Text);
ou
Table1.Filter := 'Data = ' + QuotedStr(DateToStr(Date));

Observações

A função QuitedStr() coloca apóstrofos envolvendo a string. Se houver um apóstrofo como parte da string, ela o subtitui por dois apóstrofos, para que seja corretamente interpretado.

Início da página

092 - Reproduzir um arquivo WAV

Inclua na seção uses: MMSystem

PlaySound('C:\ArqSom.wav', 1, SND_ASYNC);

Observações

Troque o nome do arquivo (C:\ArqSom.wav) pelo arquivo desejado.

Início da página

093 - Executar um programa DOS e fechá-lo em seguida

{ Coloque isto no evento OnClick de um botão: }

WinExec('command.com /c programa.exe',sw_ShowNormal);

{ Se quizer passar parâmetros pasta adicioná-los após o
  nome do programa. Exemplo: }

WinExec('command.com /c programa.exe param1 param2',sw_ShowNormal);

Observações

Se quizer que a janela do programa não apareça, troque sw_ShowNormal por sw_Hide.

Início da página

094 - Fechar um programa a partir de um programa Delphi

{ - Coloque um botão 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 não encontrado')
  else
    PostMessage(Janela, WM_QUIT, 0, 0);
end;

Observações

Este 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 não salvos, o programa a ser fechado não oportunidade para salvá-los. Uma alternativa mais suave é trocar a mensagem WM_QUIT por WM_CLOSE. Veja as perguntas 18 e 36.

Início da página

095 - Colocar Hint's de várias 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;

Início da página

096 - Reproduzir um vídeo AVI em 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 botão;
  - Altere o evento OnClick do botão 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;

Observações

Em vez de ajustar o Form ao vídeo, podemos ajustar o vídeo ao Form. Para isto troque o trecho with..end; por MediaPlayer1.DisplayRect := Form2.ClientRect;

Início da página

097 - Separar (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 função:
  - Coloque um botão no Form;
  - Altere o evento OnClick deste botão conforme abaixo: }

procedure TForm1.Button4Click(Sender: TObject);
begin
  { Pega só letras }
  ShowMessage(FilterChars('D63an*%i+/e68l13',
     ['A'..'Z', 'a'..'z']));
  { Pega só números }
  ShowMessage(FilterChars('D63an*%i+/e68l13', ['0'..'9']));
end;

Observações

Se quizer usar este função em outras unit's, coloque a declaração do tipo TChars na seção interface. Coloque aí também uma declaração da função FilterChars. E não se esqueça da cláusula uses.

Início da página

098 - Colocar zeros à esquerda de números

{ Isto coloca zeros à esquerda do número até completar 6 casas }
S := FormatFloat('000000', 5);
  

Observações

"S" precisa ser uma variável string.

Início da página

099 - Copiar 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;

Observações

No exemplo acima, se o arquivo já existir no destino, a função falha (não copia). Para que a função possa sobreescrever o arquivo destino (caso exista), altere o último parâmetro de CopyFile para false. CUIDADO! Se um arquivo for sobreescrito, estará perdido para sempre! Veja as perguntas nº 35 e 53.

Início da página

100 - Copiar 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;

Observações

No exemplo acima, se o arquivo já existir no destino, a função falha (não copia). Para que a função possa sobreescrever o arquivo destino (caso exista), altere o último parâmetro de CopyFile para false. CUIDADO! Se um arquivo for sobreescrito, estará perdido para sempre! Veja as perguntas nº 36 e 53.

Início da página

101 - Trabalhar com cores no formato string

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

Início da página

102 - Verificar se determinado programa está em execução (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 NÃO está aberto');

  { Verifica o Word }
  if FindWindow('OpusApp', nil) > 0 then
    ShowMessage('O Word está aberto')
  else
    ShowMessage('O Word NÃO está aberto');

  { Verifica o Excell }
  if FindWindow('XLMAIN', nil) > 0 then
    ShowMessage('O Excell está aberto')
  else
    ShowMessage('O Excell NÃO está aberto');
end;

Observações

Há uma margem de erro nesta verificação: 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.

Início da página

103 - Excluir 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('Não consegui excluir c:\Teste\' + SR.Name);
    I := FindNext(SR);
  end;
end;

Observações

No exemplo acima todos os arquivos do diretório c:\Teste serão excluídos. CUIDADO! Arquivos excluídos desta forma não vão para a lixeira. Veja a pergunta nº 46.

Início da página

104 - Gerar uma tabela no Word através do Delphi

Inclua na seção uses: ComObj

{ - Coloque um botão no Form;
  - Altere o evento OnClick do botão 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 célula }
      Word.Selection.TypeText(Text := 'Linha 1, Coluna 1');
      { Próxima célula }
      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 cópia }
      Word.ActiveDocument.PrintOut(Copies := 1);
      ShowMessage('Aguarde o término da impressão...');
      { 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;

Observações

Foram usados neste exemplo o Delphi4 e MS-Word97.

Início da página

105 - Obter a quantidade de registros total e visível de uma tabela

Inclua na seção uses: DbiProcs

Os componentes TTable e TQuery possuem a propriedade
RecordCount 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 1 a 10 e aplicarmos o filtro mostrado a seguir,
a propriedade RecordCount retornará 5 e não 10.

Table1.Filter := 'Codigo <= 5';
Table1.Filtered := true;

Se quizermos obter a quantidade total de registros,
independentemente de filtros, devemos usar uma API do BDE
conforme abaixo:

var
  Total: integer;
begin
  Check(DbiGetRecordCount(Table1.Handle, Total));
  ShowMessage('Total de registros: ' + IntToStr(Total));
end;  

Observações

Para testar o exemplo acima, o Table1 precisa estar aberto.

Início da página

106 - Evitar que um programa seja executado mais de uma vez

{ Muitos programas Windows permitem apenas uma cópia em 
  execução de cada vez. Isto é interessante principalmente
  quando é um grande aplicativo, pois duas cópias ao mesmo
  tempo usuaria muito mais memória. Em aplicativos 
  desenvolvidos em Delphi podemos ter esta característica.
  Vejamos:

  - Crie um novo projeto;
  - Mude o "Name" do Form1 para DPGFormPrinc;
  - Altere o código-fonte do arquivo Project1.dpr
    conforme abaixo:  }

program Project1;

uses
  Forms, Windows,
  Unit1 in 'Unit1.pas' {DPGFormPrinc};

{$R *.RES}

var
  Handle: THandle;
begin
  Handle := FindWindow('TDPGFormPrinc', nil);
  if Handle <> 0 then begin { Já está aberto }
    Application.MessageBox('Este programa já está aberto. A cópia ' +
      'anterior será ativada.', 'Programa já aberto', MB_OK);
    if not IsWindowVisible(Handle) then
      ShowWindow(Handle, SW_RESTORE);
    SetForegroundWindow(Handle);
    Exit;
  end;
  Application.Initialize;
  Application.CreateForm(TDPGFormPrinc, DPGFormPrinc);
  Application.Run;
end.

Observações

Para testar este programa você deverá compilar o projeto e fechar o Delphi. Depois, procure o Project1.exe (projeto compilado) usando o Windows Explorer e tente executá-lo mais de uma vez e veja o que acontece. Mas porque alterar o name do form principal para "DPGFormPrinc"? Este poderia ser qualquer outro nome, mas preferi usar as iniciais do meu nome (DPG). Procurei deixar um nome bem pessoal para não correr o risco de colocar um nome que possa ser encontrado em outro aplicativo do Windows. Por exemplo: se deixar Form1, será bem fácil encontrar outro aplicativo feito em Delphi que possua uma janela com este nome, o que causaria problema.

Início da página

107 - Executar um "COMMIT" no Delphi

Inclua na seção uses: DbiProcs

{ Se estiver usando TTable, coloque nos eventos
  AfterPost e AfterDelete a seguinte linha: }

  dbiSaveChanges(Table1.Handle);

{ Para TQuery, a instrução é semelhante: }

  dbiSaveChanges(Query1.Handle);

Início da página

108 - Posicionar Form's em relação ao Desktop do Windows

{ Quando usamos a propridade Position de um Form para
  centralizá-lo estamos sujeitos a um inconveniente:
  dependendo da posição/tamanho da barra de tarefas do
  Windows, o nosso Form poderá ficar parcialmente coberto
  por ela. Uma forma eficaz de resolver este problema é
  posicionar o form considerando apenas a área livre do
  Desktop. Vejamos este exemplo:

  - Crie um novo projeto;
  - Na seção implementation digite a procedure abaixo:
}

procedure FormPos(Form: TForm; const Horz, Vert: byte);
{ Horz: 1=esquerda, 2=centro, 3=direita
  Vert: 1=topo, 2=centro, 3=em baixo }
var
  R: TRect;
begin
  if not SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0) then
    R := Rect(0, 0, Screen.Width, Screen.Height);
  with Form do
    case Horz of
      1: Form.Left := 0;
      2: Form.Left := (R.Right - R.Left - Width) div 2;
      3: Form.Left := R.Right - Width;
    end;
  with Form do
    case Vert of
      1: Form.Top := 0;
      2: Form.Top := (R.Bottom - R.Top - Height) div 2;
      3: Form.Top := R.Bottom - Height;
    end;  
end;

{ - Coloque dois TEdit's: Edit1 e Edit2;
  - Coloque um TButton e altere o evento OnClick deste 
    conforme abaixo:
}

procedure TForm1.Button1Click(Sender: TObject);
begin
  FormPos(Form1, StrToInt(Edit1.Text), StrToInt(Edit2.Text));
end;

Observações

Para testar, execute este exemplo e experimente digitar números de 1 a 3 em ambos os Edit's e clique no Button para ver o resultado. O Edit1 indica a posição horizontal (esquerda, centro e direita) e o Edit2 indica a posição vertical (topo, centro e em baixo).

Início da página

109 - Saber a resolução de tela atual

{ Coloque um TButton no Form e altere o evento
  OnClick deste botão como abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('Largura: ' + IntToStr(Screen.Width) + #13 +
              'Altura: ' + IntToStr(Screen.Height));
end;

Observações

O objeto Screen contém várias informações importantes: largura e altura da tela, fontes instaladas no Windows, etc.

Início da página

110 - Verificar se uma unidade de disco (disk-drive) está preparada

Inclua na seção uses: System, SysUtils

{ - Crie um novo projeto;
  - Na seção implementation da Unit1 digite a função abaixo: }

function DriveOk(Drive: Char): boolean;
var
  I: byte;
begin
  Drive := UpCase(Drive);
  if not (Drive in ['A'..'Z']) then
    raise Exception.Create('Unidade incorreta');
  I := Ord(Drive) - 64;
  Result := DiskSize(I) >= 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 não preparado')
  else
    ShowMessage('Drive OK');
end;

Observações

Para testar você deverá executar o exemplo e digitar no Edit a letra do drive a ser testado (não precisa os dois-pontos). Após digitar, clique no Button1.

Início da página

111 - Salvar/restaurar o tamanho e posição de Form's

{ Crie uma nova Unit conforme abaixo: }
unit uFormFunc;

interface
uses Forms, IniFiles, SysUtils, Messages, Windows;

procedure tbLoadFormStatus(Form: TForm; const Section: string);
procedure tbSaveFormStatus(Form: TForm; const Section: string);

implementation

procedure 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 formulário que deseja salvar/restaurar:
  - Inclua na seção uses: uFormFunc
  - No evento OnShow digite: 
    tbLoadFormStatus(Self, Self.Name);
  - No evento OnClose digite:
    tbSaveFormStatus(Self, Self.Name);
}

Observações

O arquivo INI terá o nome do executável e extensão INI e será salvo no diretório do Windows. A palavra Self indica o Form relacionado com a unit em questão. 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 idêntico no evento OnShow e OnClose de um mesmo Form, porém para cada Form deverá ser usado um nome diferente.

Início da página

112 - Definir a quantidade de registros a ser impressa em uma página do QuickReport

1. A forma mais simples consiste em alterar a altura (Height)
   da banda Detail do nosso relatório de modo que a altura
   total da página seja inferior a duas vezes a altura da banda.
   Desta forma, cada registro será impresso em uma nova página,
   teoricamente por falta de espaço na página atual.

2. Uma outra forma mais sofisticada é usar o evento AfterPrint
   da banda Detail. Nele testamos se ainda não chegou no fim 
   da tabela e, caso positivo, pedimos uma nova página:

   if not Table1.EOF then
     QuickRep1.NewPage;

Deve existir outras alternativas, mas as duas anteriores
funcionaram bem nos testes realizados.

Início da página

113 - Colocando um BiTMap no Form

TForm1 = class(TForm)
procedure FormCreate(Sender:Tobject);
procedure FormPaint(Sender:TObject);
private
{  Private declarations }
grafico: TBitmap;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}

procedure TForm1. FormCreate(Sender:Tobject);
begin
grafico:= TBitmap.Create;
grafico.LoadFromFile ('diretório e nome da figura.bmp'); 
end;

procedure TForm1. FormPaint(Sender:TObject);
begin
Form1.Canvas.Draw(0,0,grafico);
end;
end.

Início da página

114 - Para que servem OnGetEditMask, OnGetEditText e OnSetEditText do TStringGrid

O evento OnGetEditMask ocorre quando entramos no modo de edição.
Neste momento podemos verificar em qual linha/coluna se 
encontra o cursor e então, se quiser, poderá especificar uma
máscara de edição. 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;_'; // Telefone
end;

O evento OnGetEditText ocorre também quando entramos no modo
de edição. Neste momento podemos manipularmos o texto da
célula atual (linha/coluna) e então podemos simular algo tal
como uma tabela onde opções podem ser digitadas através
de números. 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 saímos do modo de
edição. Neste momento podemos manipular a entrada e trocar
por um texto equivalente. Normalmente usamos este evento em
conjunto 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;

Observações

Para testar o exemplo anterior crie um novo projeto e coloque no Form1 um TStringGrid. Mude os três eventos mencionados conforme os exemplos. Execute e experimente digitar nas céluas 1 e 2 da primeira linha (na parte não fixada, é claro!).

Início da página

115 - Mostrar 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 botões 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 conteúdo 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.

Observações

O Form2 do exemplo é o Form de LogOn. Este deverá ser preparado para que se possa escolher o usuário, digitar a senha, etc.

Início da página

116 - Limitar a região de movimentação do mouse

Inclua na seção uses: Windows

{ Coloque um botão no form e altera o evento OnClick dele
  conforme abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
var
  R: TRect;
begin
  { Pega o retângulo 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 região de movimentação do mouse }
  ClipCursor(@R);
  ShowMessage('Tente mover o mouse para fora da área cliente do Form');
  { Libera a movimentação }
  ClipCursor(nil);
end;

Observações

Cuidado! Isto pode irritar o usuário do seu programa.

Início da página

117 - Descobrir o nome de classe de uma janela do Windows

Muitas vezes precisamos saber qual o nome de classe
de uma determinada janela. Quando são janelas desenvolvidas
por nós, você olha no código-fonte. Mas e se não for, como
é o caso do Delphi?

Por exemplo:

Para verificar se o Delphi está sendo executado, procuramos
no Windows pela janela cujo nome de classe seja TAppBuilder.
Mas como verificar então se o Internet Explorer está sendo 
executado? Precisaremos saber o nome de classe da janela 
deste programa. Então o que fazer?

Use o TBWinName. Pegue-o no download de 
www.ulbrajp.com.br/usuario/tecnobyte

Início da página

118 - Ocultar/exibir a barra de tarefas do Windows

Inclua na seção uses: Windows

{ Coloque no Form dois Botões: 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 botões }

Observações

A tarefa mais difícil é descobrir o nome de classe da janela da barra de tarefa do Windows, mas isto é fácil 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 manipulação de Janelas. Veja a pergunta nº 18.

Início da página

119 - Evitar a proteção de tela durante seu programa

Inclua na seção uses: Windows

{ Na seção "private" do Form principal acrescente: }
procedure AppMsg(var Msg: TMsg; var Handled: Boolean);

{ Na seção "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;

Início da página

120 - Fazer a barra de título ficar intermitente (piscante)

Inclua na seção 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;

Início da página

121 - Posicionar o cursor do mouse em um controle

Inclua na seção uses: Windows

{ Digite a procedure abaixo imediatamente após a palavra
  implementation no código do seu formulário. }

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 botão 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;

Observações

A função "MouseParaControle" recebe um parâmetro 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 próprio Form.

Início da página

122 - Criar 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;

Observações

A quantidade de cada cor primária é um número de 0 a 255. Observe que a cor retornada pela função RGB() está no formato do Windows (ColorRef); é por isto que fiz a conversão TColor(RGB(...)).

Início da página

123 - Adicionar uma nova fonte no Windows

{ Coloque o código abaixo no OnClick de um botão }
AddFontResource(PChar('c:\MyFonts\Monospac.ttf'));

Observações

Troque o nome do arquivo do exemplo anterior pelo nome desejado. Arquivos de fonte possuem uma das seguintes extensões: FON, FNT, TTF, FOT. Veja também a pergunta nº 10.

Início da página

124 - Saber se a impressora atual possui determinada fonte

Inclua na seção uses: Printers

{ Coloque este código no OnClick de um botão }
with Printer.Fonts do
  if IndexOf('Draft 10cpi') >= 0 then
    ShowMessage('A impressora possui a fonte.')
  else
    ShowMessage('A impressora NÃO possui a fonte.');

Observações

Isto 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 também a pergunta nº 10.

Início da página

125 - Saber se determinada Font está instalada no Windows

{ Coloque este código no OnClick de um botão }
with Screen.Fonts do
  if IndexOf('Courier New') >= 0 then
    ShowMessage('A fonte está instalada.')
  else
    ShowMessage('A fonte não está instalada.');  

Observações

Veja também a pergunta nº 11.

Início da página

126 - Acertar a data e hora do sistema através do programa

{ Coloque dois TEdit no form.
  Coloque um TButton no form e altere o evento OnClick
  deste botão 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;

Observações

No Edit1 digite a nova data e no Edit2 digite a nova hora.

Início da página

127 - ENTER em vez de TAB no formulário, no DBGrid e no StringGrid

{ Mude a propriedade "KeyPreview" do Form para true. }

{ No evento "OnKeyPress" do Form acrescente o código 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;

Observações

É bom lembrar que a tecla ENTER no Windows tem seu papel já bem definido quando se trata de caixa de diálogo: executar a ação padrão, normalmente o botão OK. Se não tomar cuidado poderá confundir o usuário, em vez de ajudá-lo.

Início da página

128 - Simular a vírgula através do ponto do teclado numérico

{ Na seção "private" do Form principal acrescente: }
procedure AppMsg(var Msg: TMsg; var Handled: Boolean);

{ Na seção "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: 

  Coloque o código abaixo no evento OnKeyPress do componente 
  onde se quer a conversão (Edit, DBEdit, etc). Neste caso
  a conversão funcionará apenas neste componente (óbvio). }

  if Key = '.' then Key = DecimalSeparator;

Observações

Na primeira alternativa, sempre que for pressionado o ponto do teclado numérico (da direita do teclado), este será convertido para vírgula, independentemente do controle que estiver em foco. Já na segunda, o ponto pode ser de qualquer lugar do teclado.

Início da página

129 - Paralizar um programa durante n segundos

Inclua na seção uses: Windows

{ Pausa por 1 segundo }
Sleep(1000);

{ Pausa por 10 segundos }
Sleep(10000);

Observações

Esta pausa não é interrompida pelo pressionamento de alguma tecla, como acontecia com InKey() do Clipper.

Início da página

130 - Criar uma tabela (DB, DBF) através do seu programa

Inclua na seção uses: dbTables, DB

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

Observações

Para verificar se o arquivo já existe na versão 3 ou anterior do Delphi, você deverá usar a função "FileExists" do Delphi.

Início da página

131 - Verificar se um diretório existe

Inclua na seção uses: FileCtrl, Dialogs

if DirectoryExists('C:\MEUSDOCS') then
  ShowMessage('O diretório existe')
else
  ShowMessage('O diretório não existe'); 

Início da página

132 - Verificar se um arquivo existe

Inclua na seção uses: SysUtils, Dialogs

if FileExists('c:\carta.doc') then
  ShowMessage('O arquivo existe')
else
  ShowMessage('O arquivo não existe');

Início da página

133 - Criar um Alias temporário através do seu programa

Inclua na seção uses: DB

{ Enxergar somente configurações da sessão atual }
Session.ConfigMode := cmSession;
{ Adicionar o Alias }
Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX');

Observações

Veja a pergunta nº 1.

Início da página

134 - Criar um Alias através do seu programa

Inclua na seção uses: DB

{ se o alias não existir... }
if not Session.IsAlias('MeuAlias') then 
begin
  { Adiciona o alias }
  Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX');
  { Salva o arquivo de configuração do BDE }
  Session.SaveConfigFile;
end;

Observações

Para 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á necessário incluir na seção uses: SysUtils, System.

Início da página