Chamando o MSDOS e criando um rotina

No caso vc poderia
Mudar o controle automaticamente:

talvez assim:

a) Coloque 02 edit na form

b) No evento OnChange do Edit1 digite:

with sender as TEdit do

begin

If Length(text)=MaxLength then

SelectNext(ActiveControl, true, true);

end;

c) Na propriedade MaxLength do Edit1 coloque a quantidade de caracteres desejado

obs: Se colocou 5 caracteres, depois do quinto caracter digitado o foco será desviado

automaticamente para Edit2.

e depois poderia validar :


Try

StrToDate(Edit1.Text);

Except

on EConvertError do

ShowMessage (´Data Inválida!´);



No caso poderia chamar uma cx de dialogo:

Chamando a Caixa DialUp:

winexec(PChar(´rundll32.exe rnaui.dll,RnaDial ´+Edit1.Text),sw_show);

Para chamar o exe que rece este dados que vc quer


Mais...


E-mail com domínio próprio
Tenha um e-mail personalizado com domínio próprio e passe uma imagem mais profissional. Inclui registro de domínio em seu nome e Site temático em Flash (mais de 120 modelos).
Confira!



[Fechar]


undefined
[Fechar]


undefined

Dicas de Delphi

Página Principal C++Buider Linux


001 - Ativar a proteção de tela do Windows
002 - Desligar/Ligar monitor
003 - Abrir e fechar o drive de CD-ROM
004 - Impedir que o form seja arrastado para fora das margens da tela
005 - Mostrar mensagem mesmo que esteja no Prompt do DOS
006 - Copiar todos os registros de uma tabela para o Clipboard
007 - Copiar um registro de uma tabela para o Clipboard
008 - Criar sub-diretório no diretório do EXE
009 - Hablitar e Desabilitar CTRL+ALT+DEL
010 - Personalizar a caixa de mensagem de exceções (erro) do Delphi
011 - Implementar procedure Delay do Pascal no Delphi
012 - Enviar comandos de rolagem vertical para um TMemo
013 - Criar uma DLL de Bitmaps e usá-la
014 - Como extrair o icone de um excutável
015 - Criar form sem título que possa ser arrastado
016 - Obter status da memória do sistema
017 - Definir data/hora de um arquivo
018 - Mostrar o diálogo About (Sobre) do Windows
019 - Ocultar/exibir o cursor do mouse
020 - Converter de Hexadecimal para Inteiro
021 - Mudar a cor de um DBEdit dentro de um DBCtrlGrid de acordo com uma condição
022 - Colocar uma ProgressBar da StatusBar
023 - Executar um programa e aguardar sua finalização antes de continuar
024 - Simular o pressionamento de uma combinação de teclas (ex: Ctrl+F2)
025 - Simular o pressionamento de uma tecla
026 - Ligar/desligar a tecla Caps Lock
027 - Verificar se uma determinada tecla está pressionada
028 - Verificar o estado de NumLock e CapsLock
029 - Configurar linhas de diferentes alturas em StringGrid
030 - Adicionar o evento OnClick do DBGrid
031 - Criar caixas de diálogo em tempo de execução
032 - Converter a primeira letra de um Edit para maiúsculo
033 - Verificar se uma string contém uma hora válida
034 - Verificar se uma string contém um valor numérico válido
035 - Mostrar uma mensagem durante um processamento
036 - Mostrar um cursor de ampulheta durante um processamento
037 - Ler e escrever dados binários no Registro do Windows
038 - Mudar a resolução do vídeo via programação
039 - Ler e escrever dados no Registro do Windows
040 - Adicionar barra de rolagem horizontal no ListBox
041 - Simular um CharCase no DBGrid
042 - Verificar se uma string é uma data válida
043 - Fazer pesquisa incremental
044 - Adicionar zeros à esquerda de um número
045 - Limpar um campo tipo data via programação
046 - Implementar um campo auto-incremental via programação
047 - Obter o endereço IP do Dial-Up
048 - Exibir a caixa de diálogo padrão de solicitação de senha do banco de dados
049 - Obter a versão da biblioteca ComCtl32.DLL (usada na unit ComCtrls do Delphi)
050 - Implementar rotinas assembly em Pascal
051 - Exibir o diálogo About do Windows
052 - Obter a linha e coluna atual em um TMemo
053 - Exibir um arquivo de ajuda do Windows
054 - Obter o valor de uma variável de ambiente
055 - Determinar se uma janela (form) está maximizada
056 - Determinar se o cursor do mouse está em determinado controle
057 - Determinar se o aplicativo está minimizado
058 - Fechar um aplicativo com uma mensagem de erro fatal
059 - Usar o evento OnGetText de um TField
060 - Maximizar um form de forma que cubra toda a tela, inclusive a barra de tarefas
061 - Verificar, via programação, se Local Share do BDE está TRUE
062 - Criar um EXE que seja executado apenas através de outro EXE criado por mim
063 - Multiplas seleções em um DBGrid
064 - Inverter os botões do mouse
065 - Obter/definir o tempo máximo do duplo-click do mouse
066 - Obter os atributos de um arquivo/diretório
067 - Obter o espaço total e livre de um disco
068 - Obter o tipo de um drive (removível, fixo, CD-ROM, unidade de rede, etc)
069 - Obter informações de um volume/disco (label, serial, sistema de arquivos, etc)
070 - Alterar o nome de volume (Label) de um disco
071 - Saber quais as unidades de disco (drives) estão presentes
072 - ´truncar´ valores reais para apenas n casas decimais
073 - Excluir todos os registros de uma tabela (como DELETE ALL do Clipper)
074 - Saber se o sistema está usando 4 dígitos para o ano
075 - Imprimir caracteres acentuados diretamente para a impressora
076 - Imprimir texto justificado com formatação na impressora Epson LX-300
077 - Formatar um disquete através de um programa Delphi
078 - executar um arquivo com extensão *.LNK
079 - Reproduzir um arquivo de som WAV sem o TMediaPlayer
080 - Obter o nome do usuário e da empresa informado durante a instalação do Windows
081 - Mostrar uma barra de progresso enquanto copia arquivos
082 - Copiar arquivos usando o Shell do Windows
083 - Descobrir o código ASCII de uma tecla
084 - Evitar que seu programa apareça na barra de tarefas
085 - Usar eventos de som do Windows
086 - Mudar a coluna ativa em um DBGrid via programação
087 - Fechar o Windows a partir do seu programa
088 - Carregar um cursor animado (.ani)
089 - Enviar um arquivo para a lixeira
090 - Obter o número do registro atual
091 - Trabalhar com Filter de forma mais prática
092 - Reproduzir um arquivo WAV
093 - Executar um programa DOS e fechá-lo em seguida
094 - Fechar um programa a partir de um programa Delphi
095 - Colocar Hint´s de várias linhas
096 - Reproduzir um vídeo AVI em um Form
097 - Separar (filtrar) caracteres de uma string
098 - Colocar zeros à esquerda de números
099 - Copiar arquivos usando curingas (*.*)
100 - Copiar arquivos
101 - Trabalhar com cores no formato string
102 - Verificar se determinado programa está em execução (Word, Delphi, etc)
103 - Excluir arquivos usando curingas (*.*)
104 - Gerar uma tabela no Word através do Delphi
105 - Obter a quantidade de registros total e visível de uma tabela
106 - Evitar que um programa seja executado mais de uma vez
107 - Executar um ´COMMIT´ no Delphi
108 - Posicionar Form´s em relação ao Desktop do Windows
109 - Saber a resolução de tela atual
110 - Verificar se uma unidade de disco (disk-drive) está preparada
111 - Salvar/restaurar o tamanho e posição de Form´s
112 - Definir a quantidade de registros a ser impressa em uma página do QuickReport
113 - Colocando um BitMap no Form
114 - Para que servem OnGetEditMask, OnGetEditText e OnSetEditText do TStringGrid
115 - Mostrar um Form de LogOn antes do Form principal
116 - Limitar a região de movimentação do mouse
117 - Descobrir o nome de classe de uma janela do Windows
118 - Ocultar/exibir a barra de tarefas do Windows
119 - Evitar a proteção de tela durante seu programa
120 - Fazer a barra de título ficar intermitente (piscante)
121 - Posicionar o cursor do mouse em um controle
122 - Criar cores personalizadas (sistema RGB)
123 - Adicionar uma nova fonte no Windows
124 - Saber se a impressora atual possui determinada fonte
125 - Saber se determinada Font está instalada no Windows
126 - Acertar a data e hora do sistema através do programa
127 - ENTER em vez de TAB no formulário, no DBGrid e no StringGrid
128 - Simular a vírgula através do ponto do teclado numérico
129 - Paralizar um programa durante n segundos
130 - Criar uma tabela (DB, DBF) através do seu programa
131 - Verificar se um diretório existe
132 - Verificar se um arquivo existe
133 - Criar um Alias temporário através do seu programa
134 - Criar um Alias através do seu programa


