Desabilitando o Splash Screen do Report Smith




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. 




 

 

Lendo o Volume do Hd




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;




 

 

Uma rotina para verificar erros em toda a  Aplicação




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.




 

 

Para saber somente o path da Aplicação




ExtractFilePath( Application.ExeName )




 

 

Como interceptar as teclas de função no seu Programa




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.




 

 

Incluindo um Preview personalizado com o Quick Report.



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'.




 

 

Função que devolve tempo decorrido em String




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;





 

 

Capturando o conteúdo do Desktop




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;




 

 

Executado uma única cópia do Aplicativo




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.


 


 

 

Manipulando DBGrid




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

 


 


Manipulando DBGrid 2



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; 




 

 

Manipulando DBGrid3

 



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; 



 

 

Disparando eventos por teclas de função



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. 


 


 

 

Como mudar a cor de um form em tempo de execução?




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;



 

 

Movimentar mouse sem Intervenção do Usuário




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; 





 

 

Chamar caixa de diálogo da conexão Dial-Up 





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; 





 

 

Remover registros da tabela Paradox fisicamente 




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; 





 

 

 

Tornar o Form não dimensionável 

 




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; 





 

 

Obter nome do usuário que está editando o registro 




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;





 

 

 

Data da Bios 





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





 

 

Converter um ícone para  Arquivo Bmp 




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; 





 

 

Executar uma única cópia do Aplicativo 




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.





 

 

Imprimir apenas o registro atual no Quick-Report 




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





 

 

Abrir tabela Paradox protegida por senha 




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.





 

 

Reindexar tabela Paradox 




DbiRegenIndexes(Table.Handle);

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





 

 

Simular Print Screen 




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;




 


Trocar impressora padrão do Windows 




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; 





 

 

Alterando tamanho do papel pelo Tprinter 




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; 





 

 

Ligar/Desligar descanso de Tela 





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





 

 

Descobrir endereço IP da máquina 




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





 

 

Esconder barra de tarefas do Windows 





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




 


Desabilitar CTRL+ALT+DEL, CTRL+ESC e ALT+TAB 





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





 

 

Retornar Número Serial do HD 





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




 


Gravar os dados das tabelas Fisicamente 




{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); 




 


Descobrindo o Path do Alias 




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





 

 

Resolvendo Problemas do Print-Setup do QuickReport 

 




{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 - - 10

                        fontesbrasil.com® Todos os direitos reservados.


Redirecinar:  http://www.fontesbrasil.com       Melhor visualização 800 x 600