Artigo Clube Delphi Edição 10

Esse artigo faz parte da revista�Clube Delphi edi��o 10. Clique aqui para ler todos os artigos desta edi��o

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;

�

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:

�

Imagem

�

�� 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:

�

Imagem

�

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

�

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;

�

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;

Confira outros conte�dos:

Instalando o ACBr

Mapeamento Objeto-Relacional com TMS...

Introdu��o aos componentes JEDI

Assista grátis a nossa aula inaugural

Perguntas frequentes

Quem somos?

Por que a programação se tornou a profissão mais promissora da atualidade?

Como faço para começar a estudar?

Em quanto tempo de estudo vou me tornar um programador?

Sim, você pode se tornar um programador e não precisa ter diploma de curso superior!

O que eu irei aprender estudando pela DevMedia?

Principais diferenciais da DevMedia

Qual o investimento financeiro que preciso fazer para me tornar um programador?

Como funciona a forma de pagamento da DevMedia?

Por Devmedia Em 2009

Nossos casos de sucesso

Leonardo Carlos

Eu sabia pouqu�ssimas coisas de programa��o antes de come�ar a estudar com voc�s, fui me especializando em v�rias �reas e ferramentas que tinham na plataforma, e com essa bagagem consegui um est�gio logo no in�cio do meu primeiro per�odo na faculdade.

Lucas Rodrigues

Estudo aqui na Dev desde o meio do ano passado! Nesse per�odo a Dev me ajudou a crescer muito aqui no trampo.
Fui o primeiro desenvolvedor contratado pela minha empresa. Hoje eu lidero um time de desenvolvimento!
Minha meta � continuar estudando e praticando para ser um Full-Stack Dev!

Her�clito J�nior

Economizei 3 meses para assinar a plataforma e sendo sincero valeu muito a pena, pois a plataforma � bem intuitiva e muuuuito did�tica a metodologia de ensino. Sinto que estou EVOLUINDO a cada dia. Muito obrigado!

Julio Cablen

Nossa! Plataforma maravilhosa. To amando o curso de desenvolvimento front-end, tinha coisas que eu ainda n�o tinha visto. A did�tica � do jeito que qualquer pessoa consegue aprender. S�rio, to apaixonado, adorando demais.

Joelberth Sena

Adquiri o curso de voc�s e logo percebi que s�o os melhores do Brasil. � um passo a passo incr�vel. S� n�o aprende quem n�o quer. Foi o melhor investimento da minha vida!

Felipe Nunes

Foi um dos melhores investimentos que j� fiz na vida e tenho aprendido bastante com a plataforma. Voc�s est�o fazendo parte da minha jornada nesse mundo da programa��o, irei assinar meu contrato como programador gra�as a plataforma.

Wanderson Oliveira

Comprei a assinatura tem uma semana, aprendi mais do que 4 meses estudando outros cursos. Exerc�cios pr�ticos que n�o tem como n�o aprender, est�o de parab�ns!

Jos� Lucas

Obrigado DevMedia, nunca presenciei uma plataforma de ensino t�o presente na vida acad�mica de seus alunos, parab�ns!

Eduardo Dorneles

Aprendi React na plataforma da DevMedia h� cerca de 1 ano e meio... Hoje estou h� 1 ano empregado trabalhando 100% com React!

Adauto Junior

J� fiz alguns cursos na �rea e nenhum � t�o bom quanto o de voc�s. Estou aprendendo muito, muito obrigado por existirem. Est�o de parab�ns... Espero um dia conseguir um emprego na �rea.

Ver todos os casos de sucesso

Artigo Clube Delphi Edi��o 10 - 50 DICAS !

Artigo da Revista Clube Delphi Edi��o 10.

Confira outros conte�dos:

Instalando o ACBr

Mapeamento Objeto-Relacional com TMS...

Introdu��o aos componentes JEDI

Perguntas frequentes

Nossos casos de sucesso