Chamando o MSDOS e criando um rotina

24/08/2004

0

Pessoal :)

Quem pode me ajudar? :o

No evento onCreate ou onActive ou onShow de meu FrmPrincipal preciso chamar um EXE ou um BAT do MSDOS até ai tudo bem -> por exemplo:

OnShow

var pi: TProcessInformation;
si: TStartupInfo;
begin
FillMemory( @si, sizeof( si ), 0 );
si.cb := sizeof( si );CreateProcess(Nil,´J:\Fontes Especiais\Filtaqry\LIMPCOD.bat´,Nil, Nil,False,NORMAL_PRIORITY_CLASS, Nil, Nil,si, pi );
CloseHandle( pi.hProcess );
CloseHandle( pi.hThread );
end;

após chamar este EXE preciso de uma rotina que efetue a digitação das teclas ´123456´ ou ´abcdef´ via um arquivo de lote tipo um BAT ou de uma outra forma preciso chamar estas teclas.

É possível fazer isso ?? ??? ::)

grato 8)

drozinski


Paulo Drozinski

Paulo Drozinski

Responder

Posts

25/08/2004

Ursula

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


Responder

25/08/2004

Persist

Acho que ficou um pouco incompleto.


Responder

Que tal ter acesso a um e-book gratuito que vai te ajudar muito nesse momento decisivo?

Ver ebook

Recomendado pra quem ainda não iniciou o estudos.

Eu quero
Ver ebook

Recomendado para quem está passando por dificuldades nessa etapa inicial

Eu quero

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar