O exemplo abaixo mostra como adquirir a Data e Hora de um Arquivo

www.fontesbrasil.com




function GetFileDate(Arquivo: String): String;
var
FHandle: integer;
begin
FHandle := FileOpen(Arquivo, 0);
try
Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
finally
FileClose(FHandle);
end;
end;

 


 

 

Writeln - Imprimindo em coluna 

 



procedure TForm1.Button1Click(Sender: TObject);
var Texto1 : string;
F : TextFile;
Valor : Extended;
t : Integer;
begin
AssignFile(F,’/LPT2');
Rewrite(F);
T := 21; { Tamanho total da string, que deverá ser impresso }
Texto1 := ‘Portal’;
Valor := 1.00;
Writeln(F,Format(‘%s%’+IntToStr(T-Length(Texto1))+’s%8.2f’, [Texto1,’ ‘,Valor])+
’Fim da linha’);
Texto1 := ‘Portal Fontes’;
Valor := 100.21;
Writeln(F,Format(‘%s%’+IntToStr(T-Length(Texto1))+’s%8.2f’, [Texto1,’ ‘,Valor])+’Fim da linha’);
Texto1 := ‘Portal’;
Valor := 1000.10;
Writeln(F,Format(‘%s%’+IntToStr(T-Length(Texto1))+’s%8.2f’, [Texto1,’ ‘,Valor])+’Fim da linha’);
Writeln(F,#12); // Ejeta a página
CloseFile(F);
end;




 

 

Alterar as cores do título de um DBGrid em tempo de Execução




procedure TForm1.DBGrid1TitleClick(Column: TColumn);
var
I: integer;
begin
for i:=0 to DBGrid1.Columns.count-1 do
begin
DBGrid1.Columns[i].Title.Color := clBtnFace;
DBGrid1.Columns[i].Title.Font.Color := clBlack;
DBGrid1.Columns[i].Title.Font.Style := [];
end;
Column.Title.color := ClYellow;
Column.Title.Font.Style := [ fsBold, fsItalic];
Column.Title.Font.Color := clRed; 

end;



 

 

Como selecionar uma impressora no QuickReport 2.0i




procedure TForm1.Button1Click(Sender: TObject);
begin
QuickRep1.Prepare;
QuickRep1.PrinterSetup;
QuickRep1.Print;
end;


 


 

 

Como carregar um cursor animado em sua Aplicação




procedure TForm1.Button3Click(Sender: TObject);
const 

NovoCursor = 1;
begin
Screen.Cursors[ NovoCursor ] :=
LoadCursorFromFile(‘c:\windows\cursors\
globe.ani’ );
Cursor := NovoCursor;
end; 

OBS. Para descarregar o cursor animado troque a string ‘c:\windows\cursors\globe.ani’ por ‘OCR_NORMAL’.

 


 

 

Como definir seu próprio hotkey (Tecla Quente)

 



Primeiro fixe a propriedade KeyPreview do Form para TRUE 

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (ssCtrl in Shift) and (chr(Key) in [‘A’, ‘a’]) then
ShowMessage(‘Ctrl-A’);
end;




 

 

Como criar um Alias dinamicamente na memória




procedure TForm1.FormCreate(Sender: TObject);
begin
if not Session.IsAlias(‘Teste’) then
session.AddStandardAlias(‘Teste’,
ExtractFilePath(Application.ExeName),’PARADOX’);
end;

 



Como usar perfeitamante o LookupComboBox




[ Resposta ] - Caro Sr. , o componente DBLookupComboBox é utilizado para seleciona registros de uma tabela e
gravar em outra tabela. 

As propriedades necessárias para a utilização são: 

DataSource - Ligar a DataSource da Tabela ao qual vai receber o valor do registro selecionado;
DataField - Ligar o campo de ligação entre as duas tabelas, ao qual vai receber o valor do registro selecionado; 

ListSource - Ligar a DataSource da Tabela ao qual vai Ter o registro selecionado; 
ListField - Ligar o campo que será listado quando o usuário abrir a janela para seleção do registro; 
KeyField - Ligar o campo de ligação entre as duas tabelas, ao qual terá o seu valor enviado para gravação.

O campo de ligação entre as duas tabelas pode ser um campo código, pois é este campo que manterá os valores
iguais entre as duas tabelas.


 


 

 

Traduzindo a mensagem: "Delete Record?"




Quando clicamos sobre o botão de deleção no DBNavigator (o do sinal de menos) surge uma box com a
mensagem "Delete Record?" com botões Ok e Cancel. Para fazer aparecer a mensagem em português deverá
selecionar o componente Table e mudar a propriedade ConfirmDelete para False e no evento da tabela
BeforeDelete colocar o seguinte:

procedure TForm1.Table1BeforeDelete(DataSet:TDataSet);

begin

if MessageDlg('Eliminar o Registro?',mtConfirmation,[mbYes,mbNo],0)<>mrYes then Abort;

end;



 

 

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


Obtendo o diretório corrente da Aplicação




A variável do sistema Application.Exename providencia o path(local) completo do executável que está
funcionando no momento.



 

 

EXECUTANDO PROGRAMAS EXTERNOS




Se você precisa abrir programas externos no seu aplicativo DELPHI, como a calculadora do Windows, por
exemplo, inclua a seguinte linha no seu programa:

WinExec('calc.exe', sw_show);

'calc.exe' é o nome do programa. Caso queira abrir um outro programa, altere este nome.




 

 

 

Utilizando a tecla Enter para saltar de campo




Insira este código em um evento OnKeyPress de um controle de edição:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

If Key = #13 Then

Begin

SelectNext(Sender as tWinControl, True, True );

Key := #0;

end;

end;


 


 

Obtendo o Número do registro atual




Function Recno(Dataset: TDataset): Longint;

var

CursorProps: CurProps;

RecordProps: RECProps;



begin

{ Return 0 if dataset is not Paradox or dBASE }

Result := 0;

with Dataset do

begin

if State = dsInactive then DBError(SDataSetClosed);

Check(DbiGetCursorProps(Handle, CursorProps));

UpdateCursorPos;

try

Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @RecordProps));

