quinta-feira, 12 de agosto de 2010

Criando um arquivo de log

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;

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.

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.

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;

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

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)

Curso de Delphi: 7.Consultas SQL