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)

Compara dois arquivos textos

procedure TForm1.Button1Click(Sender: TObject);
var
       filename1 : string;
       filename2 : string;
begin
      filename1 := Edit1.Text;
      filename2 := Edit2.Text;
      compfile(filename1, filename2);
      showmessage('Veja o resultado no arquivo c:Tempdiff.txt');
end;
 
procedure tform1.compfile(filename1, filename2 : string);
var
     f1 : system.textfile;
     f2 : system.textfile;
     diff : system.textfile;
     buf1 : string;
     buf2 : string;
     l : integer;
begin
    assignfile(f1, filename1);
    assignfile(f2, filename2);
    assignfile(diff, 'c:Tempdiff.txt');
    reset(f1);
    reset(f2);
    rewrite(diff);
    l := 1;
   while not eof(f1) do begin
       readln(f1, buf1);
       readln(f2, buf2);
       if not (compstr(buf1, buf2) )then begin
           writeln(diff, 'line: '+ inttostr(l) + '-' + buf1);
           writeln(diff, 'line: '+ inttostr(l) + '-' + buf2);
           writeln(diff, ' ');
       end;
       inc(l);
   end;
   closefile(f1);
   closefile(f2);
   closefile(diff);
end;
 
function tform1.compstr(s1, s2 : string) : boolean;
var
     i : integer;
     btemp : boolean;
begin
     btemp := true;
     if (length(s1) <> length(s2)) then begin
         btemp := false;
     end{if}
     else begin
          for i:= 1 to length(s1) do begin
               if (s1[i] <> s2[i]) then begin
                   btemp := false;
                   exit;
               end;{if}
          end;{for}
     end;{else}
     result := btemp;
end;

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;