Dicas de Delphi - Outros

Mac Address do adaptador de rede

A função abaixo retorna o Mac Address do adaptador de rede: 
function MacAddress: string;
var
  Lib: Cardinal;
  Func: function(GUID: PGUID): Longint; stdcall;
  GUID1, GUID2: TGUID;
begin
  Result := '';
  Lib := LoadLibrary('rpcrt4.dll');
  if Lib <> 0 then
  begin
    @Func := GetProcAddress(Lib, 'UuidCreateSequential');
    if Assigned(Func) then
    begin
      if (Func(@GUID1) = 0) and
         (Func(@GUID2) = 0) and
         (GUID1.D4[2] = GUID2.D4[2]) and
         (GUID1.D4[3] = GUID2.D4[3]) and
         (GUID1.D4[4] = GUID2.D4[4]) and
         (GUID1.D4[5] = GUID2.D4[5]) and
         (GUID1.D4[6] = GUID2.D4[6]) and
         (GUID1.D4[7] = GUID2.D4[7]) then
      begin
        Result :=
          IntToHex(GUID1.D4[2], 2) + '-' +
          IntToHex(GUID1.D4[3], 2) + '-' +
          IntToHex(GUID1.D4[4], 2) + '-' +
          IntToHex(GUID1.D4[5], 2) + '-' +
          IntToHex(GUID1.D4[6], 2) + '-' +
          IntToHex(GUID1.D4[7], 2);
      end;
    end;
  end;
end;

Início

Escrever no Bloco de Notas

Problema:

Gostaria verificar se o bloco de notas está aberto e, caso esteja, escrever um texto a partir de um programa feito em Delphi. Isto é possível?

Solução:

Sim, isto é possível. O código abaixo escreve o conteúdo de uma variável no Bloco de Notas caso ele esteja aberto no momento do Click em Button1: 
procedure TForm1.Button1Click(Sender: TObject);
var
  JanelaPrincipal, JanelaFilha: THandle;
  I: integer;
  Texto: string;
begin
  Texto := 'Daniel';
  JanelaPrincipal := FindWindow('Notepad', nil);
  if JanelaPrincipal > 0 then
  begin
    JanelaFilha := FindWindowEx(JanelaPrincipal, 0, 'Edit', nil);
    if JanelaFilha > 0 then
    begin
      for I := 1 to Length(Texto) do
        PostMessage(JanelaFilha, WM_CHAR, Ord(Texto[I]), 0);
    end;
  end;
end;

Observações:

Uma alternativa mais interessante seria abrir o Bloco de Notas caso ele ainda não esteja aberto. Mas vou deixar este problema como exercício de fixação.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Captions no DBNavigator

Por padrão, o DBNavigator não possui uma propriedade para especificar os captions dos botões, mas isto pode ser resolvido com o código abaixo: 
type
  TMeuDBNavigator = class(TDBNavigator);

procedure TForm1.FormCreate(Sender: TObject);
const
  Legendas: array[TNavigateBtn] of string = (
    'Primeiro', 'Anterior', 'Próximo', 'Último',
    'Incluir', 'Excluir', 'Editar', 'Salvar',
    'Cancelar', 'Atualizar');
var
  Botao: TNavigateBtn;
begin
  for Botao := nbFirst to nbRefresh do
  begin
    with TMeuDBNavigator(DBNavigator1).Buttons[Botao] do
    begin
      Caption := Legendas[Botao];
      Layout := blGlyphTop;
    end;
  end;
end;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Arredondamento financeiro

É muito comum encontrar programadores Delphi que têm dúvidas sobre como arredondar um valor real para "n" casas após o separador decimal. A princípio parece um problema simples, pois o próprio Delphi já possui uma função que arredonda para o inteiro mais próximo, a qual poderia facilmente ser utilizada para arredondar para qualquer quantidade de casas decimais. Exemplo: 

{ x receberá o valor de y arredondado para 2 casas após o separador. }
x := Round(y * 100) / 100;

{ z receberá o valor de y arredondado para 3 casas após o separador. }
z := Round(y * 1000) / 1000;

No entanto dois problemas poderão aparecer com os exemplos acima:

A função abaixo resolve estes dois problemas. 

{ Esta função faz arredondamento de valores reais para "n" casas
  decimais após o separador decimal, seguindo os critérios das
  calculadoras financeiras e dos bancos de dados InterBase e FireBird.
}
function TBRound(Value: Extended; Decimals: integer): Extended;
var
  Factor, Fraction: Extended;
begin
  Factor := IntPower(10, Decimals);
  { A conversão para string e depois para float evita
    erros de arredondamentos indesejáveis. }
  Value := StrToFloat(FloatToStr(Value * Factor));
  Result := Int(Value);
  Fraction := Frac(Value);
  if Fraction >= 0.5 then
    Result := Result + 1
  else if Fraction <= -0.5 then
    Result := Result - 1;
  Result := Result / Factor;
end;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Calcular idade (em anos completos)

A função abaixo calcula o número de anos completos entre duas datas. É ideal para calcular idades de pessoas, por exemplo. 

function CalcAnos(const Data1, Data2: TDateTime): integer;
var
  D1, M1, A1,
  D2, M2, A2: Word;
begin
  DecodeDate(Data1, A1, M1, D1);
  DecodeDate(Data2, A2, M2, D2);

  Result := A2 - A1;

  if (M1 > M2) or ((M1 = M2) and (D1 > D2)) then
    Dec(Result);
end;

Exemplo de uso: 
var
  DataNasc: TDateTime;
begin
  DataNasc := StrToDate(Edit1.Text);
  ShowMessage(IntToStr(CalcAnos(DataNasc, Date)) + ' anos');
end;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

DBGrid zebrado

Programe o evento OnDrawColumnCell do DBGrid como abaixo:

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  if State = [] then
  begin
    if Table1.RecNo mod 2 = 1 then
      DBGrid1.Canvas.Brush.Color := clAqua
    else
      DBGrid1.Canvas.Brush.Color := clWhite;
  end;
  DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;

Observação:

O objeto Table1 é da classe TTable (relativa ao BDE), mas esta dica poderá ser usada com outros DataSet's, tais como IBDataSet, ClientDataSet, etc.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Consultar por mês de um campo data

Problema:

Tenho um cadastro de clientes com Codigo, Nome, DataNasc, etc.
Preciso fazer uma consulta onde apareceão apenas os clientes
que fazem aniversário em determinado mês. Como fazer?

Solução:

Use uma Query como abaixo:
- Coloque no form os seguintes componentes:
  * TQuery
  * TDataSource
  * TDBGrid
  * TEdit
  * TButton

- Altere as propriedades dos componentes como abaixo:
  * Query1.DatabaseName = (alias do BDE)
  * DataSource1.DataSet = Query1
  * DBGrid1.DataSource = DataSource1
  
- Coloque o código abaixo no evento OnClick de Button1:

  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from dCli');
  Query1.SQL.Add('where extract(month from DataNasc) = :Mes');
  Query1.ParamByName('Mes').AsInteger := StrToInt(Edit1.Text);
  Query1.Open;

- Execute. Digite um número de 1 a 12 no Edit e clique no 
  botão.

Observações

Os números de 1 a 12 representam, respectivamente, os meses de Janeiro a Dezembro. Este exemplo foi testado com Delphi4, BDE5 e tabela Paradox7.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Mudar a cor do Edit ao receber o foco

Alguns programas mostram o Edit que está com o foco em uma 
cor diferente dos demais. Como fazer isto em Delphi?

Na seção private do form declare o procedimento abaixo:
  
  private
    procedure MudancaDeFoco(Sender: TObject);
  public
  end;

Na seção implementation, escreva o código do procedimento:

{ Esta rotina será chamada através do evento OnExit (perda do foco)
  de todos os componentes do tipo TEdit que existirem no form. }
procedure TForm1.MudancaDeFoco(Sender: TObject);
var
  I: integer;
  Ed: TEdit;
begin
  { Percorre a matriz de componentes do form }
  for I := 0 to ComponentCount - 1 do
    { Se o componente é do tipo TEdit... }
    if Components[I] is TEdit then
    begin
      { Faz um type-casting pata o tipo TEdit }
      Ed := Components[I] as TEdit;

      { Se o Edit está com o foco... }
      if Ed.Focused then
        Ed.Color := clYellow { Amarelo }
      else
        Ed.Color := clWhite; { Branco }
    end;
end;

No evento OnCreate do Form, coloque o código abaixo:

procedure TForm1.FormCreate(Sender: TObject);
var
  I: integer;
begin
  { Percorre a lista de componentes do form (matriz de componentes)
    e verifica cada componente para saber se é um TEdit. Se for,
    associa o evento OnExit do componente com a procedure
    "MudancaDeFoco". }
  for I := 0 to ComponentCount - 1 do
    if Components[I] is TEdit then
      (Components[I] as TEdit).OnExit := MudancaDeFoco;
end;

No evento OnActivate coloque:

procedure TForm1.FormActivate(Sender: TObject);
begin
  { Esta chamada é necessária para que o estado inicial seja
    controlado. }
  MudancaDeFoco(nil);
end;

Observações

Existem outras técnicas mais profissionais para resolver o problema proposto. Uma alternativa excelente é a criação de um novo componente herdado da classe TEdit (ou TCustomEdit) que implemente a mudança de cor no método DoEnter e DoExit.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Selecionar um item no ListView

Para selecionar um item no ListView via programação use
o código abaixo.

{ Manda o foco para o ListView }
ListView1.SetFocus;

{ Seleciona o quarto item }
ListView1.Items.Item[3].Selected := true;

{ Manda o foco para o quarto item }
ListView1.Items.Item[3].Focused := true;

Observações

Um procedimento semelhante pode ser usado com o TreeView.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Alinhar ao centro e à direita em StringGrid

1. Coloque no formulário um componente TStringGrid.
2. No evento OnCreate do formulário escreva:

