Atenção: por essa edição ser muito antiga não há arquivo PDF para download. Os artigos dessa edição estão disponíveis somente através do formato HTML.
50 DICAS !
|
Aí estão as 50 dicas (ufa...)!. É um pequena coletânea de dicas e macetes que não estão disponíveis na documentação da linguagem. Os temas são bem variados, indo desde operações com formulários, passando a rotinas de banco de dados e chegando a outras dicas de mais baixo nível. A criação desta matéria foi uma tarefa bem divertida para a equipe, onde todos aprendemos um pouco mais. Esperamos que as informações abaixo sejam de grande valia, da mesma forma que foram para nós |
.
Cancelando a exibição de um formulário:
Se a mensagem WM_CLOSE for enviada antes do for-mulário ser exibido, a sua exibição será cancelada:
procedure TForm1.Form1OnShow (Sender : TObject);
begin
...
PostMessage (Handle, wm_Close, 0, 0);
end;
Desabilitando o ALT+F4
Alguns aplicativos pedem pouquíssimas intervenções do usuário no sistema. Em alguns casos, é necessário não permitir que o usuário feche o programa, ou alterne utilizando a combinação ALT+TAB. Para inibir o ALT+F4, basta utilizar o evento onCloseQuery.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
CloseVariable: Boolean;
implementation
{$R *.DFM}
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := CloseVariable; // Se a variável CloseVariable for TRUE, o aplicativo será finalizado.
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CloseVariable := True; //No botão fechar, a variável CloseVariable é setada para TRUE
Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CloseVariable := False;
end;
end.
Para inibir as combinações ALT+TAB, CTRL+ESC e CTRL+ALT+DEL utilize o código abaixo:
procedure TForm1.Button1Click(Sender: TObject);
var
OldValue : LongBool;
begin
SystemParametersInfo(97, Word(True), @OldValue, 0);
end;
Nota: Para habilitar novamente as teclas, altere o segundo parâmetro para FALSE.
Executar um programa externo e aguardar o seu término:
Geralmente, quando existe a necessidade de executar um programar externo, a partir do aplicativo, a API WinExec é utilizada. Uma grande desvantagem desta API é o fato de passar o controle imediatamente para a próxima linha, independente do programa chamado ter terminado ou não. Para fazer com que o código espere o término do programa em questão, a API WaitForSingleObject pode ser utilizada. Ao invés de abrir o aplicativo com WinExec, devemos utilizar CreateProcess, que retorna um handle para WaitFor SingleObject:
procedure TForm1.Button1Click(Sender: TObject);
var
StartupInfo: TStartupinfo;
ProcessInfo: TProcessInformation;
begin
FillChar(Startupinfo,Sizeof(TStartupinfo),0);
Startupinfo.cb:=Sizeof(TStartupInfo);
if CreateProcess(nil, 'notepad.exe', nil, nil, false, normal_priority_class, nil, 'c:\windows', Startupinfo,
ProcessInfo) then
begin
WaitforSingleObject(Processinfo.hProcess, infinite);
CloseHandle(ProcessInfo.hProcess);
ShowMessage('Execução do Bloco de Notas encerrada.');
end;
end;
Convertendo as cores do Delphi para HTML Color:
Realmente a codificação de cores em HTML não é uma tarefa muito simples. Mais um interessante aplicativo pode ser construído com esta dica. Abaixo segue uma função para converter uma cor do Delphi para uma Cor HTML compatível:
function ColorToHex(Color: integer): string;
var
r,g,b: byte;
begin
r:=GetRValue(Color);
g:=GetGValue(Color);
b:=GetBValue(Color);
Result:=IntToHex(r,2)+IntToHex(g,2)+IntToHex(b,2);
end;
Verificar se o Sistema Operacional é Windows NT:
{$IFNDEF WIN32}
const WF_WINNT = $4000;
{$ENDIF}
function IsNT : bool;
{$IFDEF WIN32}
var
osv : TOSVERSIONINFO;
{$ENDIF}
begin
result := true;
{$IFDEF WIN32}
GetVersionEx(osv);
if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then exit;
{$ELSE}
if ((GetWinFlags and WF_WINNT) = WF_WINNT ) then exit;
{$ENDIF}
result := false;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsNt then
ShowMessage(‘Rodando no NT’) ;
end;
Nota: Este código funciona também para aplicações 16 bits
Capturar o pressionamento da tecla PrintScreen:
Esta é a tecla mais rebelde do keyboard. O seu pressionamento não é capturado pelos eventos defualt KeyDown e KeyPress. A API GetAsyncKeyState pode ser utilizada para recuperar o pressionamento desta tecla. Esta função pode ser utilizada num timer, ou em alguma rotina em loop. Neste caso, preferi utilizar o evento OnIdle, do objeto Application:
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnIdle := AppIdle;
end;
procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
begin
if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then
Form1.Caption := ‘PrintScreen acionada !’;
Done := True;
end;
Recuperar a velocidade da CPU:
Esta interessante função recupera a velocidade de processamento aproximada da CPU:
const
ID_BIT=$200000; // EFLAGS ID bit
function GetCPUSpeed: Double;
const
DelayTime = 500;
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin
try
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread,THREAD _PRIORITY_TIME_CRITICAL);
Sleep(10);
asm
dw 310Fh // rdtsc
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh // rdtsc
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000.0 * DelayTime);
except end;
end;
No evento OnClick, basta atribuir a saída da função a uma string:
procedure TForm1.Button1Click(Sender: TObject);
var cpuspeed:string;
begin
cpuspeed:=Format('%f MHz', [GetCPUSpeed]);
edit1.text := cpuspeed;
end;
Capturar o Desktop e salvar num objeto Timage:
A procedure GetDC permite capturar um handle de desenho para o Desktop do Windows:
procedure TForm1.Button1Click(Sender: TObject);
var
DC : HDC;
ABitmap:TBitmap;
begin
DC := GetDC (GetDesktopWindow);
ABitmap:=TBitmap.Create;
try
ABitmap.Width := GetDeviceCaps (DC,HORZRES);
ABitmap.Height := GetDeviceCaps (DC,VERTRES);
BitBlt(ABitmap.Canvas.Handle, 0, 0, ABitmap.Width,
ABitmap.Height,DC, 0, 0, SRCCOPY);
finally
ReleaseDC (GetDesktopWindow, DC);
end;
Image1.Picture.Bitmap := ABitmap;
end;
Desenhando no Desktop do windows:
A função GetDC também permite o desenho no Desktop do Windows. O exemplo abaixo imprime uma simples linha, mas qualquer função de desenho pode ser utilizada (inclusive a BITBLT!):
procedure TForm1.BitBtn1Click(Sender:TObject);
var
dc : hdc;
begin
dc := GetDc(0);
MoveToEx(Dc, 0, 0, nil);
LineTo(Dc, 300, 300);
end;
Criar um arquivo Texto:
Esta é uma das mais pedidas no nosso email de suporte. Veja abaixo os passos básicos para criação de arquivos texto:
Var
F:TextFile;
Begin
AssignFile(f,'c:\arquivo_qualquer.txt');
Rewrite(f); //abre o arquivo para escrita
Writeln(f,'Testando'); //escreve no arquivo e desce uma linha
Write(f,'Clube Delphi'); //escreve no arquivo sem descer a linha
Closefile(f); //fecha o handle de arquivo
End;
///Rotina para ler de um arquivo texto:
var
f:TextFile;
linha:String;
begin
AssignFile(f,'c:\arquivo_qualquer.txt');
Reset(f); //abre o arquivo para leitura;
While not eof(f) do begin
Readln(f,linha); //le do arquivo e desce uma linha. O conteúdo lido é transferido para a variável linha
Memo1.lines.add(linha);
End;
Closefile(f);
end;
Deletar um diretório inteiro de uma vez:
Problemas para deletar um diretório com subdiretórios? Utilize a função abaixo:
Uses
Shellapi, filectrl,
function DeleteFolder(FolderName: String; LeaveFolder: Boolean): Boolean;
var
r: TshFileOpStruct;
begin
Result := False;
if not DirectoryExists(FolderName) then Exit;
if LeaveFolder then FolderName := FolderName + ‘ *.* ‘
else if FolderName[Length(FolderName)] = ‘ \ ‘ then
Delete(FolderName,Length(FolderName), 1);
FillChar(r, SizeOf(r), 0);
r.wFunc := FO_DELETE;
r.pFrom := PChar(FolderName);
r.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
Result := ((ShFileOperation(r) = 0) and (not r.fAnyOperationsAborted));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
deleteFolder(‘c:\temp’,false);
end;
Configurando os botões de uma MessageBox:
A messageBox realmente decepciona quando exibe seus botões com o caption: "Yes" ou "No". Seria bem bem mais elegante se tivéssemos os botões sempre em português. Ou, uma caixa com apenas um botão, mas com alguma frase mais significativa do que um simples OK. A função CreateMessageDlg cria um objeto Tform, com toda a aparência da MessageDlg. Portanto, basta configurar as propriedades dos objetos criados:
procedure TForm1.Button1Click(Sender: TObject);
var
i:Integer;
f:Tform;
begin
f := CreateMessageDialog('Deseja mesmo formatar o HD?',mtConfirmation,[mbYes,mbNo]);
try
for i:=0 to f.ComponentCount-1 do
if f.Components[i] is tButton then
with TButton(f.Components[i]) do
case modalResult of
mrYes: Caption := 'Sim';
mrNo: Caption := 'Não';
end;
f.caption:='Titulo alterado'; // É possível, também, alterar o caption da janela
f.Showmodal;
finally
f.free;
End;
end;
Armazenando imagens sem gravar no BD:
Uma das grandes vantagens de armazenar imagens fora do banco de dados é a economia de espaço no banco. O database fica bem mais leve e rápido. Várias soluções podem ser utilizadas. Uma delas, é criar um cópia da imagem em um diretório específico, trocando o nome do arquivo pela chave primária. Por exemplo, se possuirmos o cliente número 10, sua foto seria 10.bmp. Veja abaixo um exemplo de unit que utiliza este algoritmo:
//Insira um objeto Timage e utilize o seu evento OnDblClick para escolher a imagem:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtDlgs, ExtCtrls, DBCtrls, StdCtrls, Mask, Db, DBTables;
type
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
Label5: TLabel;
DBNavigator1: TDBNavigator;
OpenPictureDialog1: TOpenPictureDialog;
Table1CustNo: TFloatField;
Table1Company: TStringField;
Table1Addr1: TStringField;
Table1Addr2: TStringField;
Label1: TLabel;
DBEdit1: TDBEdit;
Label2: TLabel;
DBEdit2: TDBEdit;
Label3: TLabel;
DBEdit3: TDBEdit;
Label4: TLabel;
DBEdit4: TDBEdit;
Image1: TImage;
procedure Image1DblClick(Sender:TObject);
procedure Table1AfterScroll(DataSet:TDataSet);
procedure FormClose(Sender: TObject; var
Action: TCloseAction);
private
public
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.DFM}
procedure TForm1.Image1DblClick(Sender: TObject);
var
b,c:Array[0..200] of char;
begin
if OpenPictureDialog1.Execute then begin
StrPCopy(b,OpenPIctureDialog1.Filename);
StrPCopy(c,'C:\'+Table1.Fieldbyname ('CustNo').asString+'.BMP');
CopyFile(b,c,FALSE);
Image1.Picture.LoadFromFile('c:\'+Table1.Fieldbyname ('custno').asString+'.BMP');
End;
end;
procedure TForm1.Table1AfterScroll(DataSet: TDataSet);
begin
try
image1.picture.loadfromfile('C:\'+Table1.Fieldbyname ('CustNo').asString+'.BMP');
Image1.Visible:=True;
except
Image1.Visible:=False;
End;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
form2.close;
end;
end.
Como substituir uma DLL em uso:
Em algumas situações é necessário a deleção ou substituição de uma DLL. O problema ocorre quando a biblioteca está sendo utilizada - o arquivo fica bloqueado, e se torna impossível qualquer alteração no mesmo. O próprio windows apresenta uma solução para este problema: a rotina apresentada abaixo, cria uma chave de registro, indicando que no próximo boot, o arquivo deverá ser sobreposto:
procedure TForm1.Button1Click(Sender: TObject);
var
Origem:array[0..200] of char;
destino:array[0..200] of char;
begin
StrPcopy(origem,'c:\temp\Arquivo.dll'); //indique o caminho de origem do arquivo - origem e destino deverão estar no mesmo volume StrPcopy (destino,'c:\Arquivo.dll');
If Win32Platform = VER_PLATFORM_WIN32_NT Then
MoveFileEx( Origem ,destino ,MOVEFILE_REPLACE_EXISTING or MOVEFILE_DELAY_UNTIL_REBOOT)
Else
WritePrivateProfileString('rename',destino ,origem ,'wininit.ini' );
end;
Esta mesma dica pode ser utilizada para apagar o arquivo no próximo boot. Basta atribuir NULL para o arquivo de destino.
Não consegue conectar ao Access com o Driver BDE nativo:
Muitos possuem este problema. Ao tentar conectar o driver nativo com um arquivo .MDB, vários errospodem ser gerados, como por exemplo "Cannot load na IDAPI Service Library', 'Connect Error', ou outros. Resolver este problema pode ser simples:
Access 2000 - Não é recomendável utilizar este banco com o driver nativo. Utilize o ADO ou BDE+ODBC.
Access 95, 97 - Certifique se o BDE está corretamente configurado. Na palheta configuration, selecione o item drivers->native->Access. A propriedade DLL32 deverá ser configurada da seguinte forma:
Access 95 -> IDDAO32.DLL (DAO 3.0)
Access 97 -> IDDA3532.DLL (DAO 3.5)
Executar os comandos Compact/Repair Database do Access:
O Access oferece os comandos para compactação e reparação do banco de dados, mas não nenhum método exposto no Delphi para realizar esta tarefa. Uma solução é instanciar um objeto DAO e utilizar seus métodos:
Compactando:
Uses comobj;
var
dao: OLEVariant;
begin
dao := CreateOleObject('DAO.DBEngine.35');
dao.CompactDatabase('d:\yourDatabaseName.mdb',
'd:\yourNewCompactedDatabaseName.mdb');
end;
Reparando o banco de dados:
Uses comobj;
var
dao: OLEVariant;
begin
dao := CreateOleObject('DAO.DBEngine.35');
dao.RepairDatabase('d:\yourDatabaseName.mdb');
end;
Nota: Se a versão utilizada não for a 3.5, subsitua a linha 'CreateOleObject('DAO.DBEngine.35') para o número de versão correto.
Gerar uma tabela no Word através do Delphi:
Existem várias formas de realizar esta tarefa. Abaixo um trecho de código bem prático para isto:
Inclua na seção uses: ComObj
{ - Coloque um botão no Form; - Altere o evento OnClick do botão conforme abaixo: }
procedure TForm1.Button2Click(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 } { 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;
A versão do Word utilizada neste exemplo foi a Word97.
Acessar tabelas paradox de um CD:
Este é um problema grave: criar uma aplicativo em CD-ROM com tabelas paradox. A princípio, nada de mais. O fato ocorre quando o aplicativo é acessado pela rede: O BDE tenta criar o arquivo PDOXUSR.LCK, na unidade do CD! Este é um arquivo utilizado pelo paradox para controlar os acessos simultâneos a uma tabela. Uma solução bem simples é gravar o CD juntamente com o arquivo PDOXUSR. Quando a tabela for acessada, o BDE não irá tentar sobrescrever o arquivo.
Nome das portas seriais instaladas:
O nome das saídas seriais fica armazenada no registro do sistema. O código lê o conteúdo da chave e exibe em um objeto Tmemo:
Uses registry;
procedure TForm1.Button3Click(Sender: TObject);
var
reg : TRegistry;
ts : TStrings;
i : integer;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('hardware\devicemap\serialcomm',
false);
ts := TStringList.Create;
reg.GetValueNames(ts);
for i := 0 to ts.Count -1 do begin
Memo1.Lines.Add(reg.ReadString(ts.Strings[i]));
end;
ts.Free;
reg.CloseKey;
reg.free;
end;
Converter uma aplicação ISAPI para CGI:
Uma aplicação ISAPI normalmente possui um arquivo de projeto parecido com o exemplo abaixo:
library Project2;
uses
WebBroker,
ISAPIApp,
Unit1 in ‘Unit1.pas’ {WebModule1: TWebModule};
{$R *.RES}
exports
GetExtensionVersion,
HttpExtensionProc,
TerminateExtension;
begin
Application.Initialize;
Application.CreateForm(TWebModule1, WebModule1);
Application.Run;
end.
Basta alterar a cláusula USES. Substitua a unit ISAPIAPP por CGIAPP:
uses
WebBroker,
CGIApp,
Unit1 in ‘Unit1.pas’ {WebModule1: TWebModule};
E recompile o projeto! O inverso também pode ser feito.
Verificar se o CD contém Áudio:
Passe a letra do drive do CD correspondente para a função abaixo. Se for um CD de áudio, irá retornar verdadeiro:
Function AudioCD(Drive : Char) : Boolean;
Var
FSFlags, MaxLength: DWORD;VolName, Path : String;
Begin
Path := Drive + ‘:\’;
Result := FALSE;
if (GetDriveType(PChar(Path)) = DRIVE_CDROM) then Begin
SetLength(VolName, 64);
GetVolumeInformation(PChar(Path), PChar(VolName), Length(VolName), nil, MaxLength, FSFlags, nil,0);
if (lStrCmp(PChar(VolName),’Audio CD’) = 0) Then Result := TRUE;
End;
end;
Conectar a um servidor Interbase Remoto:
Esta é uma das primeiras dúvidas quando a aplicação Interbase entra na rede. Como configurar corretamente o BDE para reconhecer um servidor Interbase na rede? Basta configurar o protocolo correto, e a propriedade PATH de acordo com a tela abaixo:
Repare que esta configuração representa a máquina BDE cliente. A sintaxe é:
NOME_DO_SERVIDOR_NA_REDE:caminho físico do banco
Note que o caminho digitado é o caminho local do banco, no servidor. Para configurar o objeto IBDatabase, proceda conforme a figura abaixo:
Capturar o endereço da porta paralela:
A função em assembler abaixo permite capturar o endereço da porta paralela. A função só irá funcionar no Windows9x. No Windows NT, só com um driver de acesso:
function GetPortAddress(PortNo: integer): word; assembler; stdcall;
asm
push es
push ebx
mov ebx, PortNo
shl ebx,1
mov ax,40h // Dos segment adress
mov es,ax
mov ax,ES:[ebx+6]
pop ebx
pop es
end;
No evento clique de um botão, o código abaixo pode ser digitado:
procedure TForm1.Button1Click(Sender: TObject);
begin
memo1.lines.add(intTohex(GetPortAddress(1),4));
end;
Como ler e escrever um byte diretamente para a porta paralela:
value:=port[$379]; { ler da porta }
port[$379]:=value; { escrever na porta }
O comando port só funciona no Windows 9x.
Como ler e escrever na porta serial:
function Tform1.ReadPort(Address:Word):Word;
asm
mov dx,Address
in ax,dx
end;
Procedure Tform1.WritePort(Address,Data:Word);
asm
mov dx,Address
mov ax,Data
out dx,ax
end;
Para habilitar a leitura/escrita na porta serial através do Windows NT, é preciso utilizar um driver especial para que o acesso ao hardware seja habilitado (já que o NT não o permite, por motivos de segurança). Um bom driver para isto é o GIVEIO, que pode ser baixado da página do clube, no endereço www.clubedelphi.com.br/aplicativos/giveio.zip.
Para instalar o aplicativo Giveio, execute o aplicativo LoadDrv, digite 'caminho\giveio.sys' e clique no botão Install. Se necessário, vá no painel de controles, clique no ícone Devices, selecione o driver GiveIo, clique no botão StartUp, e configure-o para iniciar automaticamente.
Em seguida, digite a rotina abaixo no evento onCreate do formulário principal do aplicativo. Isto irá referenciar o aplicativo ao driver GIVEIO:
procedure TForm1.FormCreate(Sender: TObject);
var
h :Thandle;
begin
h:=createfile('\\.\\giveio',GENERIC_READ,0,nil, OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
if h=INVALID_HANDLE_VALUE then showmessage('Erro ao carregar o driver GIVEIO');
Createfile('COM2',GENERIC_READ+generic_write,0,nil,
OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
End;
Filtrando um campo DATA:
O comando CAST, do SQL permite realizar a conversão de tipos dentro da consulta. Isto pode ser útil em várias situações. Um exemplo prático de uso deste comando, é o filtro parcial por Data. O exemplo abaixo recupera todas as datas com final 94:
Select SaleDate from orders
where (CAST (SaleDate as CHAR(10)) LIKE "%94")
"Table is Full"
Esta mensagem aparece caso a tabela ultrapasse os 256 mb de tamanho. Isto porque, por default, as tabelas paradox possuem como tamanho de bloco (blockSize) 4k. O tamanho máximo de blocos é 64k, totalizando 256 mb. O tamanho do bloco de dados pode ser configurado no BDE, na palheta Configuration->Drivers->Native->Paradox. Os tamanhos de blocos válidos são: 1024, 2048, 4096, 16384 e 32768. Se um for definido um tamanho de bloco maior do que 4k, a propriedade Level deverá ser configurada para 5. Por último, crie uma nova tabela e mova os dados da tabela original.
Recuperar URL do Netscape:
Basta realizar uma comunicação DDE:
Uses ddeman;
procedure TForm1.Button1Click(Sender: TObject);
var
DDE: TDdeClientConv;
begin
DDE := TDdeClientConv.Create(self);
if DDE.SetLink( 'Netscape', 'WWW_GetWindowInfo' ) then
Edit1.Text := DDE.RequestData( '0xFFFFFFFF, sURL, sTitle' )
Else
Edit1.Text := '#Erro';
DDE.Free;
end;
Como armazenar e reproduzir arquivos WAV em tabelas PARADOX:
Esta dica vale também para outros formatos de arquivo. Os métodos LoadFromFile e SaveToFile de um Tfield podem ser utilizados para armazenar qualquer arquivo binário. O campo deverá ser do tipo BLOB (binary large field object)
procedure TForm1.bnSaveClick(Sender: TObject);
begin
MediaPlayer1.Close;
tabWaves.Append;
{tabWavesAudioData é um campo BLOB}
tabWavesAudioData.LoadFromFile
(MediaPlayer1.FileName);
tabWavesDescription.Value := MediaPlayer1.FileName;
tabWaves.Post;
end;
procedure TForm1.LoadWaveFromTable;
begin
MediaPlayer2.Close;
tabWavesAudioData.SaveToFile( 'C:\Temp\WAVETABLE.wav' );
MediaPlayer2.FileName := 'C:\Temp\WAVETABLE.wav';
MediaPlayer2.Open;
End;
Imprimindo arquivos RTF de forma rápida:
O objeto TrichEdit carrega todo o arquivo para a memória, antes de imprimir. Além de ser um procedimento lento, pode não funcionar se o arquivo for muito grande. Segue abaixo uma rotina "suja" para resolver este problema. A procedure executa o WordPad para realizar a impressão, já que o WordPad não carrega todo o arquivo antes de iniciar a impressão. Repare que o segredo está no parâmetro /p, passado juntamente com o arquivo:
procedure TForm1.Button1Click(Sender: TObject);
begin
shellExecute(form1.handle, nil, 'write.exe', 'c:\myfile.rtf /p', nil, SW_HIDE);
end;
Imprimindo no modo rápido:
Já reparou como o NotePad realiza a impressão de modo muito mais veloz? É porque este aplicativo utiliza as fontes da própria impressora, enviando apenas os caracteres para o gerenciador de impressão. Nosso aplicativo pode fazer o mesmo, através da API getStockObject:
uses printers;
procedure TForm1.Button1Click(Sender: TObject);
var
tm : TTextMetric;
i : integer;
begin
Printer.BeginDoc;
Printer.Canvas.Font.Handle := GetStockObject(DEVICE_DEFAULT_FONT);
GetTextMetrics(Printer.Canvas.Handle,tm);
for i := 1 to 10 do begin
Printer.Canvas.TextOut(100,
i * tm.tmHeight +
tm.tmExternalLeading,
‘Test’);
end;
Printer.EndDoc;
end;
Verificar se existe informação no buffer da porta serial:
A função ClearCommError permite verificar se existe algum byte a ser lido na porta serial:
procedure DataInBuffer(Handle: THandle;
var InQueue, OutQueue: integer);
var ComStat: TComStat;
e: integer;
begin
if ClearCommError(Handle, e, @ComStat) then
begin
InQueue := ComStat.cbInQue;
OutQueue := ComStat.cbOutQue;
end
else
begin
InQueue := 0;
OutQueue := 0;
end;
end;
Executando Querys em Threads separados:
Colocar um query dentro de um thread pode oferecer vantagens bem interessantes. Se o sistema for multiprocessado com windows NT, a query em um thread separado será executada por um processador diferente da aplicação. É possível rodar duas querys ao mesmo tempo, uma em cada processador - já que o Nt é o responsável pela distribuição das threads em diferentes processadores. Outra grande vantagem é que o usuário pode cotinuar utilizando o sistema, enquanto a query roda em background, em um thread separado do sistema.
Para criar um sistema deste tipo, alguns cuidados devem ser tomados. Vejamos:
1) A query separada em uma thread precisa de um objeto Session independente para a mesma;
2) Se o objeto Database estiver sendo utilizado, um novo objeto Database deverá ser criado para a query em questão
3) A query não pode se conectar com um datasource contido no contexto local da thread. Somente em um datasource pertencente a thread principal do aplicativo.
Vejamos utilizar este recurso na prática:
Crie uma aplicação nova no delphi. No form em branco, insira dois objetos Tsession, dois objetos Tdatabase, dois objetos query, dois objetos Tdatasource, dois objetos TdbGrid e um objeto Tbutton. Configure-os de acordo com a tabela a seguir:
Session1
Active True;
SessionName "Ses1"
DataBase1
AliasName "IBLOCAL"
DatabaseName "DB1"
SessionName "Ses1"
Query1
DataBaseName "DB1"
SessionName "Ses1"
SQL.Strings "Select * from employee"
DataSource1
DataSet ""
DBGrid1
DataSource DataSource1
Session2
Active True;
SessionName "Ses2"
DataBase2
AliasName "IBLOCAL"
DatabaseName "DB2"
SessionName "Ses2"
Query2
DataBaseName "DB2"
SessionName "Ses2"
SQL.Strings "Select * from customer"
DataSource2
DataSet ""
DBGrid1
DataSource DataSource2
Repare que os objetos DataSource não devem estar conectados com nenhum outro objeto. Em seguida, preencha a unit conforme listado a seguir:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes,Graphics, Controls,Forms, Dialogs,
StdCtrls, Grids, DBGrids, DB, DBTables;
type
TForm1 = class(TForm)
Session1: TSession;
Session2: TSession;
Database1: TDatabase;
Database2: TDatabase;
Query1: TQuery;
Query2: TQuery;
DataSource1: TDataSource;
DataSource2: TDataSource;
DBGrid1: TDBGrid;
DBGrid2: TDBGrid;
GoBtn1: TButton;
procedure Button1Click(Sender: TObject);
end;
TQueryThread = class(TThread)
Private
FSession: TSession;
FDatabase: TDataBase;
FQuery: TQuery;
FDatasource: TDatasource;
FQueryException: Exception;
procedure ConnectDataSource;
procedure ShowQryError;
protected
procedure Execute; override;
public
constructor Create(Session: TSession; DataBase:
TDatabase; Query: TQuery; DataSource: TDataSource);
virtual;
end;
var
Form1: TForm1;
implementation
constructor TQueryThread.Create(Session: TSession; DataBase:
Tdatabase; Query: TQuery; Datasource: TDataSource);
begin
inherited Create(True);
FSession := Session;
FDatabase := DataBase;
FQuery := Query;
FDataSource := Datasource;
FreeOnTerminate := True;
Resume;
end;
procedure TQueryThread.Execute;
begin
try
FQuery.Open;
Synchronize(ConnectDataSource);
except
FQueryException := ExceptObject as Exception;
Synchronize(ShowQryError);
end;
end;
procedure TQueryThread.ConnectDataSource;
begin
FDataSource.DataSet := FQuery;
end;
procedure TQueryThread.ShowQryError;
begin
Application.ShowException(FQueryException);
end;
procedure RunBackgroundQuery(Session: TSession; DataBase:
TDataBase;
Query: TQuery; DataSource:
TDataSource);
begin
TQueryThread.Create(Session, Database, Query, DataSource);
end;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
RunBackgroundQuery(Session1, DataBase1, Query1,
Datasource1);
RunBackgroundQuery(Session2, DataBase2, Query2,
Datasource2);
end;
end.
Pesquisando um valor em todos os campos da tabela:
Basta utilizar a cláusula OR, unindo todos os campos dentro da SQL. Ex:
Select * from clientes
Where nome like “%CLUBE%” or
Endereco like “%CLUBE%” or
Cidade like “%CLUBE %” ...
Este tipo de SQL pode ser útil para criar uma consulta genérica a tabela – exibindo como resultado a ocorrência do valor em qualquer campo da tabela.
Atribuindo NULL a um campo da tabela:
A linha de código Tabela1.fieldbyname ('campo').asString:='' é muito utilizada para zerar o conteúdo de um campo. A linha de código abaixo atribui realmente NULL ao campo :
Tabela1.Fieldbyname('Campo').Value := NULL;
O valor '' não torna o campo como NULL, e sim como uma string vazia. Já a palavra NULL realmente elimina qualquer conteúdo do campo.
Capturando a impressora padrão e preenchendo uma lista com o nome das impressoras:
Impressora Padrão:
procedure TForm1.Button2Click(Sender: TObject);
Var
Driver, port, Device: String;
DeviceMode : THandle;
begin
SetLength(Driver, 255);
SetLength(Port, 255);
SetLength(Device, 255);
Printer.GetPrinter (PChar(Device), PChar(Driver), PChar(Port), DeviceMode);
Label4.Caption := Device;
Label5.Caption := Driver;
Label6.Caption := Port;
end;
Retornando as impressoras instaladas:
listbox1.Items:=Printer.Printers;
Discando com o Delphi:
implementation
function tapiRequestMakeCall(ipszDestAddress, ipszAppName, ipszCalledParty, ipszComment: LPCSTR): LongInt; StdCall; External 'tapi32.dll';
Obs.:Para efetuar ligação com o Delphi é necessário uma só função
que recebe quatro parametros que são do tipo PChar.
Estes são:
- Numero do telefone a ser discado.Este número pode ter os seguintes caracteres especiais que estão entre aspas:"+" "(" "-" ",".
- Nome da Aplicação.
- Nome de quem será chamado.
- Um comentário qualquer.
procedure TForm1.Button1Click(Sender: TObject);
Var
Telefone: Array[0..50] of Char;
Nome: Array[0..50] of Char;
begin
StrPCopy(Telefone, EdtTelefone.Text); //numero do telefone
StrPCopy(Nome, EdtNome.Text); //nome de quem esta chamando
tapiRequestMakeCall(Telefone, PChar(Application.Title), Nome, 'Teste');
end;
Executando Stored Procedures a partir do objeto IBSQL:
Para executar procedures a partir do objeto IBSQL, é necessário incluir o comando EXECUTE PROCEDURE antes do nome da procedure em questão, na propriedade SQL. Veja um exemplo:
Procedure TForm1.Button1Click(Sender: TObject);
Begin
IBSQL1.SQL.Clear;
IBSQL1.SQL.Add('execute procedure new_key');
IBSQL1.ExecQuery;
End;
Para capturar o valor retornado pela procedure, consulte a propriedade Current:
Procedure TForm1.Button1Click(Sender: TObject);
Begin
IBSQL1.SQL.Clear;
IBSQL1.SQL.Add('execute procedure new_key');
IBSQL1.ExecQuery;
Label1.Caption := IBSQL1.Current.Vars[0].AsString;
End;
Colorindo o DBGrid:
Seria muito interessante se pudéssemos colorir determinadas linhas do DbGrid, de acordo com alguma condição. O exemplo abaixo colore a linha de vermelho, caso o saldo esteja negativo:
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if (table1.fieldbyname('saldo').asFloat<0)
DbGrid1.Canvas.Brush.Color:=clRed;
dbgrid1.DefaultDrawColumnCell(rect,datacol, column,state);
end;
Capturando e Setando as teclas CAPS, NUM LOCK e SCROLL:
Para ler o status das teclas:
procedure TForm1.Button1Click(Sender: TObject);
var
keys: TKeyboardState;
begin
{1 = on, 0 = off}
GetKeyboardState( keys );
if keys[VK_NUMLOCK] = 1 then
label1.caption:='NUMLOCK ON'
Else
label1.caption:='NUMLOCK OFF';
if keys[VK_CAPITAL] = 1 then
label2.caption:='CAPSLOCK ON'
Else
label2.caption:='CAPSLOCK OFF';
if keys[VK_SCROLL] = 1 then
label3.caption:='SCROLL ON'
else
label3.caption:='SCROLL OFF';
end;
Para setar um valor à tecla:
procedure TForm1.BitBtn1Click(Sender: TObject);
var
keys: TKeyboardState;
begin
{1 = on, 0 = off}
GetKeyboardState( keys );
keys[VK_NUMLOCK] := 1; {Num Lock}
keys[VK_CAPITAL] := 1; {Caps Lock}
keys[VK_SCROLL] := 1; {Scroll Lock}
SetKeyboardState( keys );
end;
Confirmando a gravação do registro no Paradox:
No clipper, era possível forçar a gravação em disco dos dados no buffer, através do comando COMMIT (não confundir com COMMIT/ROLLBACK). No Paradox, este recursos também está disponível, através da API DbiSaveChanges:
Uses dbiTypes, dbiProcs;
procedure TForm1.Button2Click(Sender: TObject);
begin
Table1.Post;
DbisaveChanges(Table1.Handle);
end;
O uso deste comando previne a perda de dados em uma eventual queda de energia, ou pane no computador.
Exibindo um bitmap no fundo de um form MDI:
Por default, um form MDI não aceita nenhuma conteúdo em seu interior, a não ser menus e toolbars. Para inserir um bitmap no fundo do formulário, siga os passos :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Cadastro1: TMenuItem;
Clientes1: TMenuItem;
Produtos1: TMenuItem;
Sair1: TMenuItem;
Image1: TImage;
procedure Clientes1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: TMessage);
public
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.DFM}
procedure Tform1.ClientWndProc(var Message: TMessage);var Dc : hDC;
Row : Integer; Col : Integer;
begin
with Message do
case Msg of
WM_ERASEBKGND: begin
Dc := TWMEraseBkGnd(Message).Dc;
for Row := 0 to ClientHeight div Image1.Picture.Height do
for Col := 0 to ClientWidth div
Image1.Picture.Width do
BitBlt(Dc, Col * Image1.Picture.Width,
Row * Image1.Picture.Height, Image1.Picture.Width,
Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg , wParam, lParam);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;
end.
Recuperando a data da páscoa:
function Pascoa(ano: Integer): TDate;
var y, m, d: Word;
G, I, J, C, H, L: Integer;
E: TDate;
begin
G := ano mod 19;
C := ano div 100;
H := (C - C div 4 - (8*C+13) div 25 + 19*G + 15) mod 30;
I := H - (H div 28)*(1 - (H div 28)*(29 div (H + 1))*((21 - G) div 11));
J := (ano + ano div 4 + I + 2 - C + C div 4) mod 7;
L := I - J;
m := 3 + (L + 40) div 44;
d := L + 28 - 31*(m div 4);
y := ano;
E := EncodeDate(y, m, d);
while DayOfWeek(E) > 1 do
E := E + 1;
Result := E;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
d:TDate;
begin
d:=Pascoa(2000);
showmessage(DateToStr(d));
end;
Descobrindo a resolução atual do Vídeo:
Basta utilizar as propriedades Width e Height do objeto Screen:
Procedure Tform1.button1click(sender:Tobject);
Begin
Label1:='Largura:’+IntTOStr(Screen.Width);
Label2:='Altura:‘+IntToStr(Screen.Height);
End;
Enviando um arquivo para a lixeira:
uses ShellAPI;
Function DeleteFileWithUndo(sFileName : string ) : boolean;
var
fos : TSHFileOpStruct;
Begin
FillChar( fos, SizeOf( fos ), 0 );
With fos do begin
wFunc := FO_DELETE;
pFrom := PChar( sFileName );
fFlags := FOF_ALLOWUNDO
or FOF_NOCONFIRMATION
or FOF_SILENT;
end;
Result := ( 0 = ShFileOperation( fos ) );
end;
Criando um Shell com o Delphi:
O Explorer é um aplicativo Shell do windows. Ou seja, é a interface gráfica primária , fazendo com que todos os outros aplicativos rodem sobre sua form. O Desktop, os ícones, tudo pertence ao executável do Explorer. É possível criar um Shell proprietário e substituir o WinExplorer nesta função. É uma grande vantagem para criar sistemas onde o usuário não pode fazer mais nada a não ser operar o software. Ou então para sistemas mais robustos, como controladores de máquinas industriais, ou mesmo uma interface mais ousada. Para configurar sua aplicação como shell, faça o seguinte:
No arquivo system.ini, existe a linha:
Shell=Explorer.exe Altere para Shell=meu_aplicativo.exe
E Ok!. O formulário principal de seu aplicativo será o único item carregado pelo Windows!
Selecionando os registros não contidos em um Select:
Uma opção que pode ser útil em alguns casos, é criar uma seleção inversa. Ou seja, recuperar os registros que NÃO se encontrem em determinada situação. Veja o SQL :
Select COD_CLIENTE from Pedidos
Where Data_Pedido = '20/06/2000'
Este SQL retorna os cliente que fizeram pedido em 20/06/2000. Mas se o objetivo for relatar os clientes que não fizeram pedido nesta data? Cuidado pois o operador <> pode trazer todos os clientes.
O SQL abaixo resolve este problema:
Select * from Clientes
Where
Codigo NOT IN
(Select cod_Cliente from pedidos where data_pedido = '20/06/2000')
Trabalhando com índices compostos no DBASE:
Este tipo de índice é um pouco diferente no DBASE, se comparado ao Paradox. No DBASE, para um índice possuir mais de um campo, devemos criar expressões de índices. Veja a figura abaixo:
Quando um índice composto é criado no Paradox, a pesquisa pode ser feita através do método FindKey:
Table1.FindKey([campo1,campo2,..]);
Porém, este recurso não funciona no DBASE. Ao invés, utilize os métodos SetKey e GotoKey:
Table1.IndexName:='Nome_do_Indice_Composto';
Table1.setKey;
Table1Cod_Cli.Value:=1;
Table1Data.Value:=date;
Table1.GotoKey;
Imprimir na mão com preview:
Quem tem experiência em desenvolvimento de relatório, sabe que algumas situações exigem a construção de um relatório "na mão". Ou seja, utilizando o objeto Tprinter. A grande desvantagem de utilizar este objeto é a falta de um recurso automático para criação de preview. Porém, há um macete: no lugar do objeto Tprinter, podemos utilizar o objeto TqrPrinter, e linká-lo a um formulário de preview do QuickReport. Veja o código abaixo:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Printers, QRPrntr, QRPrev, StdCtrls ;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
private
public
procedure OnClosePreview(Sender: TObject; var Action: TCloseAction);
procedure PreviewReport(Sender: TObject);
end;
var
Form1: TForm1;
r:TqrPrinter;
implementation
uses Unit2;
{$R *.DFM}
{$R Quickrpt.res}
procedure TForm1.OnClosePreview(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
r.Free;
end;
{A procedure abaixo é utilizada para criar o formulário de preview. Repare que todos os hints podem ser alterados.}
procedure TForm1.PreviewReport(Sender: TObject);
begin
with TQRStandardPreview.Create(Self) do
begin
ZoomFit.Hint := '';
Zoom100.Hint := '';
ZoomToWidth.Hint := '';
FirstPage.Hint := '';
PreviousPage.Hint := '';
ToolButton2.Hint := '';
LastPage.Hint := '';
PrintSetup.Hint := '';
Print.Hint := '';
SaveReport.Hint := '';
LoadReport.Hint := '';
ExitButton.Caption := '';
OnClose := OnClosePreview;
QRPreview.QRPrinter := TQRPrinter(Sender);
Caption := 'Visualizando Impressão - ' + TQRPrinter(Sender).Title;
WindowState := wsMaximized;
Show;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
r := TqrPrinter.Create;
r.OnPreview:=PreviewReport;
r.BeginDoc;
r.NewPage;
r.Canvas.textout(10,10,'Página 1 - Clube Delphi');
r.NewPage;
r.Canvas.textout(10,10,'Página 2 - www.clubedelphi.com.br');
r.EndDoc;
r.Preview;
end;
end.
Movimentando a janela clicando em qualquer área do form:
type
Tform1 = class(Tform)
public
procedure WMNChitTest(var M: TWMNchitTest); message WM_NCHITTEST;
End;
procedure TForm1.WMNChitTest(var M:TWMNChitTest);
begin
inherited;
if M.Result = htclient then
M.Result:=htCaption;
End;
