1 - Localize o arquivo RS_RUN.INI (no diretório do Windows); 

2 - Na seção [ReportSmith] inclua a linha seguinte: 

ShowAboutBox=0 

3 - Na seção [RS_RunTime] inclua a linha seguinte: 

ShowAboutBox=0 

4 - Não se esqueça de distribuir com o seu aplicativo o referido arquivo INI. 

Function ExtractDiskSerial(Drive:String):String;

Var Serial:DWord;

DirLen,Flags: DWord;

DLabel : Array[0..11] of Char;

begin

GetVolumeInformation(PChar(Drive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);

Result := IntToHex(Serial,8);

end;

Para tratar erros de forma genérica, em todo o seu programa, insira no método ON CREATE do formulário
principal a linha:

Application.OnException:=RotinaGeral;

Rotina Geral é uma procedure na qual deverá constar o código para verificar e enviar as mensagens de erro do seu
sistema.

ExtractFilePath( Application.ExeName )

Primeiro, coloque a propriedade KeyPreview do formulário como TRUE. Depois, insira este código no evento
OnKeyDown do formulário:



procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

if Key = VK_F5 then

showMessage('I pressed the F5 key');

end;



Você também pode usar as variáveis VK_F1 até VK_F12 referentes as outras teclas de função.

No relatório, criar a procedure SHOWPREVIEW contendo:



PROCEDURE Showpreview;

begin

preview.showmodal;

end;



aonde preview e' o nome do form criado para preview não esquecer de incluir o nome da procedure na cláusula
uses.

Após isso, deve-se incluir no evento CREATE do formulário principal ou o do relatório o direcionamento do
objeto Qprinter, com a seguir:

qprinter.onpreview:=showpreview;

Isto faz com que toda vez que se desejar exibir um preview, o programa abra a rotina 'showpreview', que abre o
formulário criado, chamado "preview'.

Function NumDiasExtenso(NumDias:integer):string;

var

Anos, Meses, Dias : integer;

sAnos, sMeses, sDias : string;

begin

{ --- Calcula o número de anos --- }

Anos := 0;

while NumDias >= 365 do

begin

Anos := Anos + 1;

NumDias := NumDias - 365;

end;

if Anos > 1 then

sAnos := ' anos,'

else

sAnos := ' ano,';



{ --- Calcula o número de meses --- }

Meses := 0;

while NumDias >= 30 do

begin

Meses := Meses + 1;

NumDias := NumDias - 30;

end;

if Meses > 1 then

sMeses := ' meses e '

else

sAnos := ' mês e ';



{ --- O Número de dias é a sobra --- }

Dias := NumDias;

if sDias > 1 then

sDias := 'dias'

else

sDias := 'dia';



Return :=

Inttostr(Anos)+sAnos+inttostr(Meses)+sMeses+inttostr(Dias)+sDias;

end;

procedure TForm1.FormResize(Sender: TObject);

var

R : TRect;

DC : HDc;

Canv : TCanvas;

begin

R := Rect( 0, 0, Screen.Width, Screen.Height );

DC := GetWindowDC( GetDeskTopWindow );

Canv := TCanvas.Create;

Canv.Handle := DC;

Canvas.CopyRect( R, Canv, R );

ReleaseDC( GetDeskTopWindow, DC );

end;

Se você quiser executar uma única copia do aplicativo, o código de inicializacao do arquivo fonte do PROJETO
pode ser escrito conforme segue:



begin

if HprevHist = 0 then begin

Aplication.CreateForm( TForm1, Form1 ) 

Aplication.Run 

end

else 

MessageDlg( 'Você não pode executar outra copia do aplicativo',

mtInformation, [ mbOK ], 0 ) 

end.

Com esse código o usuário pode iniciar uma nova copia do aplicativo somente se não houver outra anterior. Caso
contrario é exibido uma mensagem para o usuário.

Às vezes os controles automáticos que o Delphi nos proporciona podem ser incômodos. Um exemplo disso é a
combinação CTRL+DEL em um DBGrid (o pressionamento destas teclas excluem o registro em foco). Por exemplo,
se estamos montando um tela de consulta, os registros não podem ser excluídos. Para Desabilitar CTRL+DEL
devemos analisar qual tecla foi pressionada através da variável KEY, que está disponível no evento OnKeyDown.
Veja o exemplo: 

procedure Tform1.DBGrid1KeyDown(Sender: TObject; 

var Key: Word; Shift: TShiftState); 

begin 

if (Shift = [ssCtrl]) and (Key = 46) Then 

KEY := 0 

end; 

Como posso saber a coluna que estou posicionado no DBGrid?

É fácil saber a coluna que você está no DBGrid. Para isso vamos usar a propriedade SelectedIndex que retorna o
número da coluna. Veja um exemplo: 

procedure Tform1.DBGrid1ColEnter(Sender:TObject); 

begin 

Edit1.Text := IntToStr(DBGrid1.SelectedIndex); 

end; 

Como mudar de uma coluna para outra pressionando a tecla ENTER ?

Para isso vamos utilizar novamente o evento OnKeyDown e analisar a variável KEY. Se a variável KEY tiver o
valor vk_Return, ou seja, foi pressionada a tecla ENTER, então devemos somar + 1 ao número da coluna em foco,
que mudará para a coluna seguinte. Veja o exemplo: 

procedure TForm1.DBGrid1KeyDown(Sender:TObject; 

var Key: Word;Shift: TShiftState); 

begin 

if KEY = vk_Return Then 

DBGrid1.SelectedIndex := DBGrid1.SelectedIndex + 1; 

end; 

Como posso redefinir uma função das teclas de função (F2 a F12) ?

Por exemplo, F3 armazena uma frase qualquer, ou dispare um comando. Em relação a gráficos, o Delphi 2 traz OCX
(VBX), como o ChartFx e outros. 

Para usar as teclas de função, você deve usar o evento OnKeyDown (de qualquer componente). Novamente,
vamos analisar a variável KEY. Veja o exemplo: 

procedure Tform1.FormKeyDown(Sender:TObject; 

var Key: Word; Shift: TShifState); 

begin 

if Key = vk_F3 Then 

ShowMessage(‘Foi pressionada a tecla F3’) 

end; 

Para que isto funcione adequadamente, mude a propriedade 

KeyPreview para True. 

Passos:

1- Insira um componente TcolorDialog no form;
2- Insira um SpeedButton (ou um outro botão) no form;
3- No evento OnClick do botão insira este código: 

procedure Tform1.SpeedButton1Click(Sender: TObject);
begin
with ColorDialog1 do
begin
Color := Tform1.Color;
if Execute then
Tform1.Color := Color;
end;
end;

Para movimentar o ponteiro do mouse sem intervenção do usuário, deve-se usar um TTimer e colocar o seguinte
código em seu evento OnTimer: 

procedure TForm1.Timer1Timer(Sender: TObject); 
var 
pt:tpoint; 
begin 
getcursorpos(pt); 
pt.x := pt.x + 1; 
pt.y := pt.y + 1; 
if pt.x>=screen.width-1 then setcursorpos(0,pt.y); 
if pt.y>=screen.height-1 then setcursorpos(pt.x,0); 
end; 

Para chamar a caixa de diálogo da conexão da rede DialUp, pode-se usar o WinExec, como a seguir: 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
winexec(PChar('rundll32.exe rnaui.dll,RnaDial '+Edit1.Text),sw_show); 
end; 

Para compactar (remover fisicamente todos registros apagados) de uma tabela Paradox deve-se utilizar o seguinte
código:

procedure ParadoxPack(Tabela : TTable);
var
Props: CURProps;
hDb: hDBIDb;
TableDesc: CRTblDesc;
Table : TTable;
begin
Tabela.Close;
Table:= TTable.Create(Application.MainForm);
Table.DatabaseName := Tabela.DatabaseName;
Table.TableName := Tabela.TableName;
Table.Exclusive := True;
Table.Open;
Check(DbiGetCursorProps(Table.Handle, Props));
if Props.szTableType = szPARADOX then
begin
FillChar(TableDesc, sizeof(TableDesc), 0);
Check(DbiGetObjFromObj(hDBIObj(Table.Handle),objDATABASE, hDBIObj(hDb)));
StrPCopy(TableDesc.szTblName, Table.TableName);
StrPCopy(TableDesc.szTblType, Props.szTableType);
TableDesc.bPack := True;
Table.Close;
Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False));
end;
Table.Free; 
end; 