procedure TForm1.FormCreate(Sender: TObject);
begin
  { Número de linhas }
  StringGrid1.RowCount := 5;
  { Número de colunas }
  StringGrid1.ColCount := 3;
  { Linhas fixas }
  StringGrid1.FixedRows := 1;
  { Colunas fixas }
  StringGrid1.FixedCols := 0;
  { Largura padrao das colunas (em pontos) }
  StringGrid1.DefaultColWidth := 80;
  { Permite editar }
  StringGrid1.Options :=
    StringGrid1.Options + [goEditing];
  { Cabeçalho }
  StringGrid1.Cells[0,0] := 'Esquerda';
  StringGrid1.Cells[1,0] := 'Centro';
  StringGrid1.Cells[2,0] := 'Direita';
end;

3. No evento OnDrawCell do StringGrid escreva:

var
  LarguraTexto, AlturaTexto, X, Y: integer;
  Texto: string;
begin
  { Pega o texto da célula }
  Texto := StringGrid1.Cells[ACol, ARow];

  { Calcura largura e altura (em pontos) do texto }
  LarguraTexto := StringGrid1.Canvas.TextWidth(Texto);
  AlturaTexto := StringGrid1.Canvas.TextHeight(Texto);

  { Calcula a posição horizontal do início do texto }
  if ACol = 0 then { Esquerda }
    X := Rect.Left + 2
  else if ACol = 1 then { Centro }
    X := Rect.Left + (Rect.Right - Rect.Left) div 2 -
      LarguraTexto div 2
  else { Direita }
    X := Rect.Right - LarguraTexto - 2;

  { Calcula a posição vertical do início do texto para
    que seja impresso no centro (verticalmente) da célula }
  Y := Rect.Top + (Rect.Bottom - Rect.Top) div 2 -
    AlturaTexto div 2;

  { Pinta o texto }
  StringGrid1.Canvas.TextRect(Rect, X, Y, Texto);
end;

Observações

Uma técnica semelhante a esta pode ser usada para pintar figuras nas células do StringGrid.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Copiar o texto do Edit para o Clipboard

O próprio componente TEdit possui um método para copiar o texto 
para a área de transferência (clipboard). No entanto este 
método copia apenas o texto selecionado, de forma que temos
que chamar o método SelectAll() antes de chamar 
CopyToClipboard().

Veja o exemplo:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.SelectAll;
  Edit1.CopyToClipboard;
end;

Observações

Outros componentes, tais como TMemo, possuem também este método.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Mostrar bitmap progressivamente

Inclua na seção uses: Graphics 
Esta é uma boa dica para quem deseja fazer aplicativos para exibir fotografias.

1. Coloque no form um TButton e um PaintBox.
2. No evento OnClick do Button escreva:

procedure TForm1.Button1Click(Sender: TObject);
var
  I, J: integer;
  R: TRect;
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.LoadFromFile('c:\teste\imagem.bmp');

    PaintBox1.ClientWidth := Bmp.Width;
    PaintBox1.ClientHeight := Bmp.Height;
    PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);

    R.Left := 0;
    R.Right := Bmp.Width -1;

    for I := 1 to 10 do begin
      J := I - 1;
      while J < (Bmp.Height -1) do begin
        R.Top := J;
        R.Bottom := J+1;
        PaintBox1.Canvas.CopyRect(R, Bmp.Canvas, R);
        J := J + 10;
      end;
      Sleep(50);
    end;
  finally
    Bmp.Free;
  end;
end;

Observações

Esta dica é só uma idéia inicial, mas com um pouco de criatividade o programador poderá criar outros efeitos mais interessantes.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Converter JPeg para Bitmap

Inclua na seção uses: Graphics, JPeg 
O procedimento abaixo converte um arquivo de imagem JPeg
para Bitmap. O arquivo Bitmap terá o mesmo nome do arquivo JPeg, mas com a extensão bmp.

procedure ConverterJPegParaBmp(Arquivo: string);
var
  JPeg: TJPegImage;
  Bmp: TBitmap;
begin
  JPeg := TJPegImage.Create;
  try
    JPeg.LoadFromFile(Arquivo);
    Bmp := TBitmap.Create;
    try
      Bmp.Assign(JPeg);
      Bmp.SaveToFile(ChangeFileExt(Arquivo, '.bmp'));
    finally
      Bmp.Free;
    end;
  finally
    JPeg.Free;
  end;
end;

Exemplo de uso:
ConverterJPegParaBmp('c:\diretorio\arquivo.jpg');

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Converter Bitmap para JPeg

Inclua na seção uses: Graphics, JPeg 
O procedimento abaixo converte um arquivo de imagem Bitmap
para JPeg. O arquivo JPeg terá o mesmo nome do arquivo Bitmap, 
mas com a extensão jpg.