case CursorProps.iSeqNums of

0: Result := RecordProps.iPhyRecNum; { dBASE }

1: Result := RecordProps.iSeqNum; { Paradox }

end;

except

on EDBEngineError do

Result := 0;

end;

end;

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;





 

 

Desabilitar o CTRL+ALT+DEL e ALT+TAB




Var

numero: integer;

begin

SystemParametersInfo(97,Word(true),@numero,0);

end;

{ Para habilitar é só chamar a mesma função com Word(false) }



 


 

Carregar um cursor animado(*.ANI)



const

cnCursorID1 = 1;

begin

Screen.Cursors[ cnCursorID1 ] :=

LoadCursorFromFile('c:\win95\cursors\cavalo.ani' );

Cursor := cnCursorID1;

end;

{ O arquivo CAVALO.ANI deverá existir no diretório apontado }




 

A função Delay do Turbo Pascal




procedure TForm1.Delay(msecs:integer);

var

FirstTickCount:longint;

begin

FirstTickCount:=GetTickCount;

repeat 

Application.ProcessMessages; 

until ((GetTickCount-FirstTickCount) >= Longint(msecs));

end;




 

 

Saindo do Windows




{ Reinicia o Windows }

ExitWindowsEx(EWX_REBOOT, 0); 



{ Desliga o Windows }

ExitWindowsEx(EWX_SHUTDOWN, 0); 



{ Força todos os programa a desligarem-se }

ExitWindowsEx(EWX_FORCE, 0); 




 