--------------------------------------------------------------------------------



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

Inclua na seção uses: MMSystem

{ 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 fform 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 = #1310; { Quebra de linha }
SeparadorRegistro = ´===========´ + 1310;
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 = #1310; { 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 foorm:

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 implemeente este método,
conforme o exemplo:

procedure TForm1.ManipulaExcecoes(Sender: TObject; E: Exception);
begin
MessageDlg(E.Message + #1313 +
´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 oo 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) conttendo 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.dppr;
- 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á criaddo o
arquivo DLLBmp.DLL.
- Feche o projeto atual e crie um novo prrojeto;
- Salve-o na mesma pasta que salvou o antterior,
mas com outro nome qualquer;
- Coloque no form um Edit e um Button;
- No evento OnClick do Button coloque o ccó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 piintado 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 Form11:
BorderStyle = bsNone, FormStyle = fsStayOnTop,
- Coloque um Label;
- Coloque um Timer;
- Altere o evento OnTimer do Timer1 confoorme 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 seuu 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 OnPainntPanel 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 (proopriedade Panels).

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

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

- No evento OnDrawPanel da StatusBar digiite 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 reesultado.
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 ppara true.
- Escreva no evento OnKeyDown do form commo 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 unitt e declare a procedure abaixo:

private
procedure DBGridClick(Sender: TObject);

- Logo após a palavra ´implementatioon´, 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 FormMsgg de
´Auto-create forms´ para ´Available forms´.
- Abaixo vou simular um processamento demmorado, 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 é amppulheta)
- 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 connforme 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 connforme 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 conforrme 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

Acho que ficou um pouco incompleto.