procedure ConverterBmpParaJPeg(Arquivo: string);
var
  Bmp: TBitmap;
  JPeg: TJPegImage;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.LoadFromFile(Arquivo);
    JPeg := TJPegImage.Create;
    try
      JPeg.CompressionQuality := 100; { Qualidade: 100% }
      JPeg.Assign(Bmp);
      JPeg.SaveToFile(ChangeFileExt(Arquivo, '.jpg'));
    finally
      JPeg.Free;
    end;
  finally
    Bmp.Free;
  end;
end;

Exemplo de uso:

ConverterBmpParaJPeg('c:\diretorio\arquivo.bmp');

Observações

Veja que usei neste exemplo 100% de qualidade para a imagem JPeg. Isto faz com que o arquivo fique grande. Se preferir pode usar uma qualidade inferior, mas lembre-se que a aparência da imagem será prejudicada.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Colocar arquivo como recurso dentro do EXE

Inclua na seção uses: Classes 
Existem alguns casos em que precisamos levar para a máquina
do usuário, além do EXE, alguns arquivos sem os quais nossa 
aplicação teria problema. Normalmente estes casos incluem:

- arquivos com imagem (bmp, jpeg, gif, etc);
- arquivos de fontes (TTF);
- bibliotecas (dll);
- e outros.

A partir desta dica você saberá como incluir tais arquivos 
dentro do próprio EXE. Dentro do EXE podemos colocar qualquer
tipo de arquivo que se comportará como um recurso. Vamos aos
passos.

1. Crie um arquivo texto com o nome ARQ_RECURSO.RC e escreva
   neste arquivo a linha abaixo:

   NOME_DO_RECURSO RCDATA "c:\diretorio\arquivo.ext"

2. Compile este arquivo de recurso com o programa BRCC32.EXE:

   BRCC32 ARQ_RECURSO.RC   

3. Confira se foi criado um arquivo chamado ARQ_RECURSO.RES.
4. Abra um novo projeto no Delphi.
5. Salve o projeto no mesmo diretório de ARQ_RECURSO.RES.
5. Escreve a linha abaixo após a palavra implementation

   {$R ARQ_RECURSO.RES}

6. Escreva o evento OnCreate do form como abaixo:
  
procedure TForm1.FormCreate(Sender: TObject);
var
  Stream: TResourceStream;
begin
  Stream := TResourceStream.Create(hInstance,
    'NOME_DO_RECURSO', RT_RCDATA);
  try
    Stream.SaveToFile('c:\diretorio\arquivo_extraido.ext');
  finally
    Stream.Free;
  end;
end;

Pronto! Muito fácil! Vamos agora entender os passos citados.

Primeiro criamos um script (arquivo .rc) para gerar o arquivo
de recurso (.res). No script informamos o nome do recurso, 
o tipo e o conteúdo. O conteúdo, neste caso, foi o arquivo
"c:\diretorio\arquivo.ext".

Depois compilamos o script com o compilador de recursos da
Borland (BRCC32.EXE). Este processo gerou o arquivo 
ARQ_RECURSO.RES.

A seguir colocamos no código-fonte uma instrução para que
o compilador do Delphi incluísse o arquivo de recurso (.res) no
executável - {$R ARQ_RECURSO.RES}.

No evento OnCreate do form acessamos o recurso como um Stream
e o salvamos em arquivo no disco.

Observações

Para incluir um arquivo de fonte no EXE e instalar a fonte na máquina do usuário na primeira vez que o programa for executado, combine este dica com a dica número 12.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Pintar bitmap no DBGrid

Embora pareça complicada, esta tarefa é muito simples. 
O Delphi nos permite controlar totalmente o desenho de cada 
célula do DBGrid através do evento OnDrawColumnCell. O que 
precisamos fazer neste evento é:

1. Verificar o estado da célula (fixa, selecionada, etc).
2. Verificar se é a coluna do campo da imagem.
3. Criar um objeto bitmap.
4. Copiar o conteúdo do campo da imagem para o bitmap.
5. Desenhar o bitmap na célula do DBGrid.
6. Destruir o bitmap.

Agora que já conhecemos os passos, vamos ao exemplo:

1. Coloque um TTable e ligue ao Alias DBDEMOS e à tabela 
   animals.dbf.
2. Coloque um TDataSource e ligue-o ao Table1.
3. Coloque um DBGrid e ligue-o ao DataSource1.
3. Mude Table1.Active para true.
4. No evento OnDrawColumnCell escreva o código abaixo:

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; 
  const Rect: TRect; DataCol: Integer; Column: TColumn; 
  State: TGridDrawState);
var
  Bmp: TBitmap;
begin
  if (not (gdFixed in State)) and
     (UpperCase(Column.FieldName) = 'BMP') then
  begin
    Bmp := TBitmap.Create;
    try
      Bmp.Assign(Table1.FieldByName('Bmp'));
      DBGrid1.Canvas.StretchDraw(Rect, Bmp);
    finally
      Bmp.Free;
    end;
  end;
end;

Conforme eu disse no início, é muito simples!

Observações

Neste exemplo usei o mínimo possível de código. Para obtermos um visual melhor poderíamos, por exemplo, deixar uma margem em torno da imagem. Não é difícil, mas vou deixar como desafio aos interessados.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Pintar um Bitmap diretamente no Canvas do Form

- Declare a variavel Bmp na seção private:

private
  Bmp: TBitmap;

- Coloque um botão no Form e no evento OnClick digite:

   Bmp:= TBitMap.Create;
   try
     Bmp.LoadFromFile('c:\teste\arquivo.bmp');
     Canvas.Draw(0,0, Bmp);
   finally
     Bmp.Free;
   end;

Pronto! Irá aparecer a imagem no Canvas. É útil para fazer 
animações.

Dica enviada por: Alisson Viana Jardim
Revisada por: Daniel Pereira Guimarães

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Mostrar o nome do EXE no caption do form

{ Esta função extrai apenas o nome do arquivo passado,
  sem path e extensão }

function Titulo(Nome: String): String;
var
  N, D: String;
begin
  N := ExtractFileName(Nome); { Retira o path }
  D := ChangeFileExt(N,''); { Retira a extensão }
  
  { Coloca a primeira letra em maiúscula e o resto
    em minúscula }
  Titulo := UpperCase(Copy(D,1,1)) + 
    LowerCase(Copy(D,2,Length(D)-1));
end;

{ No OnCreate do form, coloque: }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := Titulo(ParamStr(0));
end;

- Dica enviada por: Luiz Eduardo.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Obter tipo de uma propriedade

Inclua na seção uses: TypInfo 
{ Esta função retorna uma string com o nome do tipo de dado
  de uma propriedade. Exemplos de retornos:
  
  PropType(Button1, 'Caption'); // Retorna 'TCaption'
  PropType(Edit1, 'Width'); // Retorna 'Integer';
  PropType(Edit1, 'Color'); // Retorna 'TColor';
}

function PropType(const Obj: TObject; const PropName: string): string;
var
  Info: PPropInfo;
begin
  Info := GetPropInfo(Obj.ClassInfo, PropName);
  if Assigned(Info) then
    Result := Info^.PropType^.Name
  else
    Result := '';
end;

{ Exemplo de uso:
 - Coloque um TButton e um TEdit;
 - No OnClick do Button1 coloque o código abaixo;
 - Execute, digite 'Caption' no Edit1 e clique em Button1.
}

procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowMessage(PropType(Button1, Edit1.Text));
end;

Observações

Verdadeiramente não sei exatamente onde poderíamos aplicar esta dica, mas divulguei-a porque achei interessante. Acredito que o Object Inspector use algo parecido.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Pintar uma imagem JPG no form

Inclua na seção uses: Graphics, JPeg 
Problema:

Gostaria de pintar imagens de arquivos JPG (JPeg) nos forms 
de minha aplicação. Isto é possível? Como?

Solução:

Para trabalhar com arquivos JPG você precisa usar um objeto
TPicture, assim como colocar no uses a unit JPeg. Siga os
passos abaixo para pintar uma imagem JPG no form:

- No evento OnPaint do form coloque o código abaixo:

procedure TForm1.FormPaint(Sender: TObject);
var
  Imagem: TPicture;
begin
  Imagem := TPicture.Create;
  try
    Imagem.LoadFromFile('c:\teste\foto.jpg');
    Canvas.StretchDraw(ClientRect, Imagem.Graphic);
  finally
    Imagem.Free;
  end;
end;

- E no evento OnResize do form, coloque:

procedure TForm1.FormResize(Sender: TObject);
begin
  Repaint;
end;

Observações

Não se esqueça de trocar o nome do arquivo JPG conforme sua necessidade. Este exemplo foi elaborado usando Delphi4.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Executar comando do MS-DOS

Usando WinExec você pode executar qualquer comando do DOS. 
Para isto chame o COMMAND.COM passando como parâmetro a linha 
de comando a ser executada. O parâmetro /C é opcional e faz 
com que a janela do DOS seja fechada assim que o comando 
terminar. No exemplo abaixo estou executando a seguinte 
linha de comando: DIR C:\*.*

WinExec('COMMAND.COM /C DIR C:\*.*', SW_SHOW);

Observações

Para que a janela do DOS não seja exibida, use SW_HIDE no lugar de SW_SHOW.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Formatar CEP

{ Esta função forma CEP como: 99.999-999 }
function tbFormataCEP(const CEP: string): string;
var
  I: integer;
begin
  Result := '';
  for I := 1 to Length(CEP) do
    if CEP[I] in ['0'..'9'] then
      Result := Result + CEP[I];
  if Length(Result) <> 8 then
    raise Exception.Create('CEP inválido.')
  else
    Result :=
      Copy(Result, 1, 2) + '.' +
      Copy(Result, 3, 3) + '-' +
      Copy(Result, 6, 3);
end;

=== Para testar ===

- Coloque um Edit e um Button no form;
- No evento OnClick do Button coloque a instrução abaixo:

  Edit1.Text := tbFormataCEP(Edit1.Text);

Observações

Para formatar outros códigos como CPF, CGC, etc., pode-se usar a mesma idéia.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Permitir cancelar processo demorado