Transformando Ícone (*.ICO) em Bitmap (*.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;

 


 

 

 

Transferindo o conteúdo de um Memo para um Memofield




Var

t: TTable;

Begin

t := TTable.create(self);

with t do

begin

DatabaseName := 'MyAlias'; {personal alias}

TableName := 'MyTbl.db';

open;

edit;

insert;

fieldByName('TheField').assign(memo1.lines); {This is it!}

post; {required!!!}

close;

end; 

end;

 


 



Mudar o foco do campo em um DBGrid




Modificando o foco de um DBGrid

DBGrid1.SelectedIndex:=2; { Vai para a 3a coluna }




 

 

Modificando a posição do cursor em um Memo




Modificando a posição:

ActiveControl:=Memo1;

MemoCursorTo(Memo1,2,3);



Obtendo a Posição:

GetMemoLineCol(Memo1,Linha,Coluna);



 


Executar um programa D.O.S. e fechá-lo




WinExec("command.com /c programa.exe",sw_ShowNormal);





 

 

Copiando Arquivos




Function CopiaArquivo(scrname,destname:string):byte;

var

source,destination:file;

buffer:array[1..1024] of byte;

readcnt,writecnt:word;

pname,dname,fname,ename:String;

{

USO:

R:=COPIAARQUIVO('C:\SUBDIR\FILE.EXT','C:\SUBDIR\FILE.EXT');

Devolve 0=Ok, 1=Source Error, 2=Target Error, 3=DiskFull

}

begin

AssignFile(source,scrname);

Try

Reset(source,1);

Except

CopiaArquivo:=1;

Exit;

end;



If destname[length(destname)]='\' then

begin

pname:=scrname;

destname:=destname+separa(scrname,'\',Ocorre(scrname,'\')+1);

end;

AssignFile(destination,destname);

Try

Rewrite(destination,1);

Except

CopiaArquivo:=2;

Exit;

end;



Repeat

BlockRead(source,buffer,sizeof(buffer),readcnt);

Try

BlockWrite(destination,buffer,readcnt,writecnt);

Except

CopiaArquivo:=3; {DiskFull?}

Exit;

end;

until (readcnt=0) or (writecnt<>readcnt);

CloseFile(destination);

CloseFile(source);

CopiaArquivo:=0;

end;



 


Deixando o EXE menor e mais rápido




Para deixar o programa executável menor e mais rápido, abra a tela de Options/Project.

Na página Compiler tire todos os "X" e deixe somente nas caixas: Force far Calls, Smart Callbacks e Extended
Sintax.

Na página Linker marque um "X" em Optimize for size and load time.

Lembre-se fazendo isso o programa ficará menor e mais rápido, porém o Delphi levará mais tempo para compilá-lo.


 


 


Configurando a paleta de componentes




Gostaria de modificar a paleta de componentes para que facilite o acesso aos componentes mais usados? É fácil,
basta clicar com o botão direito do Mouse sobre a paleta e selecionar Configure... Assim é possível até mesmo
criar novas pastas para armazenar os componentes.



 

 

Usando os eventos de som do Windows




Evento Som Padrão

MessageBeep(0); { no Delphi 2.0 é só usar BEEP; }



Evento Parada Crítica

MessageBeep(16);



Evento Pergunta

MessageBeep(32);



Evento Exclamação

MessageBeep(48);



Evento Asterisco

MessageBeep(64);




 


Tocando sons *.WAV




Para reproduzir sons no formato WAV em um programa em Delphi é simples, o usuário deverá colocar na clásula
Uses o MMSystem. E no corpo do programa o comando:



SndPlaySound('C:\Windows\Media\Som.wav',SND_ASYNC);



{ No Delphi 2.0 use a função PLAYSOUND }





 

 

Como fazer para o Programa funcionar em Rede




Não são necessárias grandes mudanças no Delphi e no projeto para este funcione em rede. No BDE, selecione o
drive Paradox, no parâmetro NET DIR informe o caminho onde está a sua base de dados. Não esqueça que, se
estiver usando Alias este também deve ser apontado para o drive da rede onde estão os dados. E por último o
parâmetro LOCAL SHARE tem que estar configurado para TRUE na orelha System.



 

 

O que significa "KEY VIOLATION"




Este erro é muito comum, principalmente quando estamos começando a utilizar o bando de dados Paradox do
Delphi. Quando criamos um campo chave (o que vai com um *) em uma tabela significa que este campo será o
principal - como um código. ELE NÃO PODE TER DOIS REGISTROS COM VALORES IGUAIS. Quando o
programa tenta cadastrar dois registros com valores iguais aparece a mensagem "Key Violation". Para arrumar o
problema basta entrar o database desktop e ao restruturar a tabela re-criar os índices.





Duas Funções para tratamento de Strings




Function StrRight(p:string;n:byte):string;

var

i,l:byte;

r:string;

begin

r:='';

l:=length(p)+1;

for i:=l downto (l-n) do

r:=p[i]+r;

dec(r[0]);

Result:=r;

end;



Function StrLeft(p:string;n:byte):string;

var

r:string;

begin

r:=p;

r[0]:=chr(n);

Result:=r;

end;




 

 

Colocar Funções em uma DLL




Edite diretamente no DPR, e depois salve como Funcoes.dpr:



Library Funcoes;



Uses SysUtils,WinTypes,WinProcs;



Uma função que tira os espaços no início e no final de uma string


Function Trim(J:String):String; Export; 

Begin

While J[Length(J)]=#32 do Dec(J[0]);

If Length(J)>1 then

While (J[1]=' ') do

Begin

Delete(J,1,1);

If Length(J)<=1 then J:='';

end;

Result:=J;

end;



 


Bloquear um Arquivo em ambiente de Rede




uma dica simples mais importante ! 

Quando você programar visando uma rede e quiser bloquear um arquivo eh soh chamar o método "edit" da
Tabela que estiver usando. ex: Table1.edit; 

obs: Se o registro jah estiver bloqueado ocorrerah um erro, então você deve fazer o seguinte: 



try { para verificar o erro } 

Table1.edit; 

exception on TDBEngineError do { o erro..} 

MensageDlg('Registro ja esta sendo usado...!',mtInformation,[ mbOk ],0 ); 

end; 



 

 

Como fazer um Beep no Computador



messageBeep(0);



 


Como fazer uma pausa por um período determinado




NumSec é o tempo em segundos de espera



var 

NumSec SmallInt;

StartTime: TDateTime;

begin

StartTime := now;

NumSec:=10;

repeat

Application.ProcessMessages;

until Now > StartTime + NumSec * (1/24/60/60);

end;

Obs Nivek Informática à É melhor e mais simples colocar SLEEP(8000), onde no caso anterior o sistema daria
uma pausa de oito segundos.

 


Home   1 2  Proxima     4 - 5 - 6 - 7 - 8 - - 10