- Declare a variavel Bmp na seção private:
private
Bmp: TBitmap;
- Coloque um botão no Form e no evento OnClick digite:
Bmp:= TBitMap.Create;
try
Bmp.LoadFromFile('c:\teste\arquivo.bmp');
Canvas.Draw(0,0, Bmp);
finally
Bmp.Free;
end;
Pronto! Irá aparecer a imagem no Canvas. É útil para fazer
animações.
Dica enviada por: Alisson Viana Jardim
Revisada por: Daniel Pereira Guimarães
Problema:
Faço impressão direta para a porta da impressora e gostaria
testar se a impressora está pronta antes de enviar o
relatório. Isto é possível em Delphi?
Solução:
Usando instruções Assembly podemos fazer isto. A função
abaixo retorna true se a porta informada está pronta.
Os possíveis parâmetros para esta função são:
1 - para LPT1
2 - para LPT2
3 - para LPT3
4 - para LPT4
function tbTestLPT(Port: byte): boolean;
var
Pto : Word;
Rdo : byte;
begin
Pto := Port -1;
asm
MOV DX,Pto
MOV AX,$0200 {AH := $02 : Leer el estado de la impresora}
INT $17
MOV Rdo,AH {Guarda el estado en AL}
end;
Result := Rdo = 144;
end;
Provavelmente esta função não funcionará em Windows NT devido ao acesso em baixo nível.
Inclua na seção uses: Windows
Problema:
Como saber em qual unidade de disco (drive) o Windows está
instalado?
Solução:
Esta função retorna a letra do drive onde está instalado o
Windows:
function GetWindowsDrive: Char;
var
S: string;
begin
SetLength(S, MAX_PATH);
if GetWindowsDirectory(PChar(S), MAX_PATH) > 0 then
Result := string(S)[1]
else
Result := #0;
end;
{ Exemplo de uso: }
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := GetWindowsDrive;
end;
{ Esta função extrai apenas o nome do arquivo passado,
sem path e extensão }
function Titulo(Nome: String): String;
var
N, D: String;
begin
N := ExtractFileName(Nome); { Retira o path }
D := ChangeFileExt(N,''); { Retira a extensão }
{ Coloca a primeira letra em maiúscula e o resto
em minúscula }
Titulo := UpperCase(Copy(D,1,1)) +
LowerCase(Copy(D,2,Length(D)-1));
end;
{ No OnCreate do form, coloque: }
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := Titulo(ParamStr(0));
end;
- Dica enviada por: Luiz Eduardo.
Problema: Gostaria de fazer um formulário de pesquisa que, ao digitar algo sobre o DBGrid, o registro correspondendo fosse localizado. Solução: - Coloque no form: TTable, TDataSource, TDBGrid e TLabel. - Ajuste as propriedades do Table1: DatabaseName =TableName = Active = true - Ajuste as propriedades do DataSource1: DataSet = Table1 - Ajuste as propriedades do DBGrid1: DataSource = DataSource1 Options -> dgEditing = false ReadOnly = true * Pode também ajustar a propriedades Columns para escolher as colunas que serão exibidas. - Na seção private da unit declare: private FTexto: string; - No evento OnCreate do form coloque: FTexto := ''; Label1.Caption := ''; - No evento OnKeyPress do DBGrid1: procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char); begin if Key in [#8, #32..#255] then begin if Key = #8 then { BackSpace } FTexto := Copy(FTexto, 1, Length(FTexto)-1) else FTexto := FTexto + Key; { Posiciona na coluna Nome } Table1.FieldByName('Nome').FocusControl; { Escolhe o índice e procura } Table1.IndexFieldNames := 'Nome'; Table1.FindNearest([FTexto]); { Mostra o texto procurado } Label1.Caption := FTexto; end; end;
No nosso exemplo estamos pesquisando através do campo "Nome". Para esta pesquisa precisamos de um índice com este campo.
Inclua na seção uses: TypInfo
{ Esta função retorna uma string com o nome do tipo de dado
de uma propriedade. Exemplos de retornos:
PropType(Button1, 'Caption'); // Retorna 'TCaption'
PropType(Edit1, 'Width'); // Retorna 'Integer';
PropType(Edit1, 'Color'); // Retorna 'TColor';
}
function PropType(const Obj: TObject; const PropName: string): string;
var
Info: PPropInfo;
begin
Info := GetPropInfo(Obj.ClassInfo, PropName);
if Assigned(Info) then
Result := Info^.PropType^.Name
else
Result := '';
end;
{ Exemplo de uso:
- Coloque um TButton e um TEdit;
- No OnClick do Button1 coloque o código abaixo;
- Execute, digite 'Caption' no Edit1 e clique em Button1.
}
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage(PropType(Button1, Edit1.Text));
end;
Verdadeiramente não sei exatamente onde poderíamos aplicar esta dica, mas divulguei-a porque achei interessante. Acredito que o Object Inspector use algo parecido.
Problema:
Preciso fazer uma consulta com SQL que me retorne todos
os registros em que o valor de um campo do tipo data seja
igual ou anterior à dada do sistema. Como fazer?
Solução:
Query.Close;
Query.SQL.Text := 'select * from Tabela where CampoData <= :Hoje';
Query.ParamByName('Hoje').AsDate := Date;
Query.Open;
Este exemplo foi testado com tabelas Paradox, mas deve funcionar na maioria dos bancos de dados com pouca ou nenhuma alteração.
Inclua na seção uses: Windows
{ A função abaixo abre a caixa de diálogo de conecção
com a rede Dial-Up. O parâmetro "name" é o nome da
conecção previamente configurada.
}
procedure DialUpConnect(const Name: string);
begin
WinExec(PChar('rundll32.exe rnaui.dll,RnaDial ' + Name), SW_SHOW);
end;
{ Exemplo de uso: }
procedure TForm1.Button1Click(Sender: TObject);
begin
DialUpConnect('NomeDaConecção');
end;
Inclua na seção uses: Graphics, JPeg
Problema:
Gostaria de pintar imagens de arquivos JPG (JPeg) nos forms
de minha aplicação. Isto é possível? Como?
Solução:
Para trabalhar com arquivos JPG você precisa usar um objeto
TPicture, assim como colocar no uses a unit JPeg. Siga os
passos abaixo para pintar uma imagem JPG no form:
- No evento OnPaint do form coloque o código abaixo:
procedure TForm1.FormPaint(Sender: TObject);
var
Imagem: TPicture;
begin
Imagem := TPicture.Create;
try
Imagem.LoadFromFile('c:\teste\foto.jpg');
Canvas.StretchDraw(ClientRect, Imagem.Graphic);
finally
Imagem.Free;
end;
end;
- E no evento OnResize do form, coloque:
procedure TForm1.FormResize(Sender: TObject);
begin
Repaint;
end;
Não se esqueça de trocar o nome do arquivo JPG conforme sua necessidade. Este exemplo foi elaborado usando Delphi4.
Usando WinExec você pode executar qualquer comando do DOS.
Para isto chame o COMMAND.COM passando como parâmetro a linha
de comando a ser executada. O parâmetro /C é opcional e faz
com que a janela do DOS seja fechada assim que o comando
terminar. No exemplo abaixo estou executando a seguinte
linha de comando: DIR C:\*.*
WinExec('COMMAND.COM /C DIR C:\*.*', SW_SHOW);
Para que a janela do DOS não seja exibida, use SW_HIDE no lugar de SW_SHOW.
{ Esta função forma CEP como: 99.999-999 }
function tbFormataCEP(const CEP: string): string;
var
I: integer;
begin
Result := '';
for I := 1 to Length(CEP) do
if CEP[I] in ['0'..'9'] then
Result := Result + CEP[I];
if Length(Result) <> 8 then
raise Exception.Create('CEP inválido.')
else
Result :=
Copy(Result, 1, 2) + '.' +
Copy(Result, 3, 3) + '-' +
Copy(Result, 6, 3);
end;
=== Para testar ===
- Coloque um Edit e um Button no form;
- No evento OnClick do Button coloque a instrução abaixo:
Edit1.Text := tbFormataCEP(Edit1.Text);
Para formatar outros códigos como CPF, CGC, etc., pode-se usar a mesma idéia.
Problema:
Em determinadas partes no programa existem processos que podem
demorar vários minutos para serem concluídos. Muitas vezes o
usuário desiste e deseja cancelar o processamento. Como
permitir este cancelamento?
Solução:
Em aplicativos para Windows é comum, em processamentos
demorados, o programa mostrar uma janela de diálogo avisando
que o processo pode levar um tempo extra. Nesta mesma janela
normalmente coloca-se também um botão "Cancelar" que dá ao
usuário a opção aguardar ou desistir do processo. Para fazer
isto em um aplicativo Delphi, siga os passos abaixo:
- Vamos considerar em nosso exemplo que o processamento ocorre
na unit do Form1.
- Declare, na seção public do Form1, uma variável boolean.
public;
Cancelar: boolean;
- Crie um novo form (vou chamá-lo de Form2);
- Coloque um botão neste novo form. Programe o OnClick deste
botão conforme abaixo:
Form1.Cancelar := true;
- Na parte onde ocorre o loop do processamento demorado
coloque algo como:
try
{ Antes de começar o processamento }
Form2.Caption := 'Processamento demorado...';
Form2.Show;
{ No início do loop "Cancelar" precisa ser false }
Cancelar := false;
{ Aqui inicia o loop do processamento demorado }
while {...} do begin
{ ... Processa algo aqui... }
{ Permite que o programa processe mensagens do Windows }
Application.ProcessMessages;
{ Se a variável "Cancelar" foi alterada para true... }
if Cancelar then begin
ShowMessage('Operação cancelada pelo usuário.');
Break; { Sai do loop }
end;
end;
finally
Form2.Close;
end;
Não se esqueça de que o Form1 precisa usar Form2 e vice-versa.
Inclua na seção uses: SysUtils
{ Esta função retorna true se a data passada como parâmetro
é fim de mês. Retorna false caso contrário. }
function tbFimDoMes(const Data: TDateTime): boolean;
var
Ano, Mes, Dia: Word;
begin
DecodeDate(Data +1, Ano, Mes, Dia);
Result := Dia = 1;
end;
Inclua na seção uses: Windows, Dialogs
Problema:
Gostaria de programar algumas teclas de atalho para chamar,
por exemplo, uma calculadora, quando meu aplicativo estiver
aberto. Como fazer?
Solução:
- No evento OnCreate do form coloque o código abaixo:
procedure TForm1.FormCreate(Sender: TObject);
begin
if not RegisterHotkey(Handle, 1, MOD_CONTROL or MOD_ALT, VK_F11) then
ShowMessage('Erro ao programar Ctrl+Alt+F11');
if not RegisterHotkey(Handle, 2, MOD_CONTROL or MOD_ALT, VK_F12) then
ShowMessage('Erro ao programar Ctrl+Alt+F12');
end;
- No evento OnDestroy do form coloque o código abaixo:
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotkey(Handle, 1);
UnRegisterHotkey(Handle, 2);
end;
- Declere a procedure abaixo na seção private:
private
procedure WMHotkey(var Msg: TWMHotkey); message WM_HOTKEY;
- Abaixo da palavra implementation escreva a procedure:
procedure TForm1.WMHotkey(var Msg: TWMHotkey);
begin
case Msg.HotKey of
1: WinExec('calc.exe', SW_SHOW);
2: ShowMessage('Ctrl+Alt+F12 foram pressionadas');
end;
end;
- Execute este programa e experimente pressionar Ctrl+Alt+F11
ou Ctrl+Alt+F12.
Se a combinação de teclas já estiver em uso (num atalho, por exemplo), não será possível usá-la em nossa aplicação. Existem outras formas de implementar teclas de atalho em programas escritos em Delphi, mas a forma apresentada é bastante funcional.
Inclua na seção uses: Registry, Dialogs
{
- Coloque um botão no form;
- Altere o evento OnClick do botão conforme abaixo:
}
procedure TForm1.Button1Click(Sender: TObject);
const
cRegPath = 'System\CurrentControlSet\control\FileSystem';
cRegValue = 'ACDriveSpinDown';
var
Reg: TRegistry;
S: string;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey(cRegPath, false) then begin
case Reg.GetDataType(cRegValue) of
rdUnknown: S := 'Tipo Desconhecido';
rdString: S := 'String';
rdExpandString: S := 'ExpandString';
rdInteger: S := 'Inteiro';
rdBinary: S := 'Binário';
end;
ShowMessage(S);
end else
ShowMessage('Erro ao abrir chave do Registro');
finally
Reg.Free;
end;
end;
A unit Dialogs foi acrescentada no uses somente para podermos usar a procedure ShowMessage.
Inclua na seção uses: Windows
{ Esta procedure pega a linha e coluna da célula onde estiver
o mouse. Valores negativos para Linha ou Coluna indicam que
o mouse está fora da área cliente do StringGrid }
procedure MouseCell(Grid: TStringGrid;
var Coluna, Linha: integer);
var
Pt: TPoint;
begin
GetCursorPos(Pt);
Pt := Grid.ScreenToClient(Pt);
if PtInRect(Grid.ClientRect, Pt) then
Grid.MouseToCell(Pt.X, Pt.Y, Coluna, Linha)
else begin
Coluna := -1;
Linha := -1;
end;
end;
{ Exemplo de uso:
- Coloque um botão no form;
- Altere o evento OnClick deste botão como abaixo:
}
procedure TForm1.Button1Click(Sender: TObject);
var
Coluna, Linha: integer;
begin
MouseCell(StringGrid1, Coluna, Linha);
if (Coluna >= 0) and (Linha >= 0) then
Caption := 'Coluna: ' + IntToStr(Coluna) + ' - ' +
'Linha: ' + IntToStr(Linha);
else
Caption := 'O mouse não está no StringGrid';
end;
{ Para testar:
- Execute o programa;
- Posicione o cursor do mouse sobre alguma célula do
StringGrid;
- Pressione TAB até chegar ao botão e pressione ENTER;
- O resultado será mostrado no Caption do form;
}
Note que a procedure MouseCell usa um valor negativo (-1) para coluna e linha se o mouse não estiver sobre o StringGrid.
Existem três métodos que podemos aplicar para limpar
um StringGrid.
{ Limpando uma célula de cada vez: }
procedure TForm1.Button1Click(Sender: TObject);
var
I, J: integer;
begin
with StringGrid1 do
for I := 0 to ColCount -1 do
for J := 0 to RowCount -1 do
Cells[I,J] := '';
end;
{ Limpando uma linha de cada vez: }
procedure TForm1.Button2Click(Sender: TObject);
var
I: integer;
begin
with StringGrid1 do
for I := 0 to RowCount -1 do
Rows[I].Clear;
end;
{ Limpando uma coluna de cada vez: }
procedure TForm1.Button3Click(Sender: TObject);
var
I: integer;
begin
with StringGrid1 do
for I := 0 to ColCount -1 do
Cols[I].Clear;
end;
Em todos os exemplos estamos limpando o StringGrid completamente, inclusive linhas e colunas fixas. Para preservar linhas ou colunas fixas troque os valores iniciais de I ou J conforme a necessidade.
Inclua na seção uses: Registry
Problema:
Criei um editor de textos no Delphi. Agora gostaria que o
Windows Explorer usasse este editor para abrir arquivos com
a extensão .dpg e .dan. Como fazer?
Solução:
Para fazer isto será necessária a criação de algumas chaves no
Registro do Windows. O exemplo abaixo cria todas as chaves
necessárias.
- Coloque um TButton e no evento OnClick dele coloque o
código abaixo:
procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
Reg.LazyWrite := false;
{ Define o nome interno (ArquivoDaniel) e uma legenda
que aparecerá no Windows Explorer (Arquivo do Daniel) }
Reg.OpenKey('ArquivoDaniel', true);
Reg.WriteString('', 'Arquivo do Daniel');
Reg.CloseKey;
{ Define o comando a ser executado quando abrir um
arquivo pelo Windows Explorer (NomeDoExe %1). O símbolo
%1 indica que o arquivo a ser aberto será passado como
primeiro parâmetro para o aplicativo - ParamStr(1). }
Reg.OpenKey('ArquivoDaniel\shell\open\command', true);
Reg.WriteString('', ParamStr(0) + ' %1'); { NomeDoExe %1 }
Reg.CloseKey;
{ Define o ícone a ser usado no Windows Explorer:
0 - primeiro ícone do EXE
1 - segundo ícone do EXE, etc }
Reg.OpenKey('ArquivoDaniel\DefaultIcon', true);
Reg.WriteString('', ParamStr(0) + ',0'); { 0 = primeiro ícone }
Reg.CloseKey;
{ Define as extensões de arquivos que serão abertos pelo
meu aplicativo }
{ *.dpg }
Reg.OpenKey('.dpg', true);
Reg.WriteString('', 'ArquivoDaniel');
Reg.CloseKey;
{ *.dan }
Reg.OpenKey('.dan', true);
Reg.WriteString('', 'ArquivoDaniel');
Reg.CloseKey;
finally
Reg.Free;
end;
end;
- Coloque um TMemo;
- No evento OnShow do Form coloque o código abaixo:
procedure TForm1.FormShow(Sender: TObject);
begin
{ Se o primeiro parâmetro for um nome de arquivo existente... }
if FileExists(ParamStr(1)) then
{ Carrega o conteúdo do arquivo no memo }
Memo1.Lines.LoadFromFile(ParamStr(1));
end;
*** Para testar ***
- Execute este programa;
- Clique no botão para criar as chaves no Registro do Windows;
- Feche o programa;
- Crie alguns arquivos com as extensões .dpg e .dan;
- Vá ao Windows Explorer e procure pelos arquivos criados;
- Experimente dar um duplo-clique sobre qualquer dos arquivos
com uma das extensões acima.
Existem outros recursos que poderão ser configurados. Porém, para começar, este já é um bom exemplo.
Problema:
Tenho um cadastro de clientes com Codigo, Nome, DataNasc, etc.
Preciso fazer uma consulta onde apareceão apenas os clientes
que fazem aniversário em determinado mês. Como fazer?
Solução:
Use uma Query como abaixo:
- Coloque no form os seguintes componentes:
* TQuery
* TDataSource
* TDBGrid
* TEdit
* TButton
- Altere as propriedades dos componentes como abaixo:
* Query1.DatabaseName = (alias do BDE)
* DataSource1.DataSet = Query1
* DBGrid1.DataSource = DataSource1
- Coloque o código abaixo no evento OnClick de Button1:
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('select * from dCli');
Query1.SQL.Add('where extract(month from DataNasc) = :Mes');
Query1.ParamByName('Mes').AsInteger := StrToInt(Edit1.Text);
Query1.Open;
- Execute. Digite um número de 1 a 12 no Edit e clique no
botão.
Os números de 1 a 12 representam, respectivamente, os meses de Janeiro a Dezembro. Este exemplo foi testado com Delphi4, BDE5 e tabela Paradox7.
Inclua na seção uses: dbTables
- Coloque um TButton no form;
- Escreve no OnClick do Button como abaixo:
procedure TForm1.Button1Click(Sender: TObject);
var
Q: TQuery;
begin
Q := TQuery.Create(Application);
try
Q.DatabaseName := 'SF';
with Q.SQL do begin
Add('Create Table Funcionarios');
Add('( Codigo AutoInc,');
Add(' Nome Char(30),');
Add(' Salario Money,');
Add(' Depto SmallInt,');
Add(' Primary Key (Codigo) )');
end;
Q.ExecSQL;
finally
Q.Free;
end;
end;
Este exemplo foi testado com banco de dados Paradox, porém deverá funcionar em vários outros bancos de dados com pouca ou nenhuma alteração.
Inclua na seção uses: dbTables, Classes, Forms
A função abaixo obtém os nomes de todos os campos de uma
tabela do banco de dados.
procedure tbGetFieldNames(const DBName, TblName: string;
List: TStringList);
var
I: integer;
begin
List.Clear;
with TTable.Create(Application) do
try
DatabaseName := DBName;
TableName := TblName;
with FieldDefs do begin
Update;
for I := 0 to Count -1 do
List.Add(Items[I].Name);
end;
finally
Free;
end;
end;
=== Exemplo de uso ===
- Coloque um TMemo e um TButton no Form;
- Coloque o código abaixo no evento OnClick do Button:
procedure TForm1.Button1Click(Sender: TObject);
var
List: TStringList;
begin
List := TStringList.Create;
try
tbGetFieldNames(Edit1.Text, Edit2.Text, List);
Memo1.Lines.Assign(List);
finally
List.Free;
end;
end;
Inclua na seção uses: Printers
Problema: Quando mandamos imprimir no Windows, normalmente o nome do documento aparece na fila de impressão (spool). Como fazer com que aplicativos feitos em Delphi se comporte desta forma? Ou seja, como nomear meus relatórios feitos em Delphi? Solução: Antes de enviar seu relatório, faça assim: Printer.Title := 'Nome do relatório';
Esta solução aplica-se perfeitamente aos relatórios feitos usando o objeto Printer. Nos casos de geradores de relatórios, estes provavelmente possuem uma propriedade equivalente.
Inclua na seção uses: SysUtils
{ A função abaixo retorna o tamanho do arquivo, ou -1
se o arquivo não for encontrado }
function tbFileSize(const FileName: string): integer;
var
SR: TSearchRec;
I: integer;
begin
I := FindFirst(FileName, faArchive, SR);
try
if I = 0 then
Result := SR.Size
else
Result := -1;
finally
FindClose(SR);
end;
end;
- Declare a função abaixo antes da palavra implementation: function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL'; - Coloque dois botões no Form; - No evento OnClick do Button1 coloque: RegisterServiceProcess(GetCurrentProcessID, 1); - No evento OnClick do Button2 coloque: RegisterServiceProcess(GetCurrentProcessID, 0); === Para testar === Clique no Button1 e pressione CTRL+ALT+DEL. O seu programa não aparecerá na lista. Clique no Button2 e pressione CTRL+ALT+DEL. Agora seu programa aparecerá na lista. Dica enviada por: Luiz Carlos Manzolli
Inclua na seção uses: BDE
{ A função abaixo retorna o path (caminho) de um Alias do
BDE }
function GetAliasPath(AliasName: String):String;
var
dbDes: DBDesc;
begin
Result:='';
DBiInit(Nil);// invoca o BDE , se não inicializado
If DbiGetDatabaseDesc(PChar(AliasName), @dbDes)= DBIERR_NONE then
with dbDes do
Result:=StrPas(szPhyName);
DBiExit;// Libera o BDE
end;
Dica enviada por: Angelo Ricardo Miquelin Neto.
Se a unit em que essa rotina for colocada utilizar as units DB e DBTABLES, as chamadas a DbiInit() e DbiExit() poderão ser omitidas.
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);
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);
Este recurso pode não funcionar dependendo da configuração do sistema.
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);
- Na seção Private declare a procedure abaixo:
private
procedure WMMove(var Msg: TWMMove); message WM_MOVE;
- Abaixo da palavra implementation escreva a procedure
abaixo:
procedure TForm1.WMMove(var Msg: TWMMove);
begin
if Left < 0 then
Left := 0;
if Top < 0 then
Top := 0;
if Screen.Width - (Left + Width) < 0 then
Left := Screen.Width - Width;
if Screen.Height - (Top + Height) < 0 then
Top := Screen.Height - Height;
end;
Para testar:
- Execute o programa e tente arrastar o form para fora
das margens da tela e veja o que acontece.
Inclua na seção uses: Windows
Problema:
Fiz um programa que mostra mensagens de lembrete quando é
chegada determinada data/hora. Porém quando o usuário vai
para o Prompt do MS-DOS em modo tela cheia, a mensagem
não aparece. O que devo fazer?
Solução:
Antes de mostrar a mensagem, coloque sua aplicação na frente
das demais.
SetForegroundWindow(Application.Handle);
ShowMessage('Teste');
Inclua na seção uses: Clipbrd
Problema:
Gostaria de colocar em minha aplicação o recurso de copiar
todos os registros de uma tabela para a área de transferência,
permitindo ao usuário colar estes dados em outro
aplicativo (ex: MS-Word). Isto é possível?
Solução:
Sim. Siga os passos abaixo:
- Crie seu form normalmente, colocando DataSource, Table e
demais componentes;
- Coloque um botão e no evento OnClick deste botão coloque
o código abaixo:
procedure TForm1.Button1Click(Sender: TObject);
const
SeparadorCampoValor = ': ';
SeparadorCampo = #13#10; { Quebra de linha }
SeparadorRegistro = '===========' + #13#10;
var
S: string;
I: integer;
begin
S := '';
Table1.First;
while not Table1.EOF do begin
for I := 0 to Table1.FieldCount -1 do
S := S + Table1.Fields[I].FieldName + SeparadorCampoValor +
Table1.Fields[I].AsString + SeparadorCampo;
S := S + SeparadorRegistro;
Table1.Next;
end;
Clipboard.AsText := S;
end;
Para testar:
- Execute este aplicativo;
- Clique no botão;
- Vá em outro aplicativo (ex: MS-Word) e mande colar (Ctrl+V).
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.
Inclua na seção uses: Clipbrd
Problema:
Gostaria de colocar em minha aplicação o recurso de copiar
um registro de uma tabela para a área de transferência,
permitindo ao usuário colar estes dados em outro
aplicativo (ex: MS-Word). Isto é possível?
Solução:
Sim. Siga os passos abaixo:
- Crie seu form normalmente, colocando DataSource, Table e
demais componentes;
- Coloque um botão e no evento OnClick deste botão coloque
o código abaixo:
procedure TForm1.Button1Click(Sender: TObject);
const
SeparadorCampoValor = ': ';
SeparadorCampo = #13#10; { Quebra de linha }
var
S: string;
I: integer;
begin
S := '';
for I := 0 to Table1.FieldCount -1 do
S := S + Table1.Fields[I].FieldName + SeparadorCampoValor +
Table1.Fields[I].AsString + SeparadorCampo;
Clipboard.AsText := S;
end;
Para testar:
- Execute este aplicativo;
- Clique no botão;
- Vá em outro aplicativo (ex: MS-Word) e mande colar (Ctrl+V).
Inclua na seção uses: FileCtrl, SysUtils
Problema:
Gostaria de criar um sub-diretório dentro do diretório
onde se encontra o EXE de minha aplicação. Como fazer?
Solução:
Primeiramente vamos conhecer algumas funções do Delphi
que precisaremos usá-las:
ParamStr(Indice) - Retorna valores passados
na linha de comando quando executamos o programa. Se o valor
de Indice for 0 (zero) será retornado o caminho+nome do EXE.
ExtractFilePath(NomeArq) - Retorna o caminho (path) do
nome de arquivo informado.
Exemplo:
S := 'C:\NomeDir\Programa.exe';
ExtractFilePath(S); { retorna: 'C:\NomeDir\' }
DirectoryExists(CaminhoDir) - Retorna true se o diretório
informado existe. False em caso contrário.
CreateDir(CaminhoDir) - Tenta criar o diretório informado.
Se conseguir, retorna true. Caso contrário retorna false.
Agora que sabemos como trabalham estas funções, vamos
escrever uma função que precisamos para criar um
sub-diretório conforme proposto.
function CriaSubDir(const NomeSubDir: string): boolean;
var
Caminho: string;
begin
Caminho := ExtractFilePath(ParamStr(0)) + NomeSubDir;
if DirectoryExists(Caminho) then
Result := true
else
Result := CreateDir(Caminho);
end;
Exemplo de uso:
- Chame a função no evento OnCreate do form:
procedure TForm1.FormCreate(Sender: TObject);
begin
if not CriaSubDir('MeuSubDir') then
ShowMessage('Não foi possível criar o sub-diretório MeuSubDir.');
end;
Inclua no implementation de seu programa a seguinte linha: function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL'; e depois no OnCreate ponha a seguinte linha: RegisterServiceProcess(GetCurrentProcessID, 1); Isso vai fazer o programa nao aparecer no CTRL+ALT+DEL, mas seu form principal vai continuar aparecendo. Para ocultar também o form, basta por no OnCreate antes da linha acima a seguinte linha: Application.ShowMainForm:=False; Resposta enviada por: dexter07
Segundo o autor desta resposta, esta solução foi testada em Win95, mas também deve funcionar em Win98. Não sabe se funciona em NT.
Problema:
Quando ocorre uma exceção no Delphi, ele automaticamente
exibe uma mensagem de erro. Gostaria de poder personalizar
estas mensagens, acrescentando, por exemplo, o e-mail do
suporte técnico. Isto é possível?
Solução:
Sim. Siga os passos abaixo:
- Declare um método (procedure) na seção private do
form principal conforme abaixo:
private
procedure ManipulaExcecoes(Sender: TObject; E: Exception);
- Vá até a seção implementation e implemente este método,
conforme o exemplo:
procedure TForm1.ManipulaExcecoes(Sender: TObject; E: Exception);
begin
MessageDlg(E.Message + #13#13 +
'Suporte técnico:'#13 +
'tecnobyte@ulbrajp.com.br',
mtError, [mbOK], 0);
end;
- No evento OnCreate do Form principal escreva o código
abaixo:
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnException := ManipulaExcecoes;
end;
=== Para testar ===
- Coloque um Button no form;
- No evento OnClick deste botão coloque o código abaixo:
procedure TForm1.Button1Click(Sender: TObject);
begin
StrToInt('ABCD'); { Isto provoca uma exception }
end;
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.
Inclua na seção uses: Windows, Forms
Problema:
O Pascal para DOS possui uma procedure chamada Delay que
serve para pausar o processamento atual em "n" milésimos
de segundo. Como implemento isto no Delphi?
Solução:
Simles. Veja:
procedure Delay(MSec: Cardinal);
var
Start: Cardinal;
begin
Start := GetTickCount;
repeat
Application.ProcessMessages;
until (GetTickCount - Start) >= MSec;
end;
=== Exemplos de uso: ===
Delay(1000); { Aguarda 1 segundo }
Delay(5000); { Aguarda 5 segundos }
Delay(60000); { Aguarda 60 segundos - 1 minuto }
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).
Inclua na seção uses: Windows
Problema:
Gostaria que o meu programa rolasse automaticamente o
conteúdo de um TMemo, simulando o deslizamento da barra de
rolagem vertical. Isto é possível no Delphi?
Solução:
Sim. Utilizando mensagens do Windows isto é fácil. Vejamos
algums exemplos:
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);
Além desta técnica existem API's do Windows que fazem um trabalho equivalente.
Problema:
Gostaria de colocar algums bitmaps em uma DLL e usá-los em
tempo de execução. É possível fazer isto em Delphi?
Solução:
Sim. Siga os passos abaixo para criar a DLL de bitmaps:
- Crie um arquivo de recursos (.RES) contendo os Bitmaps.
Use o Image Editor do Delphi para criar este arquivo.
Salve-o com o nome BMPS.RES na pasta onde será salvo
o projeto do Delphi;
- Crie um novo projeto no Delphi;
- Remova todos os forms do projeto;
- Salve este projeto com o nome DLLBmp.dpr;
- Abra o arquivo de projeto (DLLBmp.dpr) e altere para
ficar somente com as linhas abaixo:
{$R BMPS.RES}
library DLLBmp;
end.
- Compile o projeto (Ctrl+F9). Será criado o
arquivo DLLBmp.DLL.
- Feche o projeto atual e crie um novo projeto;
- Salve-o na mesma pasta que salvou o anterior,
mas com outro nome qualquer;
- Coloque no form um Edit e um Button;
- No evento OnClick do Button coloque o código abaixo:
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp: TBitmap;
HandleDLL: THandle;
begin
{ Carrega a DLL }
HandleDLL := LoadLibrary('DLLBmp.DLL');
if HandleDLL = 0 then
ShowMessage('Não foi possível carregar DLLBmp.DLL')
else
try
Bmp := TBitmap.Create;
try
Bmp.Handle := LoadBitmap(HandleDLL, PChar(Edit1.Text));
if Bmp.Handle = 0 then
ShowMessage('Não foi possível carregar o Bitmap.')
else
{ Pinta o Bitmap no form }
Canvas.Draw(0, 0, Bmp);
finally
Bmp.Free;
end;
finally
{ Libera a DLL }
FreeLibrary(HandleDLL);
end;
end;
=== Para testar ===
- Execute este projeto;
- Digite no Edit1 o nome que foi dado ao Bitmap no arquivo
de recursos (.RES);
- Clique no botão. O bitmap deverá ser pintado no form.
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.
Pegue o arquivo tbtitle.zip na seção Download do IntereSite: www.ulbrajp.com.br/~tecnobyte
Problema:
Fazer um relógio num form é fácil. Porém gostaria que esse
form não possuísse a barra de título, mas que o usuário
ainda pudesse arrastá-lo com o mouse. Isto é possível
no Delphi?
Solução:
Sim, é possível e é fácil. Siga os passos abaixo:
- Crie um novo projeto;
- Mude as seguintes propriedades do Form1:
BorderStyle = bsNone, FormStyle = fsStayOnTop,
- Coloque um Label;
- Coloque um Timer;
- Altere o evento OnTimer do Timer1 conforme abaixo:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption := TimeToStr(Time);
end;
- Altere o evento OnCreate do Form1 conforme abaixo:
procedure TForm1.FormCreate(Sender: TObject);
begin
Width := 80;
Height := 40;
Label1.Left := 10;
Label1.Top := 10;
end;
- Vá na seção private do Form1 e declare a procedure abaixo:
private
procedure WMNCHitTest(var Msg: TMessage);
message WM_NCHitTest;
public
{ Public declarations }
end;
- Vá na seção implementation e escreva a procedure abaixo:
implementation
{$R *.DFM}
procedure TForm1.WMNCHitTest(var Msg: TMessage);
begin
if GetAsyncKeyState(VK_LBUTTON) < 0 then
Msg.Result := HTCAPTION
else
Msg.Result := HTCLIENT;
end;
- Execute e experimente arrastar form com o mouse.
Para fechar este aplicativo pressione Alt+F4. Uma alternativa mais elegante é colocar um menu local (PopupMenu) com um comando para fechar.
Inclua na seção uses: Windows, SysUtils
- Coloque um TMemo no form
- Coloque um TButton no form e altere seu OnClick
conforme abaixo:
procedure TForm1.Button1Click(Sender: TObject);
const
cBytesPorMb = 1024 * 1024;
var
M: TMemoryStatus;
begin
M.dwLength := SizeOf(M);
GlobalMemoryStatus(M);
Memo1.Clear;
with Memo1.Lines do begin
Add(Format('Memória em uso: %d%%',
[M.dwMemoryLoad]));
Add(Format('Total de memória física: %f MB',
[M.dwTotalPhys / cBytesPorMb]));
Add(Format('Memória física disponível: %f MB',
[M.dwAvailPhys / cBytesPorMb]));
Add(Format('Tamanho máximo do arquivo de paginação: %f MB',
[M.dwTotalPageFile / cBytesPorMb]));
Add(Format('Disponível no arquivo de paginação: %f MB',
[M.dwAvailPageFile / cBytesPorMb]));
Add(Format('Total de memória virtual: %f MB',
[M.dwTotalVirtual / cBytesPorMb]));
Add(Format('Memória virtual disponível: %f MB',
[M.dwAvailVirtual / cBytesPorMb]));
end;
end;
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;
Inclua na seção uses: ShellApi
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellAbout(Handle, 'Sistema Financeiro', 'Marcelo Senger',
Application.Icon.Handle);
end;
Dica enviada por: Marcelo Senger
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 }
Inclua na seção uses: SysUtils
Problema:
A função IntToHex do Delphi converte inteiro para
hexadecimal. O que preciso, no entanto, é fazer o contrário,
ou seja, converter de hexadecimal para inteiro. Existe
isto pronto no Delphi ou terei que escrever uma função
para isto?
Solução:
A função StrToInt pode receber uma string no formato de um
número decimal ou hexadecimal. Então podemos usá-la assim:
var
I: integer;
begin
I := StrToInt('$' + Edit1.Text);
{...}
end;
No Delphi, um número na notação decimal deve iniciar com o símbolo $.
Problema:
Uso um DBCtrlGrid e gostaria que, quando o valor de um
determinado campo for negativo, o DBEdit ligado a este
campo seja exibido em vermelho e, caso contrário,
em azul. Isto é possível?
Solução:
- Monte o form normalmente colocando DataSource, Table,
DBCtrlGrid e os DBEdit's, DBText's, etc.
- Escreva no manipulador do evento OnPaintPanel do
DBCtrlGrid conforme abaixo:
procedure TForm1.DBCtrlGrid1PaintPanel(DBCtrlGrid: TDBCtrlGrid;
Index: Integer);
begin
if Table.FieldByName('NomeDoCampo').AsFloat < 0 then
DBEdit1.Font.Color := clRed
else
DBEdit1.Font.Color := clBlue;
end;
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).
- Coloque uma StatusBar no form.
- Adicione dois paineis na StatusBar (propriedade Panels).
- Ajuste as propriedades do primeiro painel conforme abaixo:
Style = psOwnerDraw
Width = 150
- Coloque uma ProgressBar no form e mude sua propriedade
Visible para false.
- No evento OnDrawPanel da StatusBar digite o código abaixo:
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
{ Se for o primeiro painel... }
if Panel.Index = 0 then begin
{ Ajusta a tamanho da ProgressBar de acordo com
o tamanho do painel }
ProgressBar1.Width := Rect.Right - Rect.Left +1;
ProgressBar1.Height := Rect.Bottom - Rect.Top +1;
{ Pinta a ProgressBar no DC (device-context) da StatusBar }
ProgressBar1.PaintTo(StatusBar.Canvas.Handle, Rect.Left, Rect.Top);
end;
end;
- Coloque um Button no form
- Digite no evento OnClick do Button o código abaixo:
procedure TForm1.Button1Click(Sender: TObject);
var
I: integer;
begin
for I := ProgressBar1.Min to ProgressBar1.Max do begin
{ Atualiza a posição da ProgressBar }
ProgressBar1.Position := I;
{ Repinta a StatusBar para forçar a atualização visual }
StatusBar1.Repaint;
{ Aguarda 50 milisegundos }
Sleep(50);
end;
{ Aguarde 500 milisegundos }
Sleep(500);
{ Reseta (zera) a ProgressBar }
ProgressBar1.Position := ProgressBar1.Min;
{ Repinta a StatusBar para forçar a atualização visual }
StatusBar1.Repaint;
end;
- Execute e clique no botão para ver o resultado.
Com um pouco de criatividade podemos fazer outras coisas interessantes usando o evento OnDrawPanel da StatusBar.
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);
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,...).
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);
Neste exemplo pressionamos Ctrl+F2. Não se esqueça das teclas que precisam manter pressionadas: Ctrl, Alt, Shift.
Inclua na seção uses: Windows
A API keybd_event do Windows serve para fazer isto. No exemplo
abaixo estamos simulando o pressionamento da tecla F2:
keybd_event(VK_F2, 0, 0, 0);
Para testar faça o exemplo a seguir:
- Mude a propriedade KeyPreview do form para true.
- Escreva no evento OnKeyDown do form como abaixo:
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_F2 then
ShowMessage('F2 pressionada');
end;
- Coloque um botão e escreva no OnClick (do botão) como abaixo:
procedure TForm1.Button1Click(Sender: TObject);
begin
keybd_event(VK_F2, 0, 0, 0);
end;
Consulte as constantes para os códigos das teclas (ex: VK_RETURN, VK_DOWN, etc).
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 }
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.
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 }
Qualquer tecla pode ser verificada. Para isto basta saber o código virtual (Virtual Key Code) da tecla.
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 }
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.
- 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;
Cuidado para não especificar uma linha inexistente.
Problema:
Meu programa precisa processar algo quando o usuário clicar
no DBGrid em um determinado form. O problema é que o DBGrid não
possui o evento OnClick. É possível adicionar este evento no
DBGrid?
Solução:
É possível sim. Afinal é muito simples. Siga os passos abaixo
para resolver seu problema:
- Monte seu form normalmente, colocando o DBGrid e demais
componentes;
- Vá na seção "private" da unit e declare a procedure abaixo:
private
procedure DBGridClick(Sender: TObject);
- Logo após a palavra "implementation", escreva a procedure:
implementation
{$R *.DFM}
procedure TForm1.DBGridClick(Sender: TObject);
begin
ShowMessage('Clicou no DBGrid.');
end;
- Coloque as instruções abaixo no evento OnCreate do Form:
procedure TForm1.FormCreate(Sender: TObject);
begin
DBGrid1.ControlStyle :=
DBGrid1.ControlStyle + [csClickEvents];
TForm(DBGrid1).OnClick := DBGridClick;
end;
- E pronto. Execute e teste.
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.
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;
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).
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];
- Use a função abaixo:
function StrIsTime(const S: string): boolean;
begin
try
StrToTime(S);
Result := true;
except
Result := false;
end;
end;
- 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;
Problema:
Um processamento em meu sistema é bastante demorado e por isto
colocar apenas o cursor de ampulheta continua deixando o
usuário confuso, pensando que o sistema travou. É possível
exibir uma mensagem enquanto um processamento demorado ocorre?
Sim. E é fácil. Vejamos:
- Crie um form com a mensagem. Um pequeno form com um
Label já é suficiente. Aqui vou chamá-lo de FormMsg.
- Vá em Project|Options e passe o FormMsg de
"Auto-create forms" para "Available forms".
- Abaixo vou simular um processamento demorado, usando a
API Sleep:
procedure TForm1.Button1Click(Sender: TObject);
var
Form: TFormMsg;
I: integer;
begin
Form := TFormMsg.Create(Self);
try
Form.Label1.Caption := 'Processamento demorado...';
Form.Show;
for I := 1 to 5 do begin
Form.UpDate;
Sleep(1000); { Aguarda um segundo }
end;
finally
Form.Free;
end;
end;
A função Sleep é uma API do Windows e serve para paralisar a aplicação por um determinado dempo. Este tempo é em milisegundos.
- Salve o cursor atual
- Defina o novo cursor (crHourGlass é ampulheta)
- Faça o processamento
- Restaure o cursor.
Vejamos:
var
PrevCur: TCursor;
begin
PrevCur := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
{ Coloque aqui as instruções do processamento }
finally
Screen.Cursor := PrevCur;
end;
end;
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.
Inclua na seção uses: Registry
Coloque no Form:
- três edits;
- dois botões.
Logo abaixo da palavra implementation declare:
type
{ Declara um tipo registro }
TFicha = record
Codigo: integer;
Nome: string[40];
DataCadastro: TDateTime;
end;
- Escreva o evento OnClick do Button1 conforme abaixo:
procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
Ficha: TFicha;
begin
{ Coloca alguns dados na variável Ficha }
Ficha.Codigo := StrToInt(Edit1.Text);
Ficha.Nome := Edit2.Text;
Ficha.DataCadastro := StrToDate(Edit3.Text);
Reg := TRegistry.Create;
try
{ Define a chave-raiz do registro }
Reg.RootKey := HKEY_CURRENT_USER;
{ Abre uma chave (path). Se não existir cria e abre. }
Reg.OpenKey('Cadastro\Pessoas\', true);
{ Grava os dados (o registro) }
Reg.WriteBinaryData('Dados', Ficha, SizeOf(Ficha));
finally
Reg.Free;
end;
end;
- Escreva o evento OnClick do Button2 conforme abaixo:
procedure TForm1.Button2Click(Sender: TObject);
var
Reg: TRegistry;
Ficha: TFicha;
begin
Reg := TRegistry.Create;
try
{ Define a chave-raiz do registro }
Reg.RootKey := HKEY_CURRENT_USER;
{ Se existir a chave (path)... }
if Reg.KeyExists('Cadastro\Pessoas') then
begin
{ Abre a chave (path) }
Reg.OpenKey('Cadastro\Pessoas', false);
{ Se existir o valor... }
if Reg.ValueExists('Dados') then
begin
{ Lê os dados }
Reg.ReadBinaryData('Dados', Ficha, SizeOf(Ficha));
Edit1.Text := IntToStr(Ficha.Codigo);
Edit2.Text := Ficha.Nome;
Edit3.Text := DateToStr(Ficha.DataCadastro);
end else
ShowMessage('Valor não existe no registro.')
end else
ShowMessage('Chave (path) não existe no registro.');
finally
Reg.Free;
end;
end;
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.
- Coloque um ListBox no form
- Modifique o OnCreate do form assim:
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
DevMode : TDevMode;
begin
i := 0;
while EnumDisplaySettings(nil,i,Devmode) do begin
with Devmode do
ListBox1.Items.Add(Format('%dx%d %d Colors',
[dmPelsWidth,dmPelsHeight, 1 shl dmBitsperPel]));
Inc(i);
end;
end;
- Coloque um botão no form
- Altere o evento OnClick do botão conforme abaixo:
procedure TForm1.Button1Click(Sender: TObject);
var
DevMode : TDevMode;
begin
EnumDisplaySettings(nil,Listbox1.ItemIndex,Devmode);
ChangeDisplaySettings(DevMode,0);
end;
Nos testes que fiz, nem tudo funcionou adequadamente. Mas vale a pena experimentar.
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;
User o aplicativo RegEdit.exe do windows para ver o registro. Cuidado para não alterar as configurações do Windows!
{ - 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);
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];
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.');
Problema: Gostaria de montar um formulário de pesquisa com um DBGrid e um Edit de modo que, enquanto o usuário digita um nome do Edit, o registro vai sendo localizado no DBGrid. Como fazer? - Crie um índice na tabela com campo a ser usado na pesquisa. Coloque no Form: - Um DataSource - Um Table - Um DBGrid - Um 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]);
Este exemplo considera que o campo seja tipo string. Para outros tipos de campos pode ocorrer erro dependendo dos valores digitados no Edit1.
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;
Se o comprimento desejado (Casas) não for suficiente para conter o número, serão colocados asteriscos.
Table1.FieldByName('Data').Clear;
{ ou }
Table1.FieldByName('Data').AsString := '';
Podemos usar este recurso para limpar também campos numéricos, string, etc.
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;
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.
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;
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.
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;
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.
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;
Normalmente, a versão 4.72 está presente quando o Internet Explorer 4 está instalado.
{ 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;
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);
{ === SOLUÇÃO 1 === }
{ Esta procedure obtém a linha e coluna atual de um TMemo }
procedure tbGetMemoLinCol(Memo: TMemo; var Lin, Col: Cardinal);
begin
with Memo do begin
Lin := Perform(EM_LINEFROMCHAR, SelStart, 0);
Col := SelStart - Perform(EM_LINEINDEX, Lin, 0);
end;
end;
{ Use-a como abaixo: }
var
Lin, Col: Cardinal;
begin
tbGetMemoLinCol(Memo1, Lin, Col);
{ ... }
end;
{ === SOLUÇÃO 2 === }
var
Lin, Col: integer;
begin
Lin := Memo1.CaretPos.y;
Col := Memo1.CaretPos.x;
{...}
end;
- A segunda solução foi apresentada por:
Vanderley Pereira Rocha
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;
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.
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');
Inclua na seção uses: Windows
if IsZoomed(Form1.Handle) then
{ Form1 está maximizado }
else
{ Form2 NÃO está maximizado }
Veja a pergunta n. 78.
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;
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.
Inclua na seção uses: Windows
if IsIconic(Application.Handle) then
{ Minimizado }
else
{ Não minimizado }
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.
Inclua na seção uses: Windows
procedure TForm1.Button1Click(Sender: TObject); begin FatalAppExit(0, 'Erro fatal na aplicação.'); end;
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.
{ Problema:
Tenho um sistema de contas a receber, onde um campo chamado
"Tipo" contém um número inteiro que indica o tipo do
documento conforme abaixo:
1 - Promissória
2 - Duplicata
3 - Boleto
Gostaria que, ao exibir os dados (num DBGrid por exemplo),
fosse exibido o nome e não o número, ou seja, "Promissória"
em vez de "1".
Solução:
Isto pode ser feito de várias formas, mas aqui vou mostrar
como resolver usando o evento OnGetText do TField. Vejamos:
- Adicione todos os campos no Field Editor;
- Clique no campo "Tipo";
- Vá ao Object Inspector e dê um duplo-click
no evento OnGetText;
- Neste evento, digite o código abaixo:
}
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;
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.
{ É 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;
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.
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 }
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.
Inclua na seção uses: Windows
{ Problema:
Gostaria que um determinado programa (Prog1.EXE) fosse
executado apenas através de outro programa (Prog2.EXE).
Solução:
Antes da linha "Application.Initialize;" de Prog1.dpr (programa
a ser chamado), coloque o código abaixo:
}
if ParamStr(1) <> 'MinhaSenha' then begin
{ Para usar ShowMessage, coloque Dialogs no uses }
ShowMessage('Execute este programa através de Prog2.EXE');
Halt; { Finaliza }
end;
{ No Form1 de Prog2 (programa chamador) coloque um botão e
escreva o OnClick deste botão como abaixo:
}
procedure TForm1.Button1Click(Sender: TObject);
var
Erro: Word;
begin
Erro := WinExec('Pro2.exe MinhaSenha', SW_SHOW);
if Erro <= 31 then { Se ocorreu erro... }
ShowMessage('Erro ao executar o programa.');
end;
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.
Recebi esta mensagem do desenvolvedor Alexsando S. Pimenta. Como deve ser do interesse de outros desenvolvedores, coloquei-a aqui: ==== Mensagem original ==== Olá Daniel, Anote está solução, muitos tem o mesmo problema mas não conseguem a solução tão facilmente como eu. Look: Problema: Estou com um problemão. Trabalho com o NT 4 workstation Service Pack 3, Delphi 3 e Interbase 4.2.xxx. E instalei o Interbase 5.1.1 Server nesta máquina. Até aí tudo bem. Quando fui rodar a aplicação deram alguns problemas de conversão do tipo de Dado. Analisando o problema percebi que havia esquecido de instalar o Client do Interbase. Foi aí que começaram os problemas. Tentei instalar o client, porém o instalador após preparar os arquivos de instalação mostrava a seguinte mensagem e parava : Titulo da janela = "Severe", mensagem = "Internal error near: IBCheck"; comecei a ler os manuais, em certo ponto aconselhava desinstalar qualquer versão posterior do Interbase da minha máquina. Foi então que desinstalei o Interbase 4.2.xxx (através do "Control Panel", "Add/Remove Programs"). Nova tentativa de instalar o client, o erro persistia. Resolvi desinstalar (através do "Control Panel", "Add/Remove Programs") todo o Interbase da minha máquina e começar tudo de novo. Porém quando tentei instalar novamente o Interbase Server, surpresa, o erro apareceu novamente. Mas agora não havia interbase instalado. Fui desinstalando Delphi, BDE, ... e nada. Entrei no Regedit, pois o desinstalador, normalmente, faz o trabalho incompleto e é necessário excluir um monte de lixo do Registry. Deparei com a seguintes chaves: hkey_local_machine\system\controlset001\enum\root\legacy_interbase_guard hkey_local_machine\system\controlset001\enum\root\legacy_interbase Tentei excluí-las, porém são chaves protegidas, e o regedit não permitiu que eu excluísse-as. Poderiam me dar uma solução para eu poder instalar o Interbase em minha máquina? Preciso disto com urgência. Obrigado, Alexsandro Pimenta Xenon Software Comércio e Serviços Ltda apepper@uol.com.br Solução: Sr. Alexsandro, Esse erro: 'Internal error near: IBCheck' acontece apenas em algumas máquinas NT 4. Na hora da instalação, é criada uma chave com valor errado. Entre no registry do Windows e altere a opção, PATH de binário para string, da chave: HKEY_CURRENT_USER\Environment Renata Oliva Inprise Support Center
Inclua na seção uses: Windows
{ Para inverter: }
SwapMouseButton(true);
{ Para voltar ao normal: }
SwapMouseButton(false);
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;
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.
Inclua na seção uses: Windows
{ No form:
- Coloque um memo;
- Coloque um edit;
- Coloque um botão e escreva seu OnClick como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
Attr: DWord;
begin
Memo1.Clear;
Attr := GetFileAttributes(PChar(Edit1.Text));
if Attr > 0 then
with Memo1.Lines do begin
if (Attr and FILE_ATTRIBUTE_ARCHIVE) > 0 then
Add('Archive');
if (Attr and FILE_ATTRIBUTE_COMPRESSED) > 0 then
Add('Compressed');
if (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0 then
Add('Directory');
if (Attr and FILE_ATTRIBUTE_HIDDEN) > 0 then
Add('Hidden');
if (Attr and FILE_ATTRIBUTE_NORMAL) > 0 then
Add('Normal');
if (Attr and FILE_ATTRIBUTE_OFFLINE) > 0 then
Add('OffLine');
if (Attr and FILE_ATTRIBUTE_READONLY) > 0 then
Add('ReadOnly');
if (Attr and FILE_ATTRIBUTE_SYSTEM) > 0 then
Add('System');
if (Attr and FILE_ATTRIBUTE_TEMPORARY) > 0 then
Add('Temporary');
end;
end;
Inclua na seção uses: Windows
{ - Coloque um memo (TMemo) no form;
- Coloque um botão e altere seu OnClick como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
SetoresPorAgrup, BytesPorSetor, AgrupLivres,
TotalAgrup: DWord;
begin
Memo1.Clear;
if GetDiskFreeSpace('C:\', SetoresPorAgrup,
BytesPorSetor, AgrupLivres, TotalAgrup) then
with Memo1.Lines do begin
Add('Setores por agrupamento: ' + IntToStr(SetoresPorAgrup));
Add('Bytes por setor: ' + IntToStr(BytesPorSetor));
Add('Agrupamentos livres: ' + IntToStr(AgrupLivres));
Add('Total de agrupamentos: ' + IntToStr(TotalAgrup));
Add('----- Resumo -----');
Add('Total de bytes: ' +
IntToStr(TotalAgrup * SetoresPorAgrup * BytesPorSetor));
Add('Bytes livres: ' +
IntToStr(AgrupLivres * SetoresPorAgrup * BytesPorSetor));
end;
end;
{ O exemplo acima retorna as medidas em Bytes, Setores e
Agrupamentos. Se preferir algo mais simples,
use funções do Delphi. Veja: }
Memo1.Lines.Add('Total de bytes: ' + IntToStr(DiskSize(3)));
Memo1.Lines.Add('Bytes livres: ' + IntToStr(DiskFree(3)));
{ Onde o parâmetro (3) é o número da unidade, sendo
1=A, 2=B, 3=C, ... }
Para usar as funções DiskSize e DiskFree coloque SysUtils em uses.
Inclua na seção uses: Windows, Dialogs
{ - Coloque um edit (Edit1) e um botão no form;
- Altere o OnClick do botão conforme abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
Tipo: byte;
begin
Tipo := GetDriveType(PChar(Edit1.Text[1] + ':\'));
case Tipo of
0: S := 'Tipo indeterminado';
1: S := 'Drive não existe';
DRIVE_REMOVABLE: S := 'Disco removível';
DRIVE_FIXED: S := 'Disco Fixo';
DRIVE_REMOTE: S := 'Unidade de rede';
DRIVE_CDROM: S := 'CD-ROM';
DRIVE_RAMDISK: S := 'RAM Disk';
else
S := 'Erro';
end;
ShowMessage(S);
end;
{ Para pegar o tipo da unidade atual troque...}
Tipo := GetDriveType(PChar(Edit1.Text[1] + ':\'));
{ por }
Tipo := GetDriveType(nil);
Para testar digite a letra do drive no Edit1 e clique no botão. A unit Dialogs foi colocada no uses apenas por causa da procedure ShowMessage. Para exibir todas as unidades existentes e seus respectivos tipos, use a função tbGetDrives (da pergunta 64) em conjunto com este exemplo.
Inclua na seção uses: Windows, System
{ - Coloque um memo (TMemo) no form;
- Coloque um botão e escreve seu evento
OnClick como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
SLabel, SSysName: PChar;
Serial, FileNameLen, X: DWord;
begin
Memo1.Clear;
GetMem(SLabel, 255);
GetMem(SSysName, 255);
try
GetVolumeInformation('C:\', SLabel, 255,
@Serial, FileNameLen, X, SSysName, 255);
with Memo1.Lines do begin
Add('Nome do volume (Label): ' + string(SLabel));
Add('Número Serial: ' + IntToHex(Serial, 8));
Add('Tamanho máximo p/ nome arquivo: ' +
IntToStr(FileNameLen));
Add('Sistema de Arquivos: ' + string(SSysName));
end;
finally
FreeMem(SLAbel, 255);
FreeMem(SSysName, 255);
end;
end;
Inclua na seção uses: Windows
{ Da unidade C: }
SetVolumeLabel('c:\', 'NovoLabel');
{ Da unidade atual: }
SetVolumeLabel(nil, 'NovoLabel');
Veja a pergunta nº 66.
Inclua na seção uses: Windows
{ A função abaixo retorna uma string contendo
as letras de unidades de discos presentes. }
function tbGetDrives: string;
var
Drives: DWord;
I: byte;
begin
Result := '';
Drives := GetLogicalDrives;
if Drives <> 0 then
for I := 65 to 90 do
if ((Drives shl (31 - (I - 65))) shr 31) = 1 then
Result := Result + Char(I);
end;
{ Para saber se uma determinada unidade está presente,
basta fazer algo como: }
if Pos('A', tbGetDrives) > 0 then
ShowMessage('Unidade A: presente.')
else
ShowMessage('Unidade A: ausente.');
A string retornada pela função tbGetDrives está sempre em letras maiúsculas.
{ Às vezes você precisa considerar apenas duas casas de valores
reais, mas o Delphi não oferece algo pronto para isto. Se
usarmos funções como Round que vem com o Delphi, o valor será
arredondado (e não truncado). Com Round() o valor abaixo será
135.55 (e não 135.54) com duas casas decimais.
}
ValorReal := 135.54658;
{ Somente a parte inteira - nenhuma casa decimal }
X := Trunc(ValorReal); // X será 135
{ Duas casas }
X := Trunc(ValorReal * 100) / 100; // X será 135.54
{ Três casas }
X := Trunc(ValorReal * 1000) / 1000; // X será 135.5465
Isto pode não funcionar se ValorReal for muito alto. Isto por causa da multiplicação que poderá estourar a capacidade do tipo em uso. Lembre-se: os tipos reais aceitam valores muuuiiiito altos.
procedure tbDBDeleteAll(const DataSet: TDataSet);
begin
with DataSet do
while RecordCount > 0 do
Delete;
end;
{ Chame-a como nos exemplos abaixo: }
tbDBDeleteAll(Table1);
ou
tbDBDeleteAll(Query1);
Se houver um filtro ou range ativo, somente os registros filtrados serão excluídos. Portanto é diferente de Table1.EmptyTable. Esta função poderá ser chamada no evento BeforeDelete do Table (ou Query) principal em um formulário mestre-detalhe para excluir os itens (da parte detalhe).
{ Para não correr o risco de surpresas desagradáveis,
é melhor que seu programa em Delphi verifique se
o Windows está ajustado para trabalhar com 4 dígitos
para o ano. Assim seu programa pode alertar o usuário
quando o ano estiver sendo representado com apenas 2 dígitos.
A função abaixo retorna true se estiver ajustado para
4 dígitos.
}
function Is4DigitYear: Boolean;
begin
result:=(Pos('yyyy',ShortDateFormat)>0);
end;
{ Usando comandos da impressora podemos fazer isto de uma
forma bastante simples. Quando enviamos o caractere ASCII
número 8 (oito) para a impressora, a cabeça de impressão
retrocede uma posição, pois este caractere é o BackSpace.
Então podemos imprimir a letra sem acento e, sem seguida,
voltar e imprimir o acento desejado. Vejamos um exemplo:
- Coloque um botão no form;
- Altere o evento OnClick deste botão conforme abaixo:
}
procedure TForm1.Button2Click(Sender: TObject);
var
F: TextFile;
begin
AssignFile(F, 'LPT1');
Rewrite(F);
try
{ Regra: caractere sem acento + chr(8) + acento }
WriteLn(F, 'Este e' + #8 + '''' + ' um teste.');
WriteLn(F, 'Acentuac' + #8 + ',a' + #8 + '~o.');
WriteLn(F, 'Vovo' + #8 + '^');
WriteLn(F, 'U' + #8 + '''' + 'ltimo.');
WriteLn(F, #12); // Eject
finally
CloseFile(F);
end;
end;
Usando este recurso, a acentuação não fica excelente, mas melhora bastante.
{ A impressora Epson LX-300 dispõe de um comando que justifica
o texto. Este recurso é interessante, pois com ele podemos
continuar a enviar os comandos de formatação de caracteres
como condensado, negrito, italico, expandido, etc.
Para o exemplo abaixo:
- Coloque um botão no form;
- Altere o evento OnClick deste botão como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
const
cJustif = #27#97#51;
cEject = #12;
{ Tamanho da fonte }
c10cpi = #18;
c12cpi = #27#77;
c17cpi = #15;
cIExpandido = #14;
cFExpandido = #20;
{ Formatação da fonte }
cINegrito = #27#71;
cFNegrito = #27#72;
cIItalico = #27#52;
cFItalico = #27#53;
var
Texto: string;
F: TextFile;
begin
Texto := c10cpi +
'Este e um teste para impressora Epson LX 300. ' +
'O objetivo e imprimir texto justificado sem deixar ' +
'de usar formatacao, tais como: ' +
cINegrito + 'Negrito, ' + cFNegrito +
cIItalico + 'Italico, ' + cFItalico +
c17cpi + 'Condensado (17cpi), ' + c10cpi +
c12cpi + '12 cpi, ' + c10cpi +
cIExpandido + 'Expandido.' + cFExpandido +
' Este e apenas um exemplo, mas voce podera adapta-lo ' +
'a sua realidade conforme a necessidade.';
AssignFile(F, 'LPT1');
Rewrite(F);
try
WriteLn(F, cJustif, Texto);
WriteLn(F, cEject);
finally
CloseFile(F);
end;
end;
Este recurso de justificação da Epson LX-300 pode ser usado em qualquer linguagem de programação.
{ Coloque o código abaixo imediatamente abaixo da palavra
implementation: }
const
SHFMT_ID_DEFAULT = $FFFF;
{ Opções de formatação }
SHFMT_OPT_QUICKFORMAT = $0000; { Formatação rápida }
SHFMT_OPT_FULL = $0001; { Formatação completa }
SHFMT_OPT_SYSONLY = $0002; { Copia sistema }
{ Códigos de errros }
SHFMT_ERROR = $FFFFFFFF; { Ocorreu erro }
SHFMT_CANCEL = $FFFFFFFE; { Foi cancelado }
SHFMT_NOFORMAT = $FFFFFFFD; { Não formatou }
function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word):
LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive'
{ Coloque um botão no form e altere o evento OnClick dele
conforme abaixo: }
procedure TForm1.Button3Click(Sender: TObject);
var
Erro: DWord;
Msg: string;
begin
Erro := SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);
case Erro of
SHFMT_ERROR: Msg := 'Ocorreu um erro.';
SHFMT_CANCEL: Msg := 'A formatação foi cancelada.';
SHFMT_NOFORMAT: Msg := 'Não foi possível formatar.';
else
Msg := 'Disco formatado com sucesso.';
end;
ShowMessage(Msg);
end;
Para formatação completa troque SHFMT_OPT_QUICKFORMAT por SHFMT_OPT_FULL. O segundo parâmetro (zero no exemplo) indica a unidade, sendo que A é 0 (zero), B é 1, etc.
Inclua na seção uses: tbPrn
{ - Peque em nosso Download o arquivo tbPrn.zip. Ele contém
a unit tbPrn.pas, onde está a função tbPrnSetPaperSize
usada no exemplo abaixo;
- Adicione a unit tbPrn.pas em seu projeto;
- Siga o exemplo abaixo para criar seus relatórios
usando o TPrinter.
}
procedure TForm1.Button1Click(Sender: TObject);
var
Papel: TtbPrnPaper;
begin
Papel.Size := 256; // 256 é o tam. personalizado
Papel.Width := 2100; // 21 cm
Papel.Height := 1000; // 10 cm
Papel := tbPrnSetPaperSize(Papel);
try
Printer.BeginDoc;
try
{ coloque aqui os comandos para impressão }
finally
Printer.EndDoc;
end;
finally
tbPrnSetPaperSize(Papel); // Restaura o tamanho
end;
end;
{ Papel.Size refere-se ao tamanho do papel. Veja alguns:
0 - Default
1 - Letter
5 - Legal
8 - A3
9 - A4
11 - A5
256 - Custom (personalizado) }
Só será necessário informar Papel.Height e Papel.Width quando Papel.Size for 256.
Inclua na seção uses: MMSystem
{ Síncrona: aguarda terminar a reprodução para continuar: }
SndPlaySound('C:\Win95\Media\Office97\Lembrete.wav', SND_SYNC);
{ Assíncrona: a execução continua normalmente enquanto
ocorre a reprodução: }
SndPlaySound('C:\Win95\Media\Office97\Lembrete.wav', SND_ASYNC);
{ Contínua: a reprodução é repetida num efeito de loop.
Este tipo de reprodução precisa ser assíncrona: }
SndPlaySound('C:\Win95\Media\Office97\Lembrete.wav',
SND_ASYNC or SND_LOOP);
{ Interrompe uma reprodução contínua: }
SndPlaySound(nil, 0);
A reprodução contínua pode ser usada, por exemplo, para altertar o usuário em uma situação extremamente crítica. Se o equipamento não possuir placa de som, o arquivo não será reproduzido.
Inclua na seção uses: Registry
{ Coloque um botão no form e altere seu evento OnCkick
como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegIniFile;
S: string;
begin
Reg := TRegIniFile.Create('SOFTWARE\MICROSOFT\MS SETUP (ACME)\');
try
S := Reg.ReadString('USER INFO','DefName','');
S := S + #13;
S := S + Reg.ReadString('USER INFO','DefCompany','');
ShowMessage(S);
finally
Reg.free;
end;
end;
Veja a pergunta nº 53.
Inclua na seção uses: ShellApi
{ - Coloque um botão no form e altere o evento OnClick
deste botão conforme abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
Dados: TSHFileOpStruct;
begin
FillChar(Dados,SizeOf(Dados), 0);
with Dados do
begin
wFunc := FO_COPY;
pFrom := PChar('c:\teste\*.txt');
pTo := PChar('a:\');
fFlags:= FOF_ALLOWUNDO;
end;
SHFileOperation(Dados);
end;
Esta forma de copiar arquivos oferecem várias vantagens. O Shell avisa para pôr um próximo disco quando o atual estiver cheio. Mostra a barra de progresso. Pode copiar arquivos usando máscara de uma forma extremamente simples.
{ - Coloque um Label no form (Label1);
- Mude a propriedade KeyPreview do form para true;
- Altere o evento OnKeyDown do form como abaixo: }
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Label1.Caption :=
Format('O código da tecla pressionada é: %d', [Key]);
end;
Para testar execute e observe o Label enquanto pressiona as teclas desejadas.
Inclua na seção uses: Windows
{ Você já observou a caixa "Propriedades", aquela que mostra
as propriedades de um arquivo no Windows Explorer, não
aparece na lista do Alt+Tab e tampouco na barra de tarefas?
Isto ocorre porque ela funciona como uma ToolWindow, enquanto
os demais aplicativos funcionam como AppWindow. Porém podemos
mudar o comportamento de nossos programas feito em Delphi
para que se comportem como uma ToolWindow também.
Para experimentar, crie um novo projeto e altere o
Project1.dpr como abaixo (não esqueça do uses):
}
program Project1;
uses
Forms, Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
var
ExtendedStyle : Integer;
begin
Application.Initialize;
ExtendedStyle := GetWindowLong(Application.Handle, gwl_ExStyle);
SetWindowLong(Application.Handle, gwl_ExStyle, ExtendedStyle or
ws_Ex_ToolWindow and not ws_Ex_AppWindow);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Ao executar observe a barra de tarefas e teste o Alt+Tab (seu programa não estará lá!).
{ Evento Som Padrão }
MessageBeep(0); { ou Beep; }
{ Evento Parada Crítica }
MessageBeep(16);
{ Evento Pergunta }
MessageBeep(32);
{ Evento Exclamação }
MessageBeep(48);
{ Evento Asterisco }
MessageBeep(64);
{ Usando número da coluna (zero é a primeira coluna): }
DBGrid1.SelectedIndex := 0;
{ Usando o nome do campo }
DBGrid1.SelectedField := Table1.FieldByName(Edit2.Text);
Aconselho usar o nome do campo quando o que importa é o campo e não a posição. Use o número da coluna somente quando o que importa é a posição, e não o campo.
{ Reinicia o Windows }
ExitWindowsEx(EWX_REBOOT, 0);
{ Desliga o Windows }
ExitWindowsEx(EWX_SHUTDOWN, 0);
{ Força todos os programa a desligarem-se }
ExitWindowsEx(EWX_FORCE, 0);
{ Altere o evento OnCreate do Form conforme abaixo: }
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.Cursors[1] :=
LoadCursorFromFile('c:\win95\cursors\globe.ani');
Button1.Cursor := 1;
end;
Para este exemplo é necessário ter o arquivo de cursor conforme apontado e também ter, no form, um Button1. Para usar este cursor em outros componentes basta atribuir à propriedade Cursor do componente em questão o valor 1 (um). Exemplo: Edit1.Cursor := 1; Form1.Cursor := 1;, etc.
Inclua na seção uses: ShellApi
{ Coloque a procedure abaixo na seção implementation }
procedure ArqParaLixeira(const NomeArq: string; var MsgErro: string);
var
Op: TSHFileOpStruct;
begin
MsgErro := '';
if not FileExists(NomeArq) then begin
MsgErro := 'Arquivo não encontrado.';
Exit;
end;
FillChar(Op, SizeOf(Op), 0);
with Op do begin
wFunc := FO_DELETE;
pFrom := PChar(NomeArq);
fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
end;
if ShFileOperation(Op) <> 0 then
MsgErro := 'Não foi possível enviar o arquivo para a lixeira.';
end;
{ - Coloque um botão no Form;
- Altere o evento OnClick do botão conforme abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
begin
ArqParaLixeira('c:\Diretorio\Teste.doc', S);
if S = '' then
ShowMessage('O arquivo foi enviado para a lixeira.')
else
ShowMessage(S);
end;
Table1.RecNo()
Se você está habituado a usar este código no filter... Table1.Filter := 'Nome = '''+ Edit1.Text + ''''; ou Table1.Filter := 'Data = ''' + DateToStr(Date) + ''''; Tente usar este: Table1.Filter := 'Nome = ' + QuotedStr(Edit1.Text); ou Table1.Filter := 'Data = ' + QuotedStr(DateToStr(Date));
A função QuitedStr() coloca apóstrofos envolvendo a string. Se houver um apóstrofo como parte da string, ela o subtitui por dois apóstrofos, para que seja corretamente interpretado.
Inclua na seção uses: MMSystem
PlaySound('C:\ArqSom.wav', 1, SND_ASYNC);
Troque o nome do arquivo (C:\ArqSom.wav) pelo arquivo desejado.
{ Coloque isto no evento OnClick de um botão: }
WinExec('command.com /c programa.exe',sw_ShowNormal);
{ Se quizer passar parâmetros pasta adicioná-los após o
nome do programa. Exemplo: }
WinExec('command.com /c programa.exe param1 param2',sw_ShowNormal);
Se quizer que a janela do programa não apareça, troque sw_ShowNormal por sw_Hide.
{ - Coloque um botão no form e altere seu evento OnClick
conforme abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
Janela: HWND;
begin
Janela := FindWindow('OpusApp'), nil);
if Janela = 0 then
ShowMessage('Programa não encontrado')
else
PostMessage(Janela, WM_QUIT, 0, 0);
end;
Este exemplo fecha o MS Word 97 se estiver aberto. A mensagem WM_QUIT fecha o programa da forma "ignorante". Isto significa que se houver dados não salvos, o programa a ser fechado não oportunidade para salvá-los. Uma alternativa mais suave é trocar a mensagem WM_QUIT por WM_CLOSE. Veja as perguntas 18 e 36.
{ - Coloque um TButton no Form;
- Altere o evento OnCreate do Form como abaixo: }
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Hint := 'Linha 1 da dica' + #13 +
'Linha 2 da dica' + #13 +
'Linha 3 da dica';
Button1.ShowHint := true;
end;
{ - Crie um novo projeto. Este já deverá ter o Form1;
- Adicione um novo Form (Form2);
- Coloque, no Form1, um TMediaPlayer (paleta System)
e um botão;
- Altere o evento OnClick do botão como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
begin
with MediaPlayer1 do begin
FileName := 'c:\speedis.avi';
Open;
{ Ajusta tamanho do Form }
with MediaPlayer1.DisplayRect do begin
Form2.ClientHeight := Bottom - Top;
Form2.ClientWidth := Right - Left;
end;
Display := Form2;
Form2.Show;
Play;
end;
end;
Em vez de ajustar o Form ao vídeo, podemos ajustar o vídeo ao Form. Para isto troque o trecho with..end; por MediaPlayer1.DisplayRect := Form2.ClientRect;
{ Abaixo da palavra implementation digite: }
type
TChars = set of Char;
function FilterChars(const S: string; const ValidChars: TChars): string;
var
I: integer;
begin
Result := '';
for I := 1 to Length(S) do
if S[I] in ValidChars then
Result := Result + S[I];
end;
{ Para usar a função:
- Coloque um botão no Form;
- Altere o evento OnClick deste botão conforme abaixo: }
procedure TForm1.Button4Click(Sender: TObject);
begin
{ Pega só letras }
ShowMessage(FilterChars('D63an*%i+/e68l13',
['A'..'Z', 'a'..'z']));
{ Pega só números }
ShowMessage(FilterChars('D63an*%i+/e68l13', ['0'..'9']));
end;
Se quizer usar este função em outras unit's, coloque a declaração do tipo TChars na seção interface. Coloque aí também uma declaração da função FilterChars. E não se esqueça da cláusula uses.
{ Isto coloca zeros à esquerda do número até completar 6 casas }
S := FormatFloat('000000', 5);
"S" precisa ser uma variável string.
{ - Coloque um Button no Form;
- Altere o evento OnClick deste Button conforme abaixo: }
procedure TForm1.Button2Click(Sender: TObject);
var
SR: TSearchRec;
I: integer;
Origem, Destino: string;
begin
I := FindFirst('c:\Origem\*.*', faAnyFile, SR);
while I = 0 do begin
if (SR.Attr and faDirectory) <> faDirectory then begin
Origem := 'c:\Origem\' + SR.Name;
Destino := 'c:\Destino\' + SR.Name;
if not CopyFile(PChar(Origem), PChar(Destino), true) then
ShowMessage('Erro ao copiar ' + Origem + ' para ' + Destino);
end;
I := FindNext(SR);
end;
end;
No exemplo acima, se o arquivo já existir no destino, a função falha (não copia). Para que a função possa sobreescrever o arquivo destino (caso exista), altere o último parâmetro de CopyFile para false. CUIDADO! Se um arquivo for sobreescrito, estará perdido para sempre! Veja as perguntas nº 35 e 53.
{ - Coloque um Button no Form;
- Altere o evento OnClick deste Button conforme abaixo: }
procedure TForm1.Button2Click(Sender: TObject);
var
Origem, Destino: string;
begin
Origem := 'c:\Origem\NomeArq.txt';
Destino := 'c:\Destino\NomeArq.txt';
if not CopyFile(PChar(Origem), PChar(Destino), true) then
ShowMessage('Erro ao copiar ' + Origem + ' para ' + Destino);
end;
No exemplo acima, se o arquivo já existir no destino, a função falha (não copia). Para que a função possa sobreescrever o arquivo destino (caso exista), altere o último parâmetro de CopyFile para false. CUIDADO! Se um arquivo for sobreescrito, estará perdido para sempre! Veja as perguntas nº 36 e 53.
procedure TForm1.Button3Click(Sender: TObject);
begin
{ Exibe as cores atuais dos Edit's }
ShowMessage(ColorToString(Edit1.Color));
ShowMessage(ColorToString(Edit2.Color));
{ Altera as cores dos Edit's }
Edit1.Color := StringToColor('clBlue');
Edit2.Color := StringToColor('$0080FF80');
end;
{ Coloque um Button no Form e altere o evento OnClick deste
como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
begin
{ Verifica o Delphi }
if FindWindow('TAppBuilder', nil) > 0 then
ShowMessage('O Delphi está aberto')
else
ShowMessage('O Delphi NÃO está aberto');
{ Verifica o Word }
if FindWindow('OpusApp', nil) > 0 then
ShowMessage('O Word está aberto')
else
ShowMessage('O Word NÃO está aberto');
{ Verifica o Excell }
if FindWindow('XLMAIN', nil) > 0 then
ShowMessage('O Excell está aberto')
else
ShowMessage('O Excell NÃO está aberto');
end;
Há uma margem de erro nesta verificação: pode haver outros programas que possuam uma janela com os mesmos nomes. Você mesmo pode criar aplicativos em Delphi e, propositadamente, criar uma janela com um destes nomes. Veja a pergunta nº 18.
{ - Coloque um Button no Form;
- Altere o evento OnClick do Button conforme abaixo: }
procedure TForm1.Button2Click(Sender: TObject);
var
SR: TSearchRec;
I: integer;
begin
I := FindFirst('c:\Teste\*.*', faAnyFile, SR);
while I = 0 do begin
if (SR.Attr and faDirectory) <> faDirectory then
if not DeleteFile('c:\Teste\' + SR.Name) then
ShowMessage('Não consegui excluir c:\Teste\' + SR.Name);
I := FindNext(SR);
end;
end;
No exemplo acima todos os arquivos do diretório c:\Teste serão excluídos. CUIDADO! Arquivos excluídos desta forma não vão para a lixeira. Veja a pergunta nº 46.
Inclua na seção uses: ComObj
{ - Coloque um botão no Form;
- Altere o evento OnClick do botão conforme abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
Word: Variant;
begin
{ Abre o Word }
Word := CreateOleObject('Word.Application');
try
{ Novo documento }
Word.Documents.Add;
try
{ Adiciona tabela de 2 linhas e 3 colunas }
Word.ActiveDocument.Tables.Add(
Range := Word.Selection.Range,
NumRows := 2,
NumColumns := 3);
{ Escreve na primeira célula }
Word.Selection.TypeText(Text := 'Linha 1, Coluna 1');
{ Próxima célula }
Word.Selection.MoveRight(12);
{ Escreve }
Word.Selection.TypeText(Text := 'Linha 1, Coluna 2');
Word.Selection.MoveRight(12);
Word.Selection.TypeText(Text := 'Linha 1, Coluna 3');
Word.Selection.MoveRight(12);
Word.Selection.TypeText(Text := 'Linha 2, Coluna 1');
Word.Selection.MoveRight(12);
Word.Selection.TypeText(Text := 'Linha 2, Coluna 2');
Word.Selection.MoveRight(12);
Word.Selection.TypeText(Text := 'Linha 2, Coluna 3');
{ Auto-Formata }
Word.Selection.Tables.Item(1).Select; { Seleciona a 1º tabela }
Word.Selection.Cells.AutoFit; { auto-formata }
{ Imprime 1 cópia }
Word.ActiveDocument.PrintOut(Copies := 1);
ShowMessage('Aguarde o término da impressão...');
{ Para salvar... }
Word.ActiveDocument.SaveAs(FileName := 'c:\Tabela.doc');
finally
{ Fecha documento }
Word.ActiveDocument.Close(SaveChanges := 0);
end;
finally
{ Fecha o Word }
Word.Quit;
end;
end;
Foram usados neste exemplo o Delphi4 e MS-Word97.
Inclua na seção uses: DbiProcs
Os componentes TTable e TQuery possuem a propriedade
RecordCount que indicam a quantidade de registros da tabela.
No entanto esta propriedade é dependente de filtros, ou
seja, se tivermos uma tabela com dez registros com campo
"Codigo" de 1 a 10 e aplicarmos o filtro mostrado a seguir,
a propriedade RecordCount retornará 5 e não 10.
Table1.Filter := 'Codigo <= 5';
Table1.Filtered := true;
Se quizermos obter a quantidade total de registros,
independentemente de filtros, devemos usar uma API do BDE
conforme abaixo:
var
Total: integer;
begin
Check(DbiGetRecordCount(Table1.Handle, Total));
ShowMessage('Total de registros: ' + IntToStr(Total));
end;
Para testar o exemplo acima, o Table1 precisa estar aberto.
{ Muitos programas Windows permitem apenas uma cópia em
execução de cada vez. Isto é interessante principalmente
quando é um grande aplicativo, pois duas cópias ao mesmo
tempo usuaria muito mais memória. Em aplicativos
desenvolvidos em Delphi podemos ter esta característica.
Vejamos:
- Crie um novo projeto;
- Mude o "Name" do Form1 para DPGFormPrinc;
- Altere o código-fonte do arquivo Project1.dpr
conforme abaixo: }
program Project1;
uses
Forms, Windows,
Unit1 in 'Unit1.pas' {DPGFormPrinc};
{$R *.RES}
var
Handle: THandle;
begin
Handle := FindWindow('TDPGFormPrinc', nil);
if Handle <> 0 then begin { Já está aberto }
Application.MessageBox('Este programa já está aberto. A cópia ' +
'anterior será ativada.', 'Programa já aberto', MB_OK);
if not IsWindowVisible(Handle) then
ShowWindow(Handle, SW_RESTORE);
SetForegroundWindow(Handle);
Exit;
end;
Application.Initialize;
Application.CreateForm(TDPGFormPrinc, DPGFormPrinc);
Application.Run;
end.
Para testar este programa você deverá compilar o projeto e fechar o Delphi. Depois, procure o Project1.exe (projeto compilado) usando o Windows Explorer e tente executá-lo mais de uma vez e veja o que acontece. Mas porque alterar o name do form principal para "DPGFormPrinc"? Este poderia ser qualquer outro nome, mas preferi usar as iniciais do meu nome (DPG). Procurei deixar um nome bem pessoal para não correr o risco de colocar um nome que possa ser encontrado em outro aplicativo do Windows. Por exemplo: se deixar Form1, será bem fácil encontrar outro aplicativo feito em Delphi que possua uma janela com este nome, o que causaria problema.
Inclua na seção uses: DbiProcs
{ Se estiver usando TTable, coloque nos eventos
AfterPost e AfterDelete a seguinte linha: }
dbiSaveChanges(Table1.Handle);
{ Para TQuery, a instrução é semelhante: }
dbiSaveChanges(Query1.Handle);
{ Quando usamos a propridade Position de um Form para
centralizá-lo estamos sujeitos a um inconveniente:
dependendo da posição/tamanho da barra de tarefas do
Windows, o nosso Form poderá ficar parcialmente coberto
por ela. Uma forma eficaz de resolver este problema é
posicionar o form considerando apenas a área livre do
Desktop. Vejamos este exemplo:
- Crie um novo projeto;
- Na seção implementation digite a procedure abaixo:
}
procedure FormPos(Form: TForm; const Horz, Vert: byte);
{ Horz: 1=esquerda, 2=centro, 3=direita
Vert: 1=topo, 2=centro, 3=em baixo }
var
R: TRect;
begin
if not SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0) then
R := Rect(0, 0, Screen.Width, Screen.Height);
with Form do
case Horz of
1: Form.Left := 0;
2: Form.Left := (R.Right - R.Left - Width) div 2;
3: Form.Left := R.Right - Width;
end;
with Form do
case Vert of
1: Form.Top := 0;
2: Form.Top := (R.Bottom - R.Top - Height) div 2;
3: Form.Top := R.Bottom - Height;
end;
end;
{ - Coloque dois TEdit's: Edit1 e Edit2;
- Coloque um TButton e altere o evento OnClick deste
conforme abaixo:
}
procedure TForm1.Button1Click(Sender: TObject);
begin
FormPos(Form1, StrToInt(Edit1.Text), StrToInt(Edit2.Text));
end;
Para testar, execute este exemplo e experimente digitar números de 1 a 3 em ambos os Edit's e clique no Button para ver o resultado. O Edit1 indica a posição horizontal (esquerda, centro e direita) e o Edit2 indica a posição vertical (topo, centro e em baixo).
{ Coloque um TButton no Form e altere o evento
OnClick deste botão como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('Largura: ' + IntToStr(Screen.Width) + #13 +
'Altura: ' + IntToStr(Screen.Height));
end;
O objeto Screen contém várias informações importantes: largura e altura da tela, fontes instaladas no Windows, etc.
Inclua na seção uses: System, SysUtils
{ - Crie um novo projeto;
- Na seção implementation da Unit1 digite a função abaixo: }
function DriveOk(Drive: Char): boolean;
var
I: byte;
begin
Drive := UpCase(Drive);
if not (Drive in ['A'..'Z']) then
raise Exception.Create('Unidade incorreta');
I := Ord(Drive) - 64;
Result := DiskSize(I) >= 0;
end;
{ - Coloque no Form1 um TEdit (Edit1)
- Coloque no Form1 um TButton
- Altere o evento OnClick do Button1 conforme abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
begin
if DriveOk(Edit1.Text[1]) then
ShowMessage('Drive OK')
else
ShowMessage('Drive não preparado');
end;
Para testar você deverá executar o exemplo e digitar no Edit a letra do drive a ser testado (não precisa os dois-pontos). Após digitar, clique no Button1.
{ Crie uma nova Unit conforme abaixo: }
unit uFormFunc;
interface
uses Forms, IniFiles, SysUtils, Messages, Windows;
procedure tbLoadFormStatus(Form: TForm; const Section: string);
procedure tbSaveFormStatus(Form: TForm; const Section: string);
implementation
procedure tbSaveFormStatus(Form: TForm; const Section: string);
var
Ini: TIniFile;
Maximized: boolean;
begin
Ini := TIniFile.Create(ChangeFileExt(
ExtractFileName(ParamStr(0)),'.INI'));
try
Maximized := Form.WindowState = wsMaximized;
Ini.WriteBool(Section, 'Maximized', Maximized);
if not Maximized then begin
Ini.WriteInteger(Section, 'Left', Form.Left);
Ini.WriteInteger(Section, 'Top', Form.Top);
Ini.WriteInteger(Section, 'Width', Form.Width);
Ini.WriteInteger(Section, 'Height', Form.Height);
end;
finally
Ini.Free;
end;
end;
procedure tbLoadFormStatus(Form: TForm; const Section: string);
var
Ini: TIniFile;
Maximized: boolean;
begin
Maximized := false; { Evita msg do compilador }
Ini := TIniFile.Create(ChangeFileExt(
ExtractFileName(ParamStr(0)),'.INI'));
try
Maximized := Ini.ReadBool(Section, 'Maximized', Maximized);
Form.Left := Ini.ReadInteger(Section, 'Left', Form.Left);
Form.Top := Ini.ReadInteger(Section, 'Top', Form.Top);
Form.Width := Ini.ReadInteger(Section, 'Width', Form.Width);
Form.Height := Ini.ReadInteger(Section, 'Height', Form.Height);
if Maximized then
Form.Perform(WM_SIZE, SIZE_MAXIMIZED, 0);
{ A propriedade WindowState apresenta Bug.
Por isto usei a mensagem WM_SIZE }
finally
Ini.Free;
end;
end;
end.
{
Em cada formulário que deseja salvar/restaurar:
- Inclua na seção uses: uFormFunc
- No evento OnShow digite:
tbLoadFormStatus(Self, Self.Name);
- No evento OnClose digite:
tbSaveFormStatus(Self, Self.Name);
}
O arquivo INI terá o nome do executável e extensão INI e será salvo no diretório do Windows. A palavra Self indica o Form relacionado com a unit em questão. Poderia ser, por exemplo, Form1, Form2, etc. Onde aparece Self.Name poderá ser colocado um nome a sua escolha. Este nome será usado como SectionName no arquivo INI e deve ser idêntico no evento OnShow e OnClose de um mesmo Form, porém para cada Form deverá ser usado um nome diferente.
Ou seja, gostaria que, ao visualizar ou imprimir um relatório
do Quick Report, saia em cada página apenas um registro,
mesmo que o espaço permita mais de um.
Existem pelo menos duas formas de resolver este problema:
1. A forma mais simples consiste em alterar a altura (Height)
da banda Detail do nosso relatório de modo que a altura
total da página seja inferior a duas vezes a altura da banda.
Desta forma, cada registro será impresso em uma nova página,
teoricamente por falta de espaço na página atual.
2. Uma outra forma mais sofisticada é usar o evento AfterPrint
da banda Detail. Nele testamos se ainda não chegou no fim
da tabela e, caso positivo, pedimos uma nova página:
if not Table1.EOF then
QuickRep1.NewPage;
Deve existir outras alternativas, mas as duas anteriores
funcionaram bem nos testes realizados.
Existem vários sites especializados no assunto, basta fazer uma busca
O evento OnGetEditMask ocorre quando entramos no modo de edição.
Neste momento podemos verificar em qual linha/coluna se
encontra o cursor e então, se quiser, poderá especificar uma
máscara de edição. Exemplo:
procedure TForm1.StringGrid1GetEditMask(Sender: TObject; ACol,
ARow: Integer; var Value: String);
begin
if (ARow = 1) and (ACol = 1) then
Value := '(999) 999-9999;1;_'; // Telefone
end;
O evento OnGetEditText ocorre também quando entramos no modo
de edição. Neste momento podemos manipularmos o texto da
célula atual (linha/coluna) e então podemos simular algo tal
como uma tabela onde opções podem ser digitadas através
de números. Exemplo:
procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol,
ARow: Integer; var Value: String);
begin
if (ARow = 1) and (ACol = 2) then begin
if StringGrid1.Cells[ACol, ARow] = 'Ótimo' then
Value := '1'
else if StringGrid1.Cells[ACol, ARow] = 'Regular' then
Value := '2'
else if StringGrid1.Cells[ACol, ARow] = 'Ruim' then
Value := '3';
end;
end;
O evento evento OnSetEditText ocorre quando saímos do modo de
edição. Neste momento podemos manipular a entrada e trocar
por um texto equivalente. Normalmente usamos este evento em
conjunto com o evento OnGetEditText. Exemplo:
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: String);
begin
if (ARow = 1) and (ACol = 2) then begin
if Value = '1' then
StringGrid1.Cells[ACol, ARow] := 'Ótimo'
else if Value = '2' then
StringGrid1.Cells[ACol, ARow] := 'Regular'
else if Value = '3' then
StringGrid1.Cells[ACol, ARow] := 'Ruim'
end;
end;
Para testar o exemplo anterior crie um novo projeto e coloque no Form1 um TStringGrid. Mude os três eventos mencionados conforme os exemplos. Execute e experimente digitar nas céluas 1 e 2 da primeira linha (na parte não fixada, é claro!).
{
* Crie um novo Projeto. Este certamente terá o Form1.
* Adicione um novo Form (Form2).
* Coloque no Form2 dois botões TBitBtn.
* Mude a propriedade Kind do BitBtn1 para bkOK.
* Mude a propriedade Kind do BitBtn2 para bkCancel.
* Vá no menu "Project/Options" na aba "Forms" e passe o
Form2 de "Auto-create Forms" para "Available Forms".
* Abra o arquivo Project.dpr (menu Project/View Source).
* Altere o conteúdo deste arquivo conforme abaixo:
}
program Project1;
uses
Forms, Controls,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};
{$R *.RES}
var
F: TForm2;
begin
F := TForm2.Create(Application);
try
if F.ShowModal = mrOK then begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
finally
F.Free;
end;
end.
O Form2 do exemplo é o Form de LogOn. Este deverá ser preparado para que se possa escolher o usuário, digitar a senha, etc.
Inclua na seção uses: Windows
{ Coloque um botão no form e altera o evento OnClick dele
conforme abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
R: TRect;
begin
{ Pega o retângulo da área cliente do form }
R := GetClientRect;
{ Converte as coordenadas do form em coordenadas da tela }
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
{ Limita a região de movimentação do mouse }
ClipCursor(@R);
ShowMessage('Tente mover o mouse para fora da área cliente do Form');
{ Libera a movimentação }
ClipCursor(nil);
end;
Cuidado! Isto pode irritar o usuário do seu programa.
Muitas vezes precisamos saber qual o nome de classe de uma determinada janela. Quando são janelas desenvolvidas por nós, você olha no código-fonte. Mas e se não for, como é o caso do Delphi? Por exemplo: Para verificar se o Delphi está sendo executado, procuramos no Windows pela janela cujo nome de classe seja TAppBuilder. Mas como verificar então se o Internet Explorer está sendo executado? Precisaremos saber o nome de classe da janela deste programa. Então o que fazer? Use o TBWinName. Pegue-o no download de www.ulbrajp.com.br/usuario/tecnobyte
Inclua na seção uses: Windows
{ Coloque no Form dois Botões: BotaoOcultar e BotaoExibir.
No evento OnClick do BotaoOcultar escreva: }
procedure TForm1.BotaoOcultarClick(Sender: TObject);
var
Janela: HWND;
begin
Janela := FindWindow('Shell_TrayWnd', nil);
if Janela > 0 then
ShowWindow(Janela, SW_HIDE);
end;
{ No evento OnClick do BotaoExibir escreva: }
procedure TForm1.BotaoExibirClick(Sender: TObject);
var
Janela: HWND;
begin
Janela := FindWindow('Shell_TrayWnd', nil);
if Janela > 0 then
ShowWindow(Janela, SW_SHOW);
end;
{ Execute e teste, clicando em ambos os botões }
A tarefa mais difícil é descobrir o nome de classe da janela da barra de tarefa do Windows, mas isto é fácil se você usar o TBWinName. Pegue-o no link download de www.ulbrajp.com.br/usuario/tecnobyte O resto é usar as APIs do Windows para manipulação de Janelas. Veja a pergunta nº 18.
Inclua na seção uses: Windows
{ Na seção "private" do Form principal acrescente: }
procedure AppMsg(var Msg: TMsg; var Handled: Boolean);
{ Na seção "implementation" acrescente (troque TForm1 para
o nome do seu form principal): }
procedure TForm1.AppMsg(var Msg: TMsg; var Handled: Boolean);
begin
if (Msg.Message = wm_SysCommand) and
(Msg.wParam = sc_ScreenSave) then
Handled := true;
end;
{ No evento "OnCreate" do form principal, coloque: }
Application.OnMessage := AppMsg;
Inclua na seção uses: Windows
{ Coloque um TTimer no Form desejado. Define a propriedade
Interval do Timer para 1000 (1 segundo). Modifique
o evento OnTimer do Timer conforme abaixo: }
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Handle, true);
FlashWindow(Application.Handle, true);
end;
Inclua na seção uses: Windows
{ Digite a procedure abaixo imediatamente após a palavra
implementation no código do seu formulário. }
procedure MouseParaControle(Controle: TControl);
var
IrPara: TPoint;
begin
IrPara.X := Controle.Left + (Controle.Width div 2);
IrPara.Y := Controle.Top + (Controle.Height div 2);
if Controle.Parent <> nil then
IrPara := Controle.Parent.ClientToScreen(IrPara);
SetCursorPos(IrPara.X, IrPara.Y);
end;
{ Para testar, coloque no Form um botão e troque o name dele
para btnOK e modifique o evento OnShow do Form
conforme abaixo: }
procedure TForm1.FormShow(Sender: TObject);
begin
MouseParaControle(btnOk);
end;
A função "MouseParaControle" recebe um parâmetro do tipo TControl. Isto significa que você poderá passar para ela qualquer controle do Delphi, tais como: TEdit, TButton, TSpeedButton, TPanel, etc. Pode ser até mesmo o próprio Form.
{ Coloque um TButton no form e escreva o evento OnClick
deste como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
Vermelho, Verde, Azul: byte;
MinhaCor: TColor;
begin
Vermelho := 0;
Verde := 200;
Azul := 150;
MinhaCor := TColor(RGB(Vermelho, Verde, Azul));
Form1.Color := MinhaCor;
end;
A quantidade de cada cor primária é um número de 0 a 255. Observe que a cor retornada pela função RGB() está no formato do Windows (ColorRef); é por isto que fiz a conversão TColor(RGB(...)).
{ Coloque o código abaixo no OnClick de um botão }
AddFontResource(PChar('c:\MyFonts\Monospac.ttf'));
Troque o nome do arquivo do exemplo anterior pelo nome desejado. Arquivos de fonte possuem uma das seguintes extensões: FON, FNT, TTF, FOT. Veja também a pergunta nº 10.
Inclua na seção uses: Printers
{ Coloque este código no OnClick de um botão }
with Printer.Fonts do
if IndexOf('Draft 10cpi') >= 0 then
ShowMessage('A impressora possui a fonte.')
else
ShowMessage('A impressora NÃO possui a fonte.');
Isto pode ser útil quando queremos usar fonte da impressora quando for uma matricial ou fonte do Windows quando for uma Jato de Tinta ou Laser. Veja também a pergunta nº 10.
{ Coloque este código no OnClick de um botão }
with Screen.Fonts do
if IndexOf('Courier New') >= 0 then
ShowMessage('A fonte está instalada.')
else
ShowMessage('A fonte não está instalada.');
Veja também a pergunta nº 11.
{ Coloque dois TEdit no form.
Coloque um TButton no form e altere o evento OnClick
deste botão como abaixo:
}
procedure TForm1.Button1Click(Sender: TObject);
var
DataHora: TSystemTime;
Data, Hora: TDateTime;
Ano, Mes, Dia,
H, M, S, Mil: word;
begin
Data := StrToDate(Edit1.Text);
Hora := StrToTime(Edit2.Text);
DecodeDate(Data, Ano, Mes, Dia);
DecodeTime(Hora, H, M, S, Mil);
with DataHora do begin
wYear := Ano;
wMonth := Mes;
wDay := Dia;
wHour := H;
wMinute := M;
wSecond := S;
wMilliseconds := Mil;
end;
SetLocalTime(DataHora);
end;
No Edit1 digite a nova data e no Edit2 digite a nova hora.
{ Mude a propriedade "KeyPreview" do Form para true. }
{ No evento "OnKeyPress" do Form acrescente o código abaixo: }
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then begin
Key := #0;
Perform(WM_NEXTDLGCTL, 1, 0);
end;
end;
{ Em StringGrid, escreva o evento OnKeyPress como abaixo: }
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
StringGrid1.Perform(WM_KEYDOWN, VK_TAB, 0);
end;
{ Em DBGrid, escreva o evento OnKeyPress como abaixo: }
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
DBGrid1.Perform(WM_KEYDOWN, VK_TAB, 0);
end;
É bom lembrar que a tecla ENTER no Windows tem seu papel já bem definido quando se trata de caixa de diálogo: executar a ação padrão, normalmente o botão OK. Se não tomar cuidado poderá confundir o usuário, em vez de ajudá-lo.
{ Na seção "private" do Form principal acrescente: }
procedure AppMsg(var Msg: TMsg; var Handled: Boolean);
{ Na seção "implementation" acrescente (troque TForm1 para
o nome do seu form principal): }
procedure TForm1.AppMsg(var Msg: TMsg; var Handled: Boolean);
begin
if Msg.Message = WM_KEYDOWN then
if Msg.wParam = 110 then
Msg.wParam := 188;
end;
{ No evento "OnCreate" do form principal, coloque: }
Application.OnMessage := AppMsg;
{ Uma segunda alternativa (José Geraldo - ES):
Coloque o código abaixo no evento OnKeyPress do componente
onde se quer a conversão (Edit, DBEdit, etc). Neste caso
a conversão funcionará apenas neste componente (óbvio). }
if Key = '.' then Key = DecimalSeparator;
Na primeira alternativa, sempre que for pressionado o ponto do teclado numérico (da direita do teclado), este será convertido para vírgula, independentemente do controle que estiver em foco. Já na segunda, o ponto pode ser de qualquer lugar do teclado.
Inclua na seção uses: Windows
{ Pausa por 1 segundo }
Sleep(1000);
{ Pausa por 10 segundos }
Sleep(10000);
Esta pausa não é interrompida pelo pressionamento de alguma tecla, como acontecia com InKey() do Clipper.
Inclua na seção uses: dbTables, DB
procedure CriaTabelaClientes;
var
Tabela: TTable;
begin
Tabela := TTable.Create(Application);
try
Tabela.DatabaseName := 'C:\';
{ ou Tabela.DatabaseName := 'NomeAlias'; }
Tabela.TableName := 'Clientes.DB';
Tabela.TableType := ttParadox; { ou ttDBase }
{ Somente Delphi4 }
if Tabela.Exists then { Se a tabela já existe... }
Exit;
{***}
{ Cria a tabela }
Tabela.FieldDefs.Add('Codigo', ftInteger, 0, true);
Tabela.FieldDefs.Add('Nome', ftString, 30, true);
Tabela.FieldDefs.Add('DataNasc', ftDate, 0, false);
Tabela.FieldDefs.Add('RendaMes', ftCurrency, 0, false);
Tabela.FieldDefs.Add('Ativo', ftBoolean, 0, true);
{ etc, etc, etc }
Tabela.CreateTable;
{ Cria os Índices }
Tabela.AddIndex('ICodigo', 'Codigo', [ixPrimary, ixUnique]);
Tabela.AddIndex('INome', 'Nome', [ixCaseInsensitive]);
{ etc, etc, etc }
finally
Tabela.Free;
end;
end;
Para verificar se o arquivo já existe na versão 3 ou anterior do Delphi, você deverá usar a função "FileExists" do Delphi.
Inclua na seção uses: FileCtrl, Dialogs
if DirectoryExists('C:\MEUSDOCS') then
ShowMessage('O diretório existe')
else
ShowMessage('O diretório não existe');
Inclua na seção uses: SysUtils, Dialogs
if FileExists('c:\carta.doc') then
ShowMessage('O arquivo existe')
else
ShowMessage('O arquivo não existe');
Inclua na seção uses: DB
{ Enxergar somente configurações da sessão atual }
Session.ConfigMode := cmSession;
{ Adicionar o Alias }
Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX');
Veja a pergunta nº 1.
Inclua na seção uses: DB
{ se o alias não existir... }
if not Session.IsAlias('MeuAlias') then
begin
{ Adiciona o alias }
Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX');
{ Salva o arquivo de configuração do BDE }
Session.SaveConfigFile;
end;
Para criar um alias do dBase troque a string 'PARADOX' por 'DBASE'. No caso acima usei como path o caminho "C:\DirProg", mas se você quiser poderá trocar este caminho por ExtractFilePath(ParamStr(0)) para que o alias seja direcionado para o local onde está seu .EXE. Neste último caso será necessário incluir na seção uses: SysUtils, System.