procedure AddLog;
var
log: textfile;
begin
try
AssignFile(log, 'c:\log.log');
if not FileExists('c:\log.log') then Rewrite(log,'c:\log.log');
Append(log);
WriteLn(log, 'informações a serem inclusas');
finally
CloseFile(log);
end;
end;
quinta-feira, 12 de agosto de 2010
Criando diretório
Para criar um diretório você precisa usar a função ForceDirectories, o exemplo a baixo testa se não existe um diretório e cria o diretório apartir de uma variável string testando se o diretório já existe
Unit
FileCtrl
procedure TForm1.Button1Click(Sender: TObject);
var
Dir: string;
begin
Dir := 'C:\APPS\SALES\LOCAL';
if not DirectoryExists(Dir) then
ForceDirectories(Dir);
Label1.Caption := Dir + ' foi criado';
end;
quarta-feira, 11 de agosto de 2010
Alterando a fonte de determinado registro em um DBGrid
Para trocar a fonte de um DBGrid, utilize a rotina abaixo no evento OnDrawDataCell:
if Tabela.FieldByName ('Salario').Value >= 10000 then begin
DbGrid1.Canvas.Font.Color := clRed;
DbGrid1.Canvas.Font.Style := [fsBold];
end;
DbGrid1.DefaultDrawDataCell(Rect, Field, State);
No caso, somente os registros com salário maior que R$ 10.000,00 ficarão com cor vermelha e em negrito.
Nota: Não é necessário mover o ponteiro da tabela para colorir os registros.
if Tabela.FieldByName ('Salario').Value >= 10000 then begin
DbGrid1.Canvas.Font.Color := clRed;
DbGrid1.Canvas.Font.Style := [fsBold];
end;
DbGrid1.DefaultDrawDataCell(Rect, Field, State);
No caso, somente os registros com salário maior que R$ 10.000,00 ficarão com cor vermelha e em negrito.
Nota: Não é necessário mover o ponteiro da tabela para colorir os registros.
Adicionar o evento OnClick do DBGrid
Problema:
Meu programa precisa processar algo quando o usuário clicar no DBGrid em um determinado form. O problema é que o DBGrid não possui o evento OnClick. É possível adicionar este evento no DBGrid?
Solução:
É possível sim. Afinal é muito simples. Siga os passos abaixo para resolver seu problema:
- Monte seu form normalmente, colocando o DBGrid e demais componentes;
- Vá na seção "private" da unit e declare a procedure abaixo:
private
procedure DBGridClick(Sender: TObject);
- Logo após a palavra "implementation", escreva a procedure:
implementation
{$R *.DFM}
procedure TForm1.DBGridClick(Sender: TObject);
begin
ShowMessage('Clicou no DBGrid.');
end;
- Coloque as instruções abaixo no evento OnCreate do Form:
procedure TForm1.FormCreate(Sender: TObject);
begin
DBGrid1.ControlStyle :=
DBGrid1.ControlStyle + [csClickEvents];
TForm(DBGrid1).OnClick := DBGridClick;
end;
- E pronto. Execute e teste.
Observações:
O segredo principal desta dica está OnCreate do Form. A primeira instrução ativa o evento OnClick. A segunda instrução acessa o manipulador do evento OnClick. Para isto precisamos tratar o DBGrid como se fosse Form, pois o evento OnClick está declarado como protegido (protected) na classe TDBGrid.
Meu programa precisa processar algo quando o usuário clicar no DBGrid em um determinado form. O problema é que o DBGrid não possui o evento OnClick. É possível adicionar este evento no DBGrid?
Solução:
É possível sim. Afinal é muito simples. Siga os passos abaixo para resolver seu problema:
- Monte seu form normalmente, colocando o DBGrid e demais componentes;
- Vá na seção "private" da unit e declare a procedure abaixo:
private
procedure DBGridClick(Sender: TObject);
- Logo após a palavra "implementation", escreva a procedure:
implementation
{$R *.DFM}
procedure TForm1.DBGridClick(Sender: TObject);
begin
ShowMessage('Clicou no DBGrid.');
end;
- Coloque as instruções abaixo no evento OnCreate do Form:
procedure TForm1.FormCreate(Sender: TObject);
begin
DBGrid1.ControlStyle :=
DBGrid1.ControlStyle + [csClickEvents];
TForm(DBGrid1).OnClick := DBGridClick;
end;
- E pronto. Execute e teste.
Observações:
O segredo principal desta dica está OnCreate do Form. A primeira instrução ativa o evento OnClick. A segunda instrução acessa o manipulador do evento OnClick. Para isto precisamos tratar o DBGrid como se fosse Form, pois o evento OnClick está declarado como protegido (protected) na classe TDBGrid.
Copiando Arquivos Via Programação
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:\diretorio\FILE.EXT','C:\diretorio\FILE.EXT'); Devolve 0=Ok, 1=Erro no Origem, 2=Erro no Destino, 3=Disco Cheio }
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; {Disco Cheio?}
Exit;
end;
until (readcnt=0) or (writecnt<>readcnt);
CloseFile(destination);
CloseFile(source);
CopiaArquivo:=0;
end;
var
source,destination:file;
buffer:array[1..1024] of byte;
readcnt,writecnt:word;
pname,dname,fname,ename:String;
{ USO: R:=COPIAARQUIVO('C:\diretorio\FILE.EXT','C:\diretorio\FILE.EXT'); Devolve 0=Ok, 1=Erro no Origem, 2=Erro no Destino, 3=Disco Cheio }
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; {Disco Cheio?}
Exit;
end;
until (readcnt=0) or (writecnt<>readcnt);
CloseFile(destination);
CloseFile(source);
CopiaArquivo:=0;
end;
Copiando arquivos de diretório para diretório
procedure CopyDir(const cFrom, cTo : string);
var
OpStruc : TSHFileOpStruct;
frombuf, tobuf : array[0..128] of Char;
begin
FillChar(frombuf, Sizeof(frombuf), 0);
FillChar(tobuf, Sizeof(tobuf), 0);
StrPCopy(frombuf, cFrom);
StrPCopy(tobuf, cTo);
with OpStruc do begin
Wnd := Application.Handle;
wFunc := FO_COPY;
pFrom := @frombuf;
pTo := @tobuf;
fFlags := FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end; // with
ShFileOperation(OpStruc);
end; // CopyDir
var
OpStruc : TSHFileOpStruct;
frombuf, tobuf : array[0..128] of Char;
begin
FillChar(frombuf, Sizeof(frombuf), 0);
FillChar(tobuf, Sizeof(tobuf), 0);
StrPCopy(frombuf, cFrom);
StrPCopy(tobuf, cTo);
with OpStruc do begin
Wnd := Application.Handle;
wFunc := FO_COPY;
pFrom := @frombuf;
pTo := @tobuf;
fFlags := FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end; // with
ShFileOperation(OpStruc);
end; // CopyDir
Algumas dicas Uteis
Apagar arquivos via MS-DOS:
WinExec('Command.com /c Del c:\temp\*.tmp', 0)
-----------------------------------------------------------------------------------
Como extrair o tamanho de um arquivo:
function TForm1.TamArquivo(Arquivo: string): Integer;
begin
with TFileStream.Create(Arquivo, fmOpenRead or fmShareExclusive) do
try
Result := Size;
finally
Free;
end;
end;
Utilize a função assim:
procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text:= inttostr(TamArquivo('CAMINHO\NOMEDOARQUIVO'));
end;
-----------------------------------------------------------------------------------
Como verificar se um arquivo existe:
If not(fileexists('c:\windows\nuvens.bmp')) then Showmessage('Arquivo inexistente');
-----------------------------------------------------------------------------------
Copiando arquivos:
Função: CopyFile('Origem','Destino',True);
Exemplo: CopyFile('c:\logo.sys','c:\logo.bmp',True)
True : Instrui para sobrescrever o arquivo destino (caso encontre)
WinExec('Command.com /c Del c:\temp\*.tmp', 0)
-----------------------------------------------------------------------------------
Como extrair o tamanho de um arquivo:
function TForm1.TamArquivo(Arquivo: string): Integer;
begin
with TFileStream.Create(Arquivo, fmOpenRead or fmShareExclusive) do
try
Result := Size;
finally
Free;
end;
end;
Utilize a função assim:
procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text:= inttostr(TamArquivo('CAMINHO\NOMEDOARQUIVO'));
end;
-----------------------------------------------------------------------------------
Como verificar se um arquivo existe:
If not(fileexists('c:\windows\nuvens.bmp')) then Showmessage('Arquivo inexistente');
-----------------------------------------------------------------------------------
Copiando arquivos:
Função: CopyFile('Origem','Destino',True);
Exemplo: CopyFile('c:\logo.sys','c:\logo.bmp',True)
True : Instrui para sobrescrever o arquivo destino (caso encontre)
Assinar:
Postagens (Atom)
-
function GetIP:string;//--> Declare a Winsock na clausula uses da unit var WSAData: TWSAData; HostEnt: PHostEnt; Name:string; begin...
-
Vamos criar uma API REST simples em Delphi. Para isso, usaremos o Delphi 7 com Indy components (se for o que você tem disponível) ou, se est...