Ir para conteúdo
Fórum Script Brasil
  • 0

(Resolvido)Pintar Grid...criado em tempo de execução

robinhocne

Perguntado por robinhocne,

 Share

Pergunta

robinhocne

robinhocne

Postado
Postado (editado)

Criei a procedure abaixo para pintar os grids criados em tempo de execução.....

procedure PintaGrid(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
   If odd(dsAgenda.DataSet.RecNo) then
      begin
         dgAgenda.Canvas.Font.Color  := clBlack;
         dgAgenda.Canvas.Brush.Color := clMoneyGreen;
      end
   else
      begin
         dgAgenda.Canvas.Font.Color  := clBlack;
         dgAgenda.Canvas.Brush.Color := clWhite;
      end;

  if gdSelected in State then
    begin
      dgAgenda.Canvas.Font.Color  := clWhite;
      dgAgenda.Canvas.Brush.Color := clSkyBlue;
    end
    else
    begin
      dgAgenda.Canvas.Font.Color  := clBlack;
    end;

   dgAgenda.Canvas.FillRect(Rect);
   dgAgenda.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
e ai coloquei na criação do grid, mas não está aparecendo as linhas pintadas.... o que poderia ser ?. 
{ Cria o DBGrid da Agenda ...}
         try
         dgAgenda := TJvDBGrid.Create(Self);

         with dgAgenda do
           begin
             Parent     := pnAgenda;
             Align      := alClient;
             Name       := 'dgAge' + Dtm.QryPesquisar.FieldByName('ProNome').AsString;
             Options    := [dgEditing, dgTitles, dgColLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
             Font.Size  := 8;
             Font.Style := [fsBold];
             DataSource := dsAgenda;
             //Adiciona as Colunas no dgAgenda
             Columns.Add;
             Columns.Items[0].FieldName       := 'AgeHorIni';
             Columns.Items[0].Width           := 50;
             Columns.Items[0].Font.Size       := 8;
             Columns.Items[0].Title.Caption   := 'H. Inicial';
             Columns.Items[0].Title.Font.Size := 8;
             Columns.Add;
             Columns.Items[1].FieldName       := 'AgeHorFin';
             Columns.Items[1].Width           := 50;
             Columns.Items[1].Font.Size       := 8;
             Columns.Items[1].Title.Caption   := 'H. Final';
             Columns.Items[1].Title.Font.Size := 8;
             Columns.Add;
             Columns.Items[2].FieldName       := 'AgeCliente';
             Columns.Items[2].Width           := 50;
             Columns.Items[2].Font.Size       := 8;
             Columns.Items[2].Title.Caption   := 'Cliente';
             Columns.Items[2].Title.Font.Size := 8;
             Columns.Items[2].Title.Font.Name := 'Arial';

             OnDrawColumnCell := PintaGrid;
           end;

         except
           on E:Exception do
             begin
              ShowMessage('Erro ao criar DbGrid dgAge' + Dtm.QryPesquisar.FieldByName('ProNome').AsString + #10 + e.Message);
              exit;
             end;
         end;

Editado por robinhocne
Link para o comentário
Compartilhar em outros sites

7 respostass a esta questão

Posts Recomendados

  • 0
robinhocne

robinhocne

Postado
  • Autor
Postado
O evento OnActive do Form coloque:

procedure TForm1.FormActivate(Sender: TObject);
begin
   dgAgenda.OnDrawColumnCell := PintaGrid;
end;

abraço

Até ai tudo beleza....mas se vou mexer em um grid...mexe em todos.....se seleciono um registro em um Grid muda dos demais e ai as cores das linhas se perde.....

Link para o comentário
Compartilhar em outros sites
  • 0
robinhocne

robinhocne

Postado
  • Autor
Postado
mas se vou mexer em um grid...mexe em todos.....se seleciono um registro em um Grid muda dos demais e ai as cores das linhas se perde.....

isso não deveria acontecer, a menos que todos os seus grids tenham o mesmo nome

abraço

Então ...até coloquei os nomes dos grids manuais no evento para ver se era isso, mas ainda continua.....vou postar como está...

Esse Código abaixo pesquisa as profissionais para montar a agenda e pesquisa a agenda delas.....essa procedure eu coloco no OnCreate do Formulário......

procedure PesquisaProfissionais;
begin


  // pesquisa as profissionais para montar a agenda
  with Dtm.QryPesquisar do
    begin
      Close;
      sql.Clear;
      sql.Add('Select ProCodigo, ProNome From Bel_Profissionais where ProAtivo = '+#39+'S'+#39);
      open;
    end;


  while not Dtm.QryPesquisar.Eof do
    begin

        {Cria o panel da Agenda ...}
        try
        pnAgenda := TPanel.Create(Self);

        with pnAgenda do
          begin
            Parent     := ScrollBox1;
            Top        := 10;
            Left       := 10;
            Width      := 300;
            Align      := alLeft;
            BevelInner := bvRaised;
            BevelOuter := bvLowered;
          end;

         except
           on E:Exception do
             begin
              ShowMessage('Erro ao criar pnAgenda');
              exit;
             end;
         end;
          {... Cria o panel da Agenda}


         { Cria a Query da Agenda ...}
         try
           qrAgenda := TIBCQuery.Create(self);

           with qrAgenda do
             begin
               Name        := 'qrAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString;
               Connection  := Dtm.Dba;
               Transaction := Dtm.Tra;
             end;

         except
           on E:Exception do
             begin
              ShowMessage('Erro ao criar Query qrAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString + #10 + e.Message);
              exit;
             end;
         end;
         {... Cria a Query da Agenda}




         { Cria o DataSource da Agenda ...}
         try
           dsAgenda := TIBCDataSource.Create(self);

           with dsAgenda do
             begin
               Name     := 'dsAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString;
               DataSet  := qrAgenda;
             end;

         except
           on E:Exception do
             begin
              ShowMessage('Erro ao criar DataSource dsAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString + #10 + e.Message);
              exit;
             end;
         end;
         {... Cria o DataSource da Agenda}


         { Cria o DBGrid da Agenda ...}
         try
         dgAgenda := TJvDBGrid.Create(Self);

         with dgAgenda do
           begin
             Parent     := pnAgenda;
             Align      := alClient;
             Name       := 'dgAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString;
             Options    := [dgEditing, dgTitles, dgColLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
             Font.Size  := 7;
             Font.Style := [fsBold];
             DataSource := dsAgenda;
             //Adiciona as Colunas no dgAgenda
             Columns.Add;
             Columns.Items[0].FieldName       := 'AgeHorIni';
             Columns.Items[0].Width           := 50;
             Columns.Items[0].Font.Size       := 7;
             Columns.Items[0].Title.Caption   := 'H. Inicial';
             Columns.Items[0].Title.Font.Size := 7;
             Columns.Add;
             Columns.Items[1].FieldName       := 'AgeHorFin';
             Columns.Items[1].Width           := 50;
             Columns.Items[1].Font.Size       := 7;
             Columns.Items[1].Title.Caption   := 'H. Final';
             Columns.Items[1].Title.Font.Size := 7;
             Columns.Add;
             Columns.Items[2].FieldName       := 'AgeCliente';
             Columns.Items[2].Width           := 40;
             Columns.Items[2].Font.Size       := 7;
             Columns.Items[2].Title.Caption   := 'Cliente';
             Columns.Items[2].Title.Font.Size := 7;
             Columns.Items[2].Title.Font.Name := 'Arial';
             Columns.Add;
             Columns.Items[3].FieldName       := 'AgeObs';
             Columns.Items[3].Width           := 40;
             Columns.Items[3].Font.Size       := 7;
             Columns.Items[3].Title.Caption   := 'Obs';
             Columns.Items[3].Title.Font.Size := 7;
             Columns.Items[3].Title.Font.Name := 'Arial';

             OnDrawColumnCell := PintaGrid;
           end;

         except
           on E:Exception do
             begin
              ShowMessage('Erro ao criar DbGrid dgAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString + #10 + e.Message);
              exit;
             end;
         end;



         {... Cria o DBGrid da Agenda}


         { Consulta os Clientes agendados na Profissional ...}
         try
          with qrAgenda do
            begin
              Close;
              sql.Clear;
              sql.Add('Select AgeHorIni, AgeHorFin, AgeCliente, AgeObs From Bel_Agenda');
              sql.Add(' where ProCodigo =:Pro');
              ParamByName('Pro').AsString := Dtm.QryPesquisar.FieldByName('ProCodigo').AsString;
              open;
            end;

         except
           on E:Exception do
             begin
              ShowMessage('Erro ao consultar a Agenda ' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString + #10 + e.Message);
              exit;
             end;
         end;
         {... Consulta os Clientes agendados na Profissional}

      Dtm.QryPesquisar.Next;
    end;


end;
Depois.... 
procedure PintaGrid(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
     try
       If odd( TIBCDataSource ( FindComponent ( 'dsAge1' ) ).DataSet.RecNo) then
          begin
             TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Font.Color  := clBlack;
             TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Brush.Color := clMoneyGreen;
          end
       else
          begin
             TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Font.Color  := clBlack;
             TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Brush.Color := clWhite;
          end;

      if gdSelected in State then
        begin
          TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Font.Color  := clWhite;
          TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Brush.Color := clSkyBlue;
        end
        else
        begin
          TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Font.Color  := clBlack;
        end;

       TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.FillRect(Rect);
       TJvDBGrid ( FindComponent ( 'dgAge1' ) ).DefaultDrawColumnCell(Rect, DataCol, Column, State);

         except
           on E:Exception do
             begin
              ShowMessage('Erro Pinatar a dgAgeDeise' + #10 + e.Message);
              exit;
             end;
         end;



     try
       If odd( TIBCDataSource ( FindComponent ( 'dsAge2' ) ).DataSet.RecNo) then
          begin
             TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Font.Color  := clBlack;
             TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Brush.Color := clMoneyGreen;
          end
       else
          begin
             TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Font.Color  := clBlack;
             TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Brush.Color := clWhite;
          end;

      if gdSelected in State then
        begin
          TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Font.Color  := clWhite;
          TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Brush.Color := clSkyBlue;
        end
        else
        begin
          TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Font.Color  := clBlack;
        end;

       TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.FillRect(Rect);
       TJvDBGrid ( FindComponent ( 'dgAge2' ) ).DefaultDrawColumnCell(Rect, DataCol, Column, State);

         except
           on E:Exception do
             begin
              ShowMessage('Erro Pintar a dgAge2' + #10 + e.Message);
              exit;
             end;
         end;



end;

procedure FormActivate(Sender: TObject);
begin
  dgAgenda.OnDrawColumnCell := PintaGrid;
end;

Ai até coloquei manual para pintar 2 grids...nessa função e coloquei no formActivate como você informou Jhonas....e assim...quando eu estou selecionando o primeiro grid...aparece as mesmas no segundo grid....e ai quando seleciono o segundo aparece as informações dele certa e com as linhas todas pintadas......

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado
quando eu estou selecionando o primeiro grid...aparece as mesmas no segundo grid....
o que isso indica a voce ? ou a grid tem o mesmo nome, ou a query esta setada para para o mesmo datasource das 2 grids

e ai quando seleciono o segundo aparece as informações dele certa e com as linhas todas pintadas......

dgAgenda.OnDrawColumnCell := PintaGrid;

dgAgenda ... aponta para o mesmo grid, mesmo que voce faça um teste no PintaGrid

OBS: o evento OnDrawColumnCell deve ser exclusivo para o dbgrid

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
robinhocne

robinhocne

Postado
  • Autor
Postado
quando eu estou selecionando o primeiro grid...aparece as mesmas no segundo grid....
o que isso indica a voce ? ou a grid tem o mesmo nome, ou a query esta setada para para o mesmo datasource das 2 grids

e ai quando seleciono o segundo aparece as informações dele certa e com as linhas todas pintadas......
dgAgenda.OnDrawColumnCell := PintaGrid;

dgAgenda ... aponta para o mesmo grid, mesmo que voce faça um teste no PintaGrid

OBS: o evento OnDrawColumnCell deve ser exclusivo para o dbgrid

abraço

Hum.......

Criei outra procedure para o outro grid e ai deu certo....tem que ser exclusivo mesmo...ai to perdido porque se eu tiver 10 grids criados em tempo de execução...ai vou ter que ter 10 procedures já montadas para fazer isso .....é isso ?

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...