Pintando uma linha de um StringGrid

[Pedro SI]

Boa Tarde Pessoal,

Venho aqui pedir socorro!

estou montando um programa que le todos os arquivos de uma pasta, insere em um stringGrid e após vai comparar com os arquivos de outra pasta, então ele carrega outra stringGrid para a outra pasta, no momento da comparação se o arquivo não existir na segunda pasta será pintado no primeiro string grid, porem eu não consigo fazer essa colorização da linha ou celula,

Eu peço só que seja bem explicado se eu tenho que gerar um novo botão para inserir o codigo ou inserir alguma unit pois eu não estou habituado com o Delphi e suas notificações, por isso quanto mais detalhado for melhor para meu aprendizado,

O codigo que carrega as string grides:

function GetFileDate(TheFileName: string): string;
begin
  f := FileOpen(TheFileName, 0);
  try
    VLResult := DateTimeToStr(FileDateToDateTime(FileGetDate(f)));
  finally
    FileClose(f);
  end;
end;

procedure TFrmQG.BtnFecharClick(Sender: TObject);
begin
  close;
end;

procedure TFrmQG.BtnProcessamentoClick(Sender: TObject);
begin
   {if Gauge1.MaxValue = 0 then Gauge1.MaxValue := Table1.RecordCount;
   Gauge1.Progress := VGRegistrosLidos;
   LLidos.Caption := FormatFloat('###,###,##0',VGRegistrosLidos);
   LGravados.Caption := FormatFloat('###,###,##0',VGRegistrosGravados);
   LIgnorados.Caption := FormatFloat('###,###,##0',VGRegistrosIgnorados);
   LErros.Caption := FormatFloat('###,###,##0',VGRegistrosErros);
   if VGRegistrosErros <> 0 then Panel2.Color := clRed;}
end;