Inclua o código abaixo em um Form. 

type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;
procedure WMInitMenuPopup(var Msg: TWMInitMenuPopup);
message WM_INITMENUPOPUP;
procedure WMNCHitTest(var Msg: TWMNCHitTest);
message WM_NCHitTest;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
inherited;
with Msg.MinMaxInfo^ do
begin
ptMinTrackSize.x:= form1.width;
ptMaxTrackSize.x:= form1.width;
ptMinTrackSize.y:= form1.height;
ptMaxTrackSize.y:= form1.height;
end;
end;
procedure TForm1.WMInitMenuPopup(var Msg: TWMInitMenuPopup);
begin
inherited;
if Msg.SystemMenu then
EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_GRAYED)
end;
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
with Msg do
if Result in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,HTBOTTOMLEFT, HTTOP,
HTTOPRIGHT, HTTOPLEFT] then
Result:= HTNOWHERE
end; 

Se alguém já estiver alterando um registro e você tentar alterar o Delphi retornará uma mensagem de erro da qual
você poderá obter o nome do usuário que está realizando a operação no momento.

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
try
Table1.Edit;
except on E:EDBEngineError do
if E.Errors[0].ErrorCode = 10241 then
begin
ShowMessage('Mensagem de erro'+E.Errors[0].Message );
ShowMessage( 'Arquivo com erro'+E.Errors[1].Message );
ShowMessage( 'Nome do usuario'+ E.Errors[2].Message );
end;
end;
end;