Problema:

Em determinadas partes no programa existem processos que podem
demorar vários minutos para serem concluídos. Muitas vezes o
usuário desiste e deseja cancelar o processamento. Como 
permitir este cancelamento?

Solução:

Em aplicativos para Windows é comum, em processamentos 
demorados, o programa mostrar uma janela de diálogo avisando
que o processo pode levar um tempo extra. Nesta mesma janela 
normalmente coloca-se também um botão "Cancelar" que dá ao
usuário a opção aguardar ou desistir do processo. Para fazer 
isto em um aplicativo Delphi, siga os passos abaixo:

- Vamos considerar em nosso exemplo que o processamento ocorre
  na unit do Form1.

- Declare, na seção public do Form1, uma variável boolean. 

  public;
    Cancelar: boolean;

- Crie um novo form (vou chamá-lo de Form2);
- Coloque um botão neste novo form. Programe o OnClick deste
  botão conforme abaixo:

  Form1.Cancelar := true;

- Na parte onde ocorre o loop do processamento demorado
  coloque algo como:

  try
    { Antes de começar o processamento }
    Form2.Caption := 'Processamento demorado...';
    Form2.Show;

    { No início do loop "Cancelar" precisa ser false }
    Cancelar := false;

    { Aqui inicia o loop do processamento demorado }
    while {...} do begin

      { ... Processa algo aqui... }

      { Permite que o programa processe mensagens do Windows }
      Application.ProcessMessages;

      { Se a variável "Cancelar" foi alterada para true... }
      if Cancelar then begin
        ShowMessage('Operação cancelada pelo usuário.');
        Break; { Sai do loop }
      end;

    end;

  finally
    Form2.Close;
  end;

Observações

Não se esqueça de que o Form1 precisa usar Form2 e vice-versa.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Descobrir se uma data é fim do mês

Inclua na seção uses: SysUtils 
{ Esta função retorna true se a data passada como parâmetro
  é fim de mês. Retorna false caso contrário. } 

function tbFimDoMes(const Data: TDateTime): boolean;
var
  Ano, Mes, Dia: Word;
begin
  DecodeDate(Data +1, Ano, Mes, Dia);
  Result := Dia = 1;
end;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Obter o tipo de dado de um valor no Registro do Windows

Inclua na seção uses: Registry, Dialogs 
{
  - Coloque um botão no form;
  - Altere o evento OnClick do botão conforme abaixo:
}

procedure TForm1.Button1Click(Sender: TObject);
const
  cRegPath = 'System\CurrentControlSet\control\FileSystem';
  cRegValue = 'ACDriveSpinDown';
var
  Reg: TRegistry;
  S: string;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey(cRegPath, false) then begin
      case Reg.GetDataType(cRegValue) of
        rdUnknown: S := 'Tipo Desconhecido';
        rdString:  S := 'String';
        rdExpandString: S := 'ExpandString';
        rdInteger: S := 'Inteiro';
        rdBinary:  S := 'Binário';
      end;

      ShowMessage(S);

    end else
      ShowMessage('Erro ao abrir chave do Registro');
  finally
    Reg.Free;
  end;
end;

Observações

A unit Dialogs foi acrescentada no uses somente para podermos usar a procedure ShowMessage.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Obter a célula de um StringGrid que está sob o cursor do mouse

Inclua na seção uses: Windows 
{ Esta procedure pega a linha e coluna da célula onde estiver
  o mouse. Valores negativos para Linha ou Coluna indicam que
  o mouse está fora da área cliente do StringGrid }

procedure MouseCell(Grid: TStringGrid; 
  var Coluna, Linha: integer);
var
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  Pt := Grid.ScreenToClient(Pt);
  if PtInRect(Grid.ClientRect, Pt) then
    Grid.MouseToCell(Pt.X, Pt.Y, Coluna, Linha)
  else begin
    Coluna := -1;
    Linha := -1;
  end;
end;

{ Exemplo de uso:
  - Coloque um botão no form;
  - Altere o evento OnClick deste botão como abaixo:
}

procedure TForm1.Button1Click(Sender: TObject);
var
  Coluna, Linha: integer;
begin
  MouseCell(StringGrid1, Coluna, Linha);
  if (Coluna >= 0) and (Linha >= 0) then
    Caption := 'Coluna: ' + IntToStr(Coluna) + ' - ' +
               'Linha: ' + IntToStr(Linha);
  else
    Caption := 'O mouse não está no StringGrid';
end;

{ Para testar: 
  - Execute o programa;
  - Posicione o cursor do mouse sobre alguma célula do 
    StringGrid;
  - Pressione TAB até chegar ao botão e pressione ENTER;
  - O resultado será mostrado no Caption do form;
}

Observações

Note que a procedure MouseCell usa um valor negativo (-1) para coluna e linha se o mouse não estiver sobre o StringGrid.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Limpar todas as células de um StringGrid

Existem três métodos que podemos aplicar para limpar 
um StringGrid.

{ Limpando uma célula de cada vez: }