procedure TFrmQG.BtnInterromperClick(Sender: TObject);
begin
   if MessageDlg('Deseja realmente interromper o processamento?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
   begin
      VGInterromper := True;
   end;
end;

procedure TFrmQG.BtnExecutarClick(Sender: TObject);
begin
  {VGRegistrosLidos := 0;
   VGRegistrosGravados := 0;
   VGRegistrosIgnorados := 0;
   VGRegistrosErros := 0;
   VGInterromper := false;

   if CBTransacao.Checked then DBDecis.StartTransaction;

   With Table1 do
   begin
      First;
      While NOT EOF do
      begin



            inc(VGRegistrosGravados);
            inc(VGRegistrosIgnorados);
            inc(VGRegistrosErros);


         if VGInterromper then break;

         if CBStatus.Checked then BtnProcessamento.Click;
         if CBContador.Checked then BtnProcessamento.Click;

         inc(VGRegistrosLidos);
         Next;
         Application.ProcessMessages;
      end;
   end;

   if CBTransacao.Checked then DBDecis.Commit;
   MessageDlg('Final do Processamento!', mtInformation, [mbOK], 0);}
//----------------StringGrid1-----------------------------------------------//
  StringGrid1.Cells[0, 0] := 'Numero';
  StringGrid1.Cells[1, 0] := 'Nome';
  StringGrid1.Cells[2, 0] := 'Data';
  StringGrid1.Cells[3, 0] := 'Hora';
  StringGrid1.Cells[4, 0] := 'Status';
//----------------StringGrid2-----------------------------------------------//
  StringGrid2.Cells[0, 0] := 'Numero';
  StringGrid2.Cells[1, 0] := 'Nome';
  StringGrid2.Cells[2, 0] := 'Data';
  StringGrid2.Cells[3, 0] := 'Hora';
  StringGrid2.Cells[4, 0] := 'Status';
  try
    //faz a primeira busca
    FindFirst('C:\DECIS\Relatorio\*.*',faArchive,Result);
    //elimina o diretorio .
    if (Result.Name <> '.') then
    begin
      //adiciona o nome do arquivo no StringGrid
      StringGrid1.Cells[1,1] := Result.Name;
      StringTest := Result.Name;
      RegistroData := FileAge('C:\DECIS\Relatorio\' + Result.Name);
      Data := FileDateToDateTime(RegistroData);
      VLResult := DateTimeToStr(Data);
      StringGrid1.Cells[0,1] := '1';
      StringGrid1.Cells[2,1] := VLResult;
      StringGrid1.RowCount := 3;
    end;
    //faz a busca em todo diretório
    while FindNext(Result) = 0 do
    begin
      //elimina o diretorio ..
      if (Result.Name <> '..') then
      begin
        //adiciona no grid
        StringGrid1.Cells[0,StringGrid1.RowCount-1] := IntToStr(StringGrid1.RowCount-1);
        StringGrid1.Cells[1,StringGrid1.RowCount-1] := Result.Name;
        StringTest := Result.Name;
        RegistroData := FileAge('C:\DECIS\Relatorio\' + Result.Name);
        Data := FileDateToDateTime(RegistroData);
        VLResult := DateTimeToStr(Data);
        StringGrid1.Cells[2,StringGrid1.RowCount-1] := VLResult;
        StringGrid1.RowCount := StringGrid1.RowCount + 1;
      end;
    end;
  finally
    FindClose(Result);
  end;
    try
    //faz a primeira busca
    FindFirst('C:\DECIS\Relatorio\Original\*.*',faArchive,Result2);
    //elimina o diretorio.

    if (Result.Name <> '.') then
    begin
      //adiciona o nome do arquivo no StringGrid
      StringGrid2.Cells[1,1] := Result2.Name;
      RegistroData := FileAge('C:\DECIS\Relatorio\Original\' + Result2.Name);
      Data := FileDateToDateTime(RegistroData);
      VLResult := DateTimeToStr(Data);
      StringGrid2.Cells[0,1] := '1';
      StringGrid2.Cells[2,1] := VLResult;
      StringGrid2.RowCount := 3;
    end;
    //faz a busca em todo diretório
    while FindNext(Result2) = 0 do
    begin
      //elimina o diretorio ..
      if (Result.Name <> '..') then
      begin
        //adiciona no grid
        StringGrid2.Cells[0,StringGrid2.RowCount-1] := IntToStr(StringGrid2.RowCount-1);
        StringGrid2.Cells[1,StringGrid2.RowCount-1] := Result2.Name;
        RegistroData := FileAge('C:\DECIS\Relatorio\Original\' + Result2.Name);
        Data := FileDateToDateTime(RegistroData);
        VLResult := DateTimeToStr(Data);
        StringGrid2.Cells[2,StringGrid2.RowCount-1] := VLResult;
        StringGrid2.RowCount := StringGrid2.RowCount + 1;
      end;
    end;
  finally
    FindClose(Result2);
  end;
  If (StringGrid1<>StringGrid2) then
   begin
      //StringGrid1.Canvas.Font.Color := clGreen;
      //StringGrid1.Color := clGreen;
   end;
   {if (gdselected in gdFixed) then
   begin
      StringGrid.Canvas.Font.Color:= clGreen;//coloque a cor do colordialog
      StringGrid.Canvas.Brush.Color:= clWhite;
   end
   else
      begin
         StringGrid.Canvas.Font.Color:= clBlack;
         StringGrid.Canvas.Brush.Color:=clWhite;
      end;
   StringGrid.Canvas.FillRect(Rect);
   StringGrid.Canvas.TextOut(Rect.Left+2,Rect.Top+2,StringGrid.Cells[ACol,Arow]);}
   end;

Acessem Meu Blog http://ohwmen.wordpress.com

Editado Maio 13, 2011 por Pedro SI

[Jhonas]

tire essa parte do código

If (StringGrid1<>StringGrid2) then
   begin
      //StringGrid1.Canvas.Font.Color := clGreen;
      //StringGrid1.Color := clGreen;
   end;
   {if (gdselected in gdFixed) then
   begin
      StringGrid.Canvas.Font.Color:= clGreen;//coloque a cor do colordialog
      StringGrid.Canvas.Brush.Color:= clWhite;
   end
   else
      begin
         StringGrid.Canvas.Font.Color:= clBlack;
         StringGrid.Canvas.Brush.Color:=clWhite;
      end;
   StringGrid.Canvas.FillRect(Rect);
   StringGrid.Canvas.TextOut(Rect.Left+2,Rect.Top+2,StringGrid.Cells[ACol,Arow]);}
   end;

depois é só adaptar ao seu código esse exemplo:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    procedure StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  lin, col : integer;
  Rect: TRect;
implementation

{$R *.dfm}

procedure TForm1.StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);

  procedure DrawCellText;
  var
    Text: array[0..255] of Char;
  begin
    StrPCopy( Text, StringGrid1.Cells[ ACol, ARow ] );
    ExtTextOut( StringGrid1.Canvas.Handle, Rect.Left + 2, Rect.Top + 2,
                ETO_CLIPPED or ETO_OPAQUE, @Rect, Text, StrLen( Text ),nil );
  end;

  procedure DrawCellColor( CorFundo, CorLetra : TColor );
  var
    S1, S2 : TColor;
  begin
    with StringGrid1.Canvas do
    begin
      S1 := Brush.Color;
      S2 := Font.Color;
      try
        {pinta o fundo com a cor desejada}
        Brush.Color := CorFundo;
        FillRect( Rect );
        {pinta as letras com a cor desejada}
        Font.Color := CorLetra;
        DrawCellText;
      finally
        {restaura as cores}
        Brush.Color := S1;
        Font.Color := S2;
      end;{try}
    end;{with}
  end;

begin

  If (StringGrid1.Cells[ACol,Arow]<>StringGrid2.Cells[ACol,Arow]) then
     DrawCellColor( clYellow, clBlack );
end;

procedure TForm1.Button1Click(Sender: TObject);
var i, j : integer; Meufoco: TGridRect;
begin
   StringGrid1.Cells[1,1] := '1';
   StringGrid1.Cells[2,1] := '2';
   StringGrid1.Cells[3,1] := '3';
   StringGrid1.Cells[4,1] := '4';

   StringGrid2.Cells[1,1] := '1';
   StringGrid2.Cells[2,1] := '3';
   StringGrid2.Cells[3,1] := '3';
   StringGrid2.Cells[4,1] := '5';

   for i := 1 to StringGrid1.RowCount -1  do
      for j := 1 to StringGrid1.ColCount -1  do
         begin
            Meufoco.Left:=j; // coluna inicial
            Meufoco.Right:=j; // coluna final
            Meufoco.Top:=i; // linha inicial
            Meufoco.Bottom:=i; // linha final
            stringGrid1.Selection:=Meufoco;
            stringGrid1.Refresh;
            stringGrid2.Refresh;

            StringGrid2.SetFocus;
         end;

end;

end.

abraço

[Pedro SI]

Jhonas, em primeiro lugar muito obrigado por sua ajuda!

Referente ao código que me passou, copiei ele direto para o Delphi e inseri o botão conjunto aos dois StringGrid, ele preenche a String grid mais não muda a cor, eu tenho uma duvida com os procedures, somente de inseri los no código eles já são executados???

Pelo que noitei não só neste código mais nos outros eles nuca são chamados, e meu conhecimento é em linguagem estruturada e pouco de Objeto, é meio parecido mais to me enrolando kosakoskoaskso!

Abraço.

[Jhonas]

Referente ao código que me passou, copiei ele direto para o Delphi e inseri o botão conjunto aos dois StringGrid, ele preenche a String grid mais não muda a cor, eu tenho uma duvida com os procedures, somente de inseri los no código eles já são executados???

Não , para que funcionem, voce deve fazer a refencia via 2 cliques do mouse no evento da procedure

OBS: O código ( vazio ) criado deve ser apagado

o código que te passei funciona perfeitamente, só tem que adapta-lo ao seu código

abraço

[Pedro SI]

Novamente Jhonas muito obrigado,

Consegui fazer funcionar o preenchimento das Cells,

A forma que fiz funcionar é clicando sobre a grid 2, tem alguma forma de ser alterada a cor quando eu clicar no botão?

O que eu quero é fazer a comparação dos valores preenchidos e pelo resultado ele vai preenchendo cores no StringGrid1.

Abraço.

[Jhonas]

A forma que fiz funcionar é clicando sobre a grid 2, tem alguma forma de ser alterada a cor quando eu clicar no botão?

altere esse comando

If (StringGrid1.Cells[ACol,Arow]<>StringGrid2.Cells[ACol,Arow]) then
     DrawCellColor( clYellow, clBlack );

azul claro

If (StringGrid1.Cells[ACol,Arow]<>StringGrid2.Cells[ACol,Arow]) then
     DrawCellColor( clAqua, clBlack );

vermelho

If (StringGrid1.Cells[ACol,Arow]<>StringGrid2.Cells[ACol,Arow]) then
     DrawCellColor( clRed, clBlack );

se não for isso, expique melhor

abraço

[Pedro SI]

Me expressei mal,

Eu quero que quando eu clique no botão, ou seja quando carregar os arquivos para as listas, ele já preencha a cor nas cells, no caso faria uma comparação estilo IF, e depois se fosse verdade, tal cor, se não permanece branço.

Eu acho que consegui explicar melhor sakosaksaosak!

abraço.

[Jhonas]

Eu quero que quando eu clique no botão, ou seja quando carregar os arquivos para as listas, ele já preencha a cor nas cells, no caso faria uma comparação estilo IF, e depois se fosse verdade, tal cor, se não permanece branço.

o exemplo que te passei faz exatamente isso

abraço

[Pedro SI]

Acho que errei em alguma coisa,

Porque o meu muda a cor quando eu clico em algum iten do StringGrid2 ele pinta a mesma celula referente a StringGrid1, eu simplesmente apaguei o codigo, inseri o seu, inseri os dois Grids e o obotão, ai no evento do string 2 e inseri em OnDrawCell o StringGrid2DrawCell, ai ele fica assim...

o botão fica somente para preencher o grid.

é este o procedimento?

[Jhonas]

vou tentar explicar...

a procedure DrawCellText que esta no evento OnDrawCell do StringGrid2 é para copiar o Texto quando a celula for pintada

a procedure DrawCellColor( CorFundo, CorLetra : TColor ) ... perçeba que recebe 2 parametros

CorFundo -> a cor que eu quero que a celula seja pintada

CorLetra -> a cor que eu quero que fique o Texto]

O evento OnDrawCell do StringGrid2 funciona como se fosse um Loop infinito, então o código abaixo:

If (StringGrid1.Cells[ACol,Arow]<>StringGrid2.Cells[ACol,Arow]) then
     DrawCellColor( clYellow, clBlack );

fica testando os valores de cada celula, se o valor das celulas forem iguais, fica branco e se forem de valores diferentes ficam amarelas ================================================ o código do botão serve apenas para carregar os valores nas respectivas celulas dos StringGrids ...

StringGrid1.Cells[1,1] := '1';
   StringGrid1.Cells[2,1] := '2';
   StringGrid1.Cells[3,1] := '3';
   StringGrid1.Cells[4,1] := '4';

   StringGrid2.Cells[1,1] := '1';
   StringGrid2.Cells[2,1] := '3';
   StringGrid2.Cells[3,1] := '3';
   StringGrid2.Cells[4,1] := '5';

entretanto para evitar de ficar clicando com o mouse sobre esses valores para que ele verifique o conteudo das celulas, o codigo abaixo:

for i := 1 to StringGrid1.RowCount -1  do
      for j := 1 to StringGrid1.ColCount -1  do
         begin
            Meufoco.Left:=j; // coluna inicial
            Meufoco.Right:=j; // coluna final
            Meufoco.Top:=i; // linha inicial
            Meufoco.Bottom:=i; // linha final
            stringGrid1.Selection:=Meufoco;
            stringGrid1.Refresh;
            stringGrid2.Refresh;

            StringGrid2.SetFocus;
         end;

faz o serviço automaticamente ... entendeu ?

abraço

[Pedro SI]

Jhonas, Muito Obrigado, Procedimento terminado, só colocar o evento vinculado na StringGrid1 ;P

Agora tá filé! ai na parte onde é alterada a cor eu posso inserir os If para o caso de outra variação ser inserida uma outra cor?

Muito Obrigado, o codigo está quase perfeito ;D

[Jhonas]

na parte onde é alterada a cor eu posso inserir os If para o caso de outra variação ser inserida uma outra cor?

nesse caso, o if não deverá testar somente a diferença, mas o conteudo ( valor )

abraço

[Pedro SI]

O que eu aprontei foi isso:

procedure TFrmQG.StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
  procedure DrawCellText;
  var
    Text: array[0..255] of Char;
  begin
    StrPCopy( Text, StringGrid1.Cells[ ACol, ARow ] );
    ExtTextOut( StringGrid1.Canvas.Handle, Rect.Left + 2, Rect.Top + 2, ETO_CLIPPED or ETO_OPAQUE, @Rect, Text, StrLen( Text ),nil );
  end;

  procedure DrawCellColor( CorFundo, CorLetra : TColor );
  var
    S1, S2 : TColor;

  begin
    with StringGrid1.Canvas do
    begin
      S1 := Brush.Color;
      S2 := Font.Color;
      try
        {pinta o fundo com a cor desejada}
        Brush.Color := CorFundo;
        FillRect( Rect );
        {pinta as letras com a cor desejada}
        Font.Color := CorLetra;
        DrawCellText;
      finally
        {restaura as cores}
        Brush.Color := S1;
        Font.Color := S2;
      end;{try}
    end;{with}
   end;
   begin
      StringGrid1.RowCount := 1;
      StringGrid2.RowCount := 1;
      relatorio1 := StringGrid1.Cells[1,StringGrid1.RowCount];
      while relatorio1 <> '' do
      begin
         StringGrid2.RowCount :=1;
         relatorio2 := StringGrid2.Cells[1,StringGrid2.RowCount];
         while relatorio2 <> '' do
         begin
            if relatorio1 = relatorio2 then
               if StringGrid1.Cells[2,StringGrid1.RowCount] <> StringGrid2.Cells[2,StringGrid2.RowCount] then
               begin
                  DrawCellColor(clRed, clBlack);
                  break;
               end;
            StringGrid2.RowCount := StringGrid2.RowCount + 1;
            relatorio2 := StringGrid2.Cells[1,StringGrid2.RowCount];

         end;
         StringGrid1.RowCount := StringGrid1.RowCount + 1;
         relatorio1 := StringGrid1.Cells[1,StringGrid1.RowCount];
      end;
      {If (StringGrid1.Cells[ACol,ARow] <> StringGrid2.Cells[ACol,ARow]) then
         DrawCellColor( clRed, clBlack );}
   end;

e ao que me parece ele entrou um um laço infinito, tipo ele não demonstra a grade só fica fazendo testes, tem alguma maneira mais agil de isto ocorrer?

Editado Maio 19, 2011 por Pedro SI

[Jhonas]

sugestão:

mude toda a lógica... não use mais o evento OnDrawCell e faça tudo o que precisa em um botão

abraço