Label1.Caption := 'Data da Bios: '+String(PChar(Ptr($FFFF5))); 

VAR
Pic : TPicture;
TI : TIcon;
BEGIN
TI := TIcon.Create;
TI.Handle := ExtractIcon(HInstance, FileNameBuf, 0);
Pic := TPicture.Create;
Pic.Icon := TI;
Image1.Picture := Pic; {TImage}
BitBtn1.Glyph := TBitmap.Create;
WITH BitBtn1.Glyph DO
BEGIN
width := TI.Width;
Height := TI.Height;
Canvas.Draw(0, 0, Pic.Icon);
END;
END; 

Se você quiser executar uma única copia do aplicativo, o código de inicializacao do arquivo fonte do PROJETO
pode ser escrito conforme segue:

Var
HWnd : Thandle;
Begin
Hwnd:= Findwindow(‘Tform1’,’Uma Cópia’ //caption do Form Principal);
if Hwnd = 0 then 
begin
Aplication.CreateForm( TForm1, Form1 )
Aplication.Run
end
else
MessageDlg( 'Você não pode executar outra copia do aplicativo',
mtInformation, [ mbOK ], 0 )
SetForegroundwindow(hwnd);
end.

Com esse código o usuário pode iniciar uma nova copia do aplicativo somente se não houver outra anterior. Caso
contrario é exibido uma mensagem para o usuário.

Para imprimir apenas o registro corrente no QuickReport basta você não informar nada na propriedade
DataSource do componente QuickReport.

Para abrir uma tabela Paradox você deve informar no evento OnCreate do formulário principal a seguinte linha:

Session.AddPassword('TESTE');

A Palavra TESTE seria a senha.

DbiRegenIndexes(Table.Handle);

O parâmetro é a propriedade Handle do componente Table. 

Uma coisa que pode ser muito útil em suporte a distância, ou até mesmo pra outros objetivos, é a realização de um
"print-scrren" coisa que muitas vezes um usuário não dá conta de realizar e fica complicado, de certa maneira,
explicar por telefone. Por este motivo criamos uma rotininha que simula a tecla PrintScreen. A baixo a rotina de
como realizar tal processo:

procedure TForm1.Button1Click(Sender: TObject);
begin
keybd_event(VK_PRINT, 0, 0, 0);
keybd_event(VK_PRINT, 0, KEYEVENT_KEYUP, 0);
end;

Uma dúvida muito frequente em nossos mails são referentes a troca de impressoras em determinados relatórios. A
rotina que apresentamos a seguir realiza essa troca:

procedure TForm1.FormShow(Sender: TObject);
var
i: integer;
begin
// Limpa a lista de impressoras mostradas
ListBoc1.Items.Clear;
// Atualiza listbox com nome das impressoras
for i := 1 to Printer.Printers.Count do
ListBox1.Items.Add(Printers[i - 1]);
end;
Para selecionar uma determinada impressora, basta atribuir um inteiro à Printer.PrinterIndex, como você verá a
seguir:
Printer.PrinterIndex := ListBox1.ItemIndex; 

Vamos tentar mostrar um exemplo bem simples sobre o assunto.
Esta procedure configura o tamanho do papel em Run-Time para ser utilizado com o objeto TPrinter; Esta
procedure deve ser chamada antes de aplicar o método Printer.BeginDoc:

procedure TForm1.SetPrinterPage(Width, Height : LongInt);
var
Device : array[0..255] of char;
Driver : array[0..255] of char;
Port : array[0..255] of char;
hDMode : THandle;
PDMode : PDEVMODE;
begin
Printer.GetPrinter(Device, Driver, Port, hDMode);
If hDMode <> 0 then
begin
pDMode := GlobalLock( hDMode );
If pDMode <> nil then
begin
pDMode^.dmPaperSize := DMPAPER_USER;
pDMode^.dmPaperWidth := Width;
pDMode^.dmPaperLength := Height;
pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE;
GlobalUnlock( hDMode );
end;
end;
end; 

SystemParametersInfo(SPI_SETSCREENSAVEACTIVE , 0, nil, 0); 
{Desliga a proteção de tela} 
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE , 1, nil, 0); 
{Liga a proteção de tela} 

