12 respuestas en este tema

[felipe]

Hola,
que tal amigos, estoy buscando la manera de pintar las filas de un dbgrid de manera intercalada, por ejemplo, el primer registro blanco, el segundo azul, el tercero de nuevo blanco y asi sucesivamente 

Saludos!

[eduarcol]

delphi

if (MiQuery.RecNo mod 2) = 0 then   //Valida que sea la linea par
      If (gdFocused in State) then dbgrid1.canvas.brush.color := clNavy
      else dbgrid1.canvas.brush.color := clSilver;
 
  dbgrid1.DefaultDrawColumnCell(rect,DataCol,Column,State)

La primera condicion valida que sea la linea par, luego si la linea tiene el foco la resalta, si no le da el color.  La ultima instruccion pinta.

Espero te sirva

[felipe]

Gracias amigo voy a probarla y te cuento, pero podrí­as explicarme esta parte:

If (gdFocused in State)

además, ¿en que evento es mejor usar el código?

Saludos!

[poliburro]

yo uso este código

delphi

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
 Var
  LsValor: String; //Almacena el valor de la celda activa y aplica para las columnas 0,1,2,3,6
begin
  with (Sender as TStringGrid) do
    Begin
      Canvas.Font.Color := clBlack;
      //Se definen las caracteristicas de la fuente para la fila de encabezados.
      If (ACol = 0) or (ARow = 0) then
        Begin
          Canvas.Font.Style := [fsBold];
          Canvas.Brush.Color := clBtnFace;
        End
      Else If (Arow Mod 2) <> 0 Then
        Canvas.Brush.Color := clMoneyGreen
      Else Canvas.Brush.Color := clWhite;
      //Almacena el valor de la celda activa
      LsValor := Cells[ACol,ARow];
      //Pinta el canvas de la celda
      Canvas.FillRect(Rect);
      //Para la fila de encabezado no aplican los cambios en su canvas
      If ARow = 0 Then
        Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, LsValor)
     //Lo contrario para las restantes
      Else DrawText(Canvas.Handle,PChar(LsValor),StrLen(PChar(LsValor)),Rect,DT_LEFT);
    End;
end;

Edito: Ya contamos con las etiquetas de Delphi, Delphi Prism, SQL, C++ y C# amigo

Edito: jajajajaj editaste mi edición amigo jajajaja. mencionaba que erré el código, pedian uno para dbgrid no para string grid ni pepe :$.


saludos

[Wilson]

Un componente para probar

delphi

Unit UColorDBGrid;
 
interface
 
Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB,
  Grids, DBGrids;
 
Type
  TColorDBGrid = Class(TDBGrid)
  private
    FRowColorEven : TColor;
    FRowColorOdd  : TColor;
 
    procedure SetRowColorEven(Const Value: TColor);
    procedure SetRowColorOdd(Const Value: TColor);
  protected
    procedure DrawColumnCell(Const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
  public
    constructor Create(aOwner: TComponent); override;
    function AddColumn(Const aFieldName: String;
        Const aMaxValue: Double = 0; aFormat: String = ''): TColumn;
  published
    property RowColorEven : TColor  read FRowColorEven  write SetRowColorEven;
    property RowColorOdd  : TColor  read FRowColorOdd   write SetRowColorOdd;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Pruebas', [TColorDBGrid]);
end;
 
{ TColorDBGrid }
 
function TColorDBGrid.AddColumn(Const aFieldName: String;
    Const aMaxValue: Double = 0; aFormat: String = ''): TColumn;
begin
  Result := Columns.Add;
  Result.FieldName := aFieldName;
  If (DataSource.DataSet.FieldByName(aFieldName) is TNumericField) Then
  begin
    If (aFormat = '') Then
      aFormat := (DataSource.DataSet.FieldByName(aFieldName) as
TNumericField).DisplayFormat
    Else
      (DataSource.DataSet.FieldByName(aFieldName) as TNumericField).DisplayFormat :=
aFormat;
    If (aMaxValue <> 0) Then
      Result.Width := Canvas.TextWidth(FormatFloat(aFormat, aMaxValue)) + 4;
  end;
end;
 
constructor TColorDBGrid.Create(aOwner: TComponent);
begin
  inherited;
  //---
  FRowColorEven := clWindow;
  FRowColorOdd  := clInfoBk;
end;
 
procedure TColorDBGrid.DrawColumnCell(Const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
begin
  inherited;
  //---
  If (gdSelected in State)                 And
     (Screen.ActiveControl = Self)         And
     (Not (csDesigning in ComponentState)) Then
    //Nada
  Else
  If (Color <> Column.Color) Then
    //Define color de columna
  Else
  begin
    If odd(DataSource.DataSet.RecNo) Then
      Canvas.Brush.Color := FRowColorOdd
    Else
      Canvas.Brush.Color := FRowColorEven;
    DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
end;
 
procedure TColorDBGrid.SetRowColorEven(Const Value: TColor);
begin
  FRowColorEven := Value;
  Repaint;
end;
 
procedure TColorDBGrid.SetRowColorOdd(Const Value: TColor);
begin
  FRowColorOdd := Value;
  Repaint;
end;
 
end.

[Caro]

Hola Felipe, debes utilizar el evento OnDrawColumnCell de tu dbgrid y esta lí­nea :

If (gdFocused in State)

lo que hace es preguntar si la celda tiene el foco, si es así­ lo pinta con clNavy.

Saluditos

[felipe]

Hola,
probé el código de eduarcol pero tal parece que nunca se cumple la condición del foco por lo que no pinta los azules, y si elimino dicha condición aún no los pinta  ¿¿ ??

Saludos!

[felipe]

Se produce un molesto efecto al seleccionar las filas del dbgrid, ya que esta cambia de color pero queda blanca.


Saludos!

[enecumene]

delphi

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
 With DBGrid1 do begin
  if (dsCanciones.DataSet.RecNo mod 2) = 0 then   //Valida que sea la linea par
      If (gdFocused in State) then begin
      canvas.brush.color := clNavy
     end else begin
     canvas.brush.color := clSilver;
     Canvas.Font.Color  := clRed;
  end;
 
  DefaultDrawColumnCell(rect,DataCol,Column,State)
 end;
end;

Saludos.

[luk2009]

encontre esto hace un tiempo y me ha funcionado bien, inclusive te pinta en rojo el que este seleccionado:

delphi

procedure TFRMactivasred.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
 begin
if (Sender as TDBGrid).Datasource.DataSet.RecNo mod 2 = 0 then
        (Sender as TDBGrid).Canvas.Brush.Color := $00FFF5EC
      else
        (Sender as TDBGrid).Canvas.Brush.Color := $00F5FEFE;
(Sender as TDBGrid).Canvas.Font.Color := clBlack;
 if (Sender as TDBGrid).SelectedRows.CurrentRowSelected then
         begin
          (Sender as TDBGrid).Canvas.Font.Color := clWhite;
          (Sender as TDBGrid).Canvas.Brush.Color := clRed
         end;
(Sender as TDBGrid).DefaultDrawColumnCell(rect,DataCol,Column,State);
end;
end; 

solo debes recordar dejar dgmultiselect  en true

[JoAnCa]

Hola
Yo tambien he usado lo de pintar las filas, y con este codigo me sale bien

delphi

procedure TfrmSubmayor492.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
const
  clPaleGreen = TColor($A3AB05);
  clPaleRed =   TColor($B37BFD);
 
begin
  if Column.Field.Dataset.FieldbyName('Importe').AsInteger < 0 then
 
    if (gdFocused in State) then dbgrid1.canvas.brush.color:=clMedGray
    else dbgrid1.canvas.brush.color:=clPaleGreen;
 
  if (Column.Field.Dataset.FieldbyName('ImpAcum').AsInteger < 0) or
     (Column.Field.Dataset.FieldbyName('DiasAcum').AsInteger >24) then
 
    if (gdFocused in State) then dbgrid1.canvas.brush.color:=clBlue
    else dbgrid1.canvas.brush.color:=clPaleRed;
 
  dbgrid1.DefaultDrawColumnCell(rect,DataCol,Column,State)

Las lineas

delphi

   
  if (gdFocused in State) then dbgrid1.canvas.brush.color:=clMedGray
  else dbgrid1.canvas.brush.color:=clPaleGreen;

son las que cambian el color segun la condicion

y como dijo Luk2009, dgmultiselect  tiene que ser true

[felipe]

Hola,
gracias por sus respuestas, la verdad no he terminado de probar todos los códigos pero espero me den el resultado


Saludos!

[AngelF]

Hola a todos.

Reflotando este hilo de hace unos añitos, me ha parecido muy interesante el componente que tan amablemente comparte Wilson y de hecho pienso utilizarlo en mis desarrollos.
Pero me gustaría adaptarlo un poco a mi gusto y he pensado en añadirle la capacidad de colorear la fila que está bajo del cursor del puntero, esto es, que cuando pases el puntero por encima de los registros, estos se coloreen en un tono distinto al resto, dándole un aspecto que a mí me parece muy dinámico y agradable.

Esto de colorear la fila que se encuentra bajo del cursor se puede encontrar en http://delphi.about....idmouseover.htm y tratando de insertar este código en el de Wilson, me queda un "engendro" tal que así:

delphi

unit UColorDBGrid;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB,
  Grids, DBGrids, RzDBGrid;
 
type
  TColorDBGrid = class(TRzDBGrid)
  private
    FRowColorEven: TColor;
    FRowColorOdd: TColor;
    FColorUnderCursor: TColor; // Added by Angel 29/11/2011 16:27:53
 
    procedure SetRowColorEven(const Value: TColor);
    procedure SetRowColorOdd(const Value: TColor);
    procedure SetColorUnderCursor(const Value: TColor); // Added by Angel 29/11/2011 16:28:55
  protected
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
    procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); // Added by Angel 29/11/2011 16:31:11
  public
    constructor Create(aOwner: TComponent); override;
    function AddColumn(const aFieldName: string;
      const aMaxValue: Double = 0; aFormat: string = ''): TColumn;
  published
    property RowColorEven: TColor read FRowColorEven write SetRowColorEven;
    property RowColorOdd: TColor read FRowColorOdd write SetRowColorOdd;
    property ColorUnderCursor: TColor read FColorUnderCursor write SetColorUnderCursor; // Added by Angel 29/11/2011 16:27:58
  end;
 
type
  THackDBGrid = class(TDBGrid); // Added by Angel 29/11/2011 16:27:43
 
procedure Register;
 
var
  MouseOverRow: integer; // Added by Angel 29/11/2011 16:27:38
 
implementation
 
procedure Register;
begin
  RegisterComponents('Componentes', [TColorDBGrid]);
end;
 
{ TColorDBGrid }
 
function TColorDBGrid.AddColumn(const aFieldName: string;
  const aMaxValue: Double = 0; aFormat: string = ''): TColumn;
begin
  Result := Columns.Add;
  Result.FieldName := aFieldName;
  if (DataSource.DataSet.FieldByName(aFieldName) is TNumericField) then
  begin
    if (aFormat = '') then
      aFormat := (DataSource.DataSet.FieldByName(aFieldName) as
        TNumericField).DisplayFormat
    else
      (DataSource.DataSet.FieldByName(aFieldName) as TNumericField).DisplayFormat :=
        aFormat;
    if (aMaxValue <> 0) then
      Result.Width := Canvas.TextWidth(FormatFloat(aFormat, aMaxValue)) + 4;
  end;
end;
 
constructor TColorDBGrid.Create(aOwner: TComponent);
begin
  inherited;
  //---
  FRowColorEven := clWindow;
  FRowColorOdd := $00F8FFC6;
end;
 
procedure TColorDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
begin
  inherited;
  //---
 
  if (gdSelected in State) and
    (Screen.ActiveControl = Self) and
    (not (csDesigning in ComponentState)) then
    //Nada
  else
    if (MouseOverRow = 1 + THackDBGrid(TColorDBGrid).DataLink.ActiveRecord) then  // Added by Angel 29/11/2011 21:50:52 <-- AQUI SALTA EL ERROR
    begin
      with Canvas do
      begin
        Brush.Color := $0093E4C5;
        Font.Color := clNavy;
        Font.Style := [fsBold];
      end;
    end
    else
      if (Color <> Column.Color) then
        //Define color de columna
      else
      begin
        if odd(DataSource.DataSet.RecNo) then
          Canvas.Brush.Color := FRowColorOdd
        else
          Canvas.Brush.Color := FRowColorEven;
        DefaultDrawColumnCell(Rect, DataCol, Column, State);
      end;
end;
 
procedure TColorDBGrid.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); // Added by Angel 29/11/2011 16:31:11
var
  gc: TGridCoord;
begin
  gc := MouseCoord(x, y);
 
  MouseOverRow := gc.Y;
 
  gc := MouseCoord(X, Y);
end;
 
procedure TColorDBGrid.SetRowColorEven(const Value: TColor);
begin
  FRowColorEven := Value;
  Repaint;
end;
 
procedure TColorDBGrid.SetRowColorOdd(const Value: TColor);
begin
  FRowColorOdd := Value;
  Repaint;
end;
 
procedure TColorDBGrid.SetColorUnderCursor(const Value: TColor); // Added by Angel 29/11/2011 16:29:48
begin
  FColorUnderCursor := Value;
  Repaint;
end;
 
end.

El problema es que no funciona, ya que salta un error en la línea

if (MouseOverRow = 1 + THackDBGrid(TColorDBGrid).DataLink.ActiveRecord) then

concretamente, con el THackDBGrid salta un EAccess violation. Por lo que yo entiendo, que es poco, no se puede llamar al THackDBGrid como yo lo he hecho.

¿Alguna idea de cómo añadir lo que busco?

Un saludo al foro.