procedure TForm1.Button1Click(Sender: TObject);
var
  I, J: integer;
begin
  with StringGrid1 do
    for I := 0 to ColCount -1 do
      for J := 0 to RowCount -1 do
        Cells[I,J] := '';
end;

{ Limpando uma linha de cada vez: }

procedure TForm1.Button2Click(Sender: TObject);
var
  I: integer;
begin
  with StringGrid1 do
    for I := 0 to RowCount -1 do
      Rows[I].Clear;
end;

{ Limpando uma coluna de cada vez: }

procedure TForm1.Button3Click(Sender: TObject);
var
  I: integer;
begin
  with StringGrid1 do
    for I := 0 to ColCount -1 do
      Cols[I].Clear;
end;

Observações

Em todos os exemplos estamos limpando o StringGrid completamente, inclusive linhas e colunas fixas. Para preservar linhas ou colunas fixas troque os valores iniciais de I ou J conforme a necessidade.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Programar meu aplicativo para abrir arquivos a partir do Windows Explorer

Inclua na seção uses: Registry 
Problema:

Criei um editor de textos no Delphi. Agora gostaria que o 
Windows Explorer usasse este editor para abrir arquivos com
a extensão .dpg e .dan. Como fazer?

Solução:

Para fazer isto será necessária a criação de algumas chaves no
Registro do Windows. O exemplo abaixo cria todas as chaves
necessárias.

- Coloque um TButton e no evento OnClick dele coloque o
  código abaixo:

procedure TForm1.Button1Click(Sender: TObject);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CLASSES_ROOT;
    Reg.LazyWrite := false;

    { Define o nome interno (ArquivoDaniel) e uma legenda
      que aparecerá no Windows Explorer (Arquivo do Daniel) }
    Reg.OpenKey('ArquivoDaniel', true);
    Reg.WriteString('', 'Arquivo do Daniel');
    Reg.CloseKey;

    { Define o comando a ser executado quando abrir um
      arquivo pelo Windows Explorer (NomeDoExe %1). O símbolo
      %1 indica que o arquivo a ser aberto será passado como
      primeiro parâmetro para o aplicativo - ParamStr(1). }
    Reg.OpenKey('ArquivoDaniel\shell\open\command', true);
    Reg.WriteString('', ParamStr(0) + ' %1'); { NomeDoExe %1 }
    Reg.CloseKey;

    { Define o ícone a ser usado no Windows Explorer:
      0 - primeiro ícone do EXE
      1 - segundo ícone do EXE, etc }
    Reg.OpenKey('ArquivoDaniel\DefaultIcon', true);
    Reg.WriteString('', ParamStr(0) + ',0'); { 0 = primeiro ícone }
    Reg.CloseKey;

    { Define as extensões de arquivos que serão abertos pelo
      meu aplicativo }

    { *.dpg }
    Reg.OpenKey('.dpg', true);
    Reg.WriteString('', 'ArquivoDaniel');
    Reg.CloseKey;

    { *.dan }
    Reg.OpenKey('.dan', true);
    Reg.WriteString('', 'ArquivoDaniel');
    Reg.CloseKey;
  finally
    Reg.Free;
  end;
end;

- Coloque um TMemo;
- No evento OnShow do Form coloque o código abaixo:

procedure TForm1.FormShow(Sender: TObject);
begin
  { Se o primeiro parâmetro for um nome de arquivo existente... }
  if FileExists(ParamStr(1)) then
    { Carrega o conteúdo do arquivo no memo }
    Memo1.Lines.LoadFromFile(ParamStr(1));
end;

*** Para testar ***
- Execute este programa;
- Clique no botão para criar as chaves no Registro do Windows;
- Feche o programa;
- Crie alguns arquivos com as extensões .dpg e .dan;
- Vá ao Windows Explorer e procure pelos arquivos criados;
- Experimente dar um duplo-clique sobre qualquer dos arquivos
  com uma das extensões acima.

Observações

Existem outros recursos que poderão ser configurados. Porém, para começar, este já é um bom exemplo.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Ocultar aplicação da lista de tarefas - CTRL+ALT+DEL

- Declare a função abaixo antes da palavra implementation:

function RegisterServiceProcess(dwProcessID, dwType: Integer): 
  Integer; stdcall; external 'KERNEL32.DLL';

- Coloque dois botões no Form;
- No evento OnClick do Button1 coloque:

RegisterServiceProcess(GetCurrentProcessID, 1);

- No evento OnClick do Button2 coloque:

RegisterServiceProcess(GetCurrentProcessID, 0);

=== Para testar ===

Clique no Button1 e pressione CTRL+ALT+DEL. O seu programa
não aparecerá na lista.

Clique no Button2 e pressione CTRL+ALT+DEL. Agora seu programa
aparecerá na lista.

Autor: Luiz Carlos Manzolli

Início

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

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Mostrar mensagem mesmo que esteja no Prompt do DOS

Inclua na seção uses: Windows 
Problema:

Fiz um programa que mostra mensagens de lembrete quando é 
chegada determinada data/hora. Porém quando o usuário vai 
para o Prompt do MS-DOS em modo tela cheia, a mensagem 
não aparece. O que devo fazer?

Solução:

Antes de mostrar a mensagem, coloque sua aplicação na frente 
das demais.

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

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Ocultar o aplicativo do CTRL+ALT+DEL

Inclua no implementation de seu programa a seguinte linha:

function RegisterServiceProcess(dwProcessID, dwType: Integer):
 Integer; stdcall; external 'KERNEL32.DLL';

e depois no OnCreate ponha a seguinte linha:

RegisterServiceProcess(GetCurrentProcessID, 1);

Isso vai fazer o programa nao aparecer no CTRL+ALT+DEL,
mas seu form principal vai continuar aparecendo. Para ocultar
também o form, basta por no OnCreate antes da linha acima
a seguinte linha:

Application.ShowMainForm:=False;

Resposta enviada por: dexter07

Observações

Segundo o autor desta resposta, esta solução foi testada em Win95, mas também deve funcionar em Win98. Não sabe se funciona em NT.

Início

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

Problema:

Quando ocorre uma exceção no Delphi, ele automaticamente
exibe uma mensagem de erro. Gostaria de poder personalizar
estas mensagens, acrescentando, por exemplo, o e-mail do 
suporte técnico. Isto é possível?

Solução:

Sim. Siga os passos abaixo:

- 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 +
             'suporte@servidor.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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Implementar procedure Delay do Pascal no Delphi

Inclua na seção uses: Windows, Forms 
Problema: 

O Pascal para DOS possui uma procedure chamada Delay que
serve para pausar o processamento atual em "n" milésimos 
de segundo. Como implemento isto no Delphi?

Solução:

Simles. Veja:

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).

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Criar uma DLL de Bitmaps e usá-la

Problema:

Gostaria de colocar algums bitmaps em uma DLL e usá-los em
tempo de execução. É possível fazer isto em Delphi?

Solução:

Sim. 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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Converter de Hexadecimal para Inteiro

Inclua na seção uses: SysUtils 
Problema:

A função IntToHex do Delphi converte inteiro para 
hexadecimal. O que preciso, no entanto, é fazer o contrário,
ou seja, converter de hexadecimal para inteiro. Existe
isto pronto no Delphi ou terei que escrever uma função
para isto?

Solução:

A função StrToInt pode receber uma string no formato de um
número decimal ou hexadecimal. Então podemos usá-la assim:

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

Observações

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

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Colocar uma ProgressBar na 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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Adicionar o evento OnClick do DBGrid

Problema:

Meu programa precisa processar algo quando o usuário clicar
no DBGrid em um determinado form. O problema é que o DBGrid não
possui o evento OnClick. É possível adicionar este evento no 
DBGrid?

Solução:

É possível sim. Afinal é muito simples. Siga os passos abaixo
para resolver seu problema:

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

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Mostrar uma mensagem durante um processamento

Problema:

Um processamento em meu sistema é bastante demorado e por isto
colocar apenas o cursor de ampulheta continua deixando o 
usuário confuso, pensando que o sistema travou. É possível
exibir uma mensagem enquanto um processamento demorado ocorre?

Sim. E é fácil. Vejamos:

- Crie um form com a mensagem. Um pequeno form com um 
  Label já é suficiente. Aqui vou chamá-lo de FormMsg.
- Vá em Project|Options e passe o FormMsg de 
  "Auto-create forms" para "Available forms".
- Abaixo vou simular um processamento demorado, usando a
  API Sleep:

procedure TForm1.Button1Click(Sender: TObject);
var
  Form: TFormMsg;
  I: integer;
begin
  Form := TFormMsg.Create(Self);
  try
    Form.Label1.Caption := 'Processamento demorado...';
    Form.Show;
    for I := 1 to 5 do begin
      Form.UpDate;
      Sleep(1000); { Aguarda um segundo }
    end;
  finally
    Form.Free;
  end;
end;

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Vejamos:

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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

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!

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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

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.');

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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

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;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Obter a linha e coluna atual em um TMemo

{ === SOLUÇÃO 1 === }

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

{ === SOLUÇÃO 2 === }

var
  Lin, Col: integer;
begin
  Lin := Memo1.CaretPos.y;
  Col := Memo1.CaretPos.x;
  {...}
end;

- A segunda solução foi apresentada por:
  Vanderley Pereira Rocha

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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

Inclua na seção uses: Windows 
{ Problema:

  Gostaria que um determinado programa (Prog1.EXE) fosse 
  executado apenas através de outro programa (Prog2.EXE).

  Solução:

  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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Truncar valores reais para 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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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

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

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Onde encontrar tutoriais sobre construção de componentes em Delphi

Pegue apostila no download.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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!).

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.tecnobyte.com.br

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.tecnobyte.com.br. O resto é usar as APIs do Windows para manipulação de Janelas.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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(...)).

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.');

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

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.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início

Página atualizada em 01 de maio de 2007
Todos os direitos reservados
www.tecnobyte.com.br