{ Declare a Winsock na clausula uses da unit }

Function GetIP:string; 
var
WSAData: TWSAData;
HostEnt: PHostEnt;
Name:string;
begin
WSAStartup(2, WSAData);
SetLength(Name, 255);
Gethostname(PChar(Name), 255);
SetLength(Name, StrLen(PChar(Name)));
HostEnt := gethostbyname(PChar(Name));
with HostEnt^ do
begin
Result := Format('%d.%d.%d.%d',[Byte(h_addr^[0]),Byte(h_addr^[1]),Byte(h_addr^[2]),Byte(h_addr^[3])]);
end;
WSACleanup;
end; 

{Para esconder a barra de tarefas do Windows, digite a seguinte rotina}

procedure hideTaskbar;
var
wndHandle : THandle;
wndClass: array [0..50] of Char;
begin
StrPCopy (@wndClass[0], 'Shell_TrayWnd');
wndHandle:= FindWindow (@wndClass[0], nil);
ShowWindow(wndHandle, SW_HIDE);
end;

{E para mostrar novamente, digite a rotina abaixo: }

procedure showTaskbar;
var
wndHandle: THandle;
wndClass : array [0..50] of Char;
begin
StrPCopy(@wndClass[0], 'Shell_TrayWnd');
wndHandle:= FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_RESTORE);
end; 

{Para desabilitar o Ctrl+Alt+Del, o Alt+Tab e o Ctrl+Esc, utilize a seguinte rotina }

procedure TNomeDoForm.ButtonNameClick(Sender: TObject);
var
Numero : Integer;
begin
SystemParametersInfo (97, Word (True), @Numero, 0);
end; 

{E para reabilitar, utilize a rotina abaixo: }

procedure TNomeDoForm.ButtonName2Click(Sender: TObject);
var
Numero : Integer;
begin
SystemParametersInfo(97, Word (False), @Numero, 0);
end; 

{Uma boa maneira de se evitar pirataria é colocar um arquivo como número serial do HD. Ao abrir o programa é só
comparar:se não for o mesmo é porque o programa foi copiado para outro computador. Para se descobrir o
número, faça o seguinte }

function SerialNum (FDrive : String) : String;
var
Serial : DWord;
DirLen, Flags : DWord;
DLabel : array [0..11] of char;
begin
try
GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);
Result := IntToHex (Serial, 8);
except
Result := '';
end;
end; 

{Os bancos de dados normalmente gravam dados da tabela na memória, ao invés de gravar diretamente no
arquivo o tempo todo, para otimizar o acesso e reduzir o tráfego na rede. Só que às vezes é necessário que os
dados estejam disponíveis imediatamente após pressionar o botão "Salvar"... para resolver isso, adicione a unit
DBIProcs na cláusula Uses do form e coloque o seguinte comando no evento AfterPost da tabela: }

DbiSaveChanges(NomeDaTabela.Handle); 

{Para descobrir o caminho do alias, faça o seguinte: 
Inclua um objeto TSession no form. Altere a propriedade SessionName para Session1 e, na procedure em que
você quer ver o nome do alias, use a seguinte rotina }

var 
List : TStringList; 
CaminhoDoAlias : String; 
begin 
Session1.Active := True; 
List := TStringList.Create; 
Session1.GetAliasParams ('NomeDoAlias', List); 
CaminhoDoAlias := List.Values['PATH']); { Em Interbase é SERVER NAME no lugar de PATH } 
end; 

{Quando executa o PrintSetup do Preview e você está trabalhando com papel Personalizado, o QuickReport perde
a configuração do Papel Personalizado, colocando o PaperSize de Custom para Letter.
Para resolver o problema guarde o valor da propriedade PaperSize e do Length em variáveis e no evento
BeforePrint você atribui o valor da variável para o QuickReport novamente, dessa forma resolve o problema.
Veja exemplo }

var
Form1: TForm1;
cPaperSize : TQRPaperSize;
nLength : Extended;

implementation
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
cPapersize := QuickRep1.Page.PaperSize;
nLength := QuickRep1.Page.Length;
QuickRep1.Preview;
end;

procedure TForm1.QuickRep1BeforePrint(Sender: TQuickRep;
var PrintReport: Boolean);
begin
QuickRep1.Page.PaperSize := cPaperSize;
QuickRep1.Page.Length := nLength;
end;

Home   1 -  2  - 3   Proxima     5 - 6 - 7 - 8 - 9  - 10