Ir al contenido


Foto

Pintar las filas de un dbgrid


  • Por favor identifícate para responder
12 respuestas en este tema

#1 felipe

felipe

    Advanced Member

  • Administrador
  • 3.283 mensajes
  • LocationColombia

Escrito 24 julio 2009 - 08:12

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  :D

Saludos!
  • 0

#2 eduarcol

eduarcol

    Advanced Member

  • Administrador
  • 4.483 mensajes
  • LocationVenezuela

Escrito 24 julio 2009 - 09:01



delphi
  1. if (MiQuery.RecNo mod 2) = 0 then  //Valida que sea la linea par
  2.       If (gdFocused in State) then dbgrid1.canvas.brush.color := clNavy
  3.       else dbgrid1.canvas.brush.color := clSilver;
  4.  
  5.   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
  • 0

#3 felipe

felipe

    Advanced Member

  • Administrador
  • 3.283 mensajes
  • LocationColombia

Escrito 24 julio 2009 - 09:09

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!
  • 0

#4 poliburro

poliburro

    Advanced Member

  • Administrador
  • 4.945 mensajes
  • LocationMéxico

Escrito 24 julio 2009 - 09:17

yo uso este código



delphi
  1. procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  2.   Rect: TRect; State: TGridDrawState);
  3. Var
  4.   LsValor: String; //Almacena el valor de la celda activa y aplica para las columnas 0,1,2,3,6
  5. begin
  6.   with (Sender as TStringGrid) do
  7.     Begin
  8.       Canvas.Font.Color := clBlack;
  9.       //Se definen las caracteristicas de la fuente para la fila de encabezados.
  10.       If (ACol = 0) or (ARow = 0) then
  11.         Begin
  12.           Canvas.Font.Style := [fsBold];
  13.           Canvas.Brush.Color := clBtnFace;
  14.         End
  15.       Else If (Arow Mod 2) <> 0 Then
  16.         Canvas.Brush.Color := clMoneyGreen
  17.       Else Canvas.Brush.Color := clWhite;
  18.       //Almacena el valor de la celda activa
  19.       LsValor := Cells[ACol,ARow];
  20.       //Pinta el canvas de la celda
  21.       Canvas.FillRect(Rect);
  22.       //Para la fila de encabezado no aplican los cambios en su canvas
  23.       If ARow = 0 Then
  24.         Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, LsValor)
  25.     //Lo contrario para las restantes
  26.       Else DrawText(Canvas.Handle,PChar(LsValor),StrLen(PChar(LsValor)),Rect,DT_LEFT);
  27.     End;
  28. end;



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

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


saludos
  • 0

#5 Wilson

Wilson

    Advanced Member

  • Moderadores
  • PipPipPip
  • 2.137 mensajes

Escrito 24 julio 2009 - 09:37

Un componente para probar



delphi
  1. Unit UColorDBGrid;
  2.  
  3. interface
  4.  
  5. Uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB,
  7.   Grids, DBGrids;
  8.  
  9. Type
  10.   TColorDBGrid = Class(TDBGrid)
  11.   private
  12.     FRowColorEven : TColor;
  13.     FRowColorOdd  : TColor;
  14.  
  15.     procedure SetRowColorEven(Const Value: TColor);
  16.     procedure SetRowColorOdd(Const Value: TColor);
  17.   protected
  18.     procedure DrawColumnCell(Const Rect: TRect; DataCol: Integer;
  19.       Column: TColumn; State: TGridDrawState); override;
  20.   public
  21.     constructor Create(aOwner: TComponent); override;
  22.     function AddColumn(Const aFieldName: String;
  23.         Const aMaxValue: Double = 0; aFormat: String = ''): TColumn;
  24.   published
  25.     property RowColorEven : TColor  read FRowColorEven  write SetRowColorEven;
  26.     property RowColorOdd  : TColor  read FRowColorOdd  write SetRowColorOdd;
  27.   end;
  28.  
  29. procedure Register;
  30.  
  31. implementation
  32.  
  33. procedure Register;
  34. begin
  35.   RegisterComponents('Pruebas', [TColorDBGrid]);
  36. end;
  37.  
  38. { TColorDBGrid }
  39.  
  40. function TColorDBGrid.AddColumn(Const aFieldName: String;
  41.     Const aMaxValue: Double = 0; aFormat: String = ''): TColumn;
  42. begin
  43.   Result := Columns.Add;
  44.   Result.FieldName := aFieldName;
  45.   If (DataSource.DataSet.FieldByName(aFieldName) is TNumericField) Then
  46.   begin
  47.     If (aFormat = '') Then
  48.       aFormat := (DataSource.DataSet.FieldByName(aFieldName) as
  49. TNumericField).DisplayFormat
  50.     Else
  51.       (DataSource.DataSet.FieldByName(aFieldName) as TNumericField).DisplayFormat :=
  52. aFormat;
  53.     If (aMaxValue <> 0) Then
  54.       Result.Width := Canvas.TextWidth(FormatFloat(aFormat, aMaxValue)) + 4;
  55.   end;
  56. end;
  57.  
  58. constructor TColorDBGrid.Create(aOwner: TComponent);
  59. begin
  60.   inherited;
  61.   //---
  62.   FRowColorEven := clWindow;
  63.   FRowColorOdd  := clInfoBk;
  64. end;
  65.  
  66. procedure TColorDBGrid.DrawColumnCell(Const Rect: TRect; DataCol: Integer;
  67.   Column: TColumn; State: TGridDrawState);
  68. begin
  69.   inherited;
  70.   //---
  71.   If (gdSelected in State)                And
  72.     (Screen.ActiveControl = Self)        And
  73.     (Not (csDesigning in ComponentState)) Then
  74.     //Nada
  75.   Else
  76.   If (Color <> Column.Color) Then
  77.     //Define color de columna
  78.   Else
  79.   begin
  80.     If odd(DataSource.DataSet.RecNo) Then
  81.       Canvas.Brush.Color := FRowColorOdd
  82.     Else
  83.       Canvas.Brush.Color := FRowColorEven;
  84.     DefaultDrawColumnCell(Rect, DataCol, Column, State);
  85.   end;
  86. end;
  87.  
  88. procedure TColorDBGrid.SetRowColorEven(Const Value: TColor);
  89. begin
  90.   FRowColorEven := Value;
  91.   Repaint;
  92. end;
  93.  
  94. procedure TColorDBGrid.SetRowColorOdd(Const Value: TColor);
  95. begin
  96.   FRowColorOdd := Value;
  97.   Repaint;
  98. end;
  99.  
  100. end.


  • 0

#6 Caro

Caro

    Member

  • Miembros
  • PipPip
  • 29 mensajes
  • LocationBolivia

Escrito 24 julio 2009 - 09:39

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
  • 0

#7 felipe

felipe

    Advanced Member

  • Administrador
  • 3.283 mensajes
  • LocationColombia

Escrito 24 julio 2009 - 07:56

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!
  • 0

#8 felipe

felipe

    Advanced Member

  • Administrador
  • 3.283 mensajes
  • LocationColombia

Escrito 24 julio 2009 - 08:02

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


Saludos!
  • 0

#9 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.419 mensajes
  • LocationRepública Dominicana

Escrito 24 julio 2009 - 08:16



delphi
  1. procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  2.   DataCol: Integer; Column: TColumn; State: TGridDrawState);
  3. begin
  4. With DBGrid1 do begin
  5.   if (dsCanciones.DataSet.RecNo mod 2) = 0 then  //Valida que sea la linea par
  6.       If (gdFocused in State) then begin
  7.       canvas.brush.color := clNavy
  8.     end else begin
  9.     canvas.brush.color := clSilver;
  10.     Canvas.Font.Color  := clRed;
  11.   end;
  12.  
  13.   DefaultDrawColumnCell(rect,DataCol,Column,State)
  14. end;
  15. end;



Saludos.
  • 0

#10 luk2009

luk2009

    Advanced Member

  • Moderadores
  • PipPipPip
  • 2.040 mensajes
  • LocationSanto Domingo

Escrito 25 julio 2009 - 09:33

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


delphi
  1. procedure TFRMactivasred.DBGrid1DrawColumnCell(Sender: TObject;
  2.   const Rect: TRect; DataCol: Integer; Column: TColumn;
  3.   State: TGridDrawState);
  4. begin
  5. begin
  6. if (Sender as TDBGrid).Datasource.DataSet.RecNo mod 2 = 0 then
  7.         (Sender as TDBGrid).Canvas.Brush.Color := $00FFF5EC
  8.       else
  9.         (Sender as TDBGrid).Canvas.Brush.Color := $00F5FEFE;
  10. (Sender as TDBGrid).Canvas.Font.Color := clBlack;
  11. if (Sender as TDBGrid).SelectedRows.CurrentRowSelected then
  12.         begin
  13.           (Sender as TDBGrid).Canvas.Font.Color := clWhite;
  14.           (Sender as TDBGrid).Canvas.Brush.Color := clRed
  15.         end;
  16. (Sender as TDBGrid).DefaultDrawColumnCell(rect,DataCol,Column,State);
  17. end;
  18. end; 



solo debes recordar dejar dgmultiselect  en true





  • 0

#11 JoAnCa

JoAnCa

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 775 mensajes
  • LocationPinar del Río, Cuba

Escrito 28 julio 2009 - 11:40

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



delphi
  1. procedure TfrmSubmayor492.DBGrid1DrawColumnCell(Sender: TObject;
  2.   const Rect: TRect; DataCol: Integer; Column: TColumn;
  3.   State: TGridDrawState);
  4. const
  5.   clPaleGreen = TColor($A3AB05);
  6.   clPaleRed =  TColor($B37BFD);
  7.  
  8. begin
  9.   if Column.Field.Dataset.FieldbyName('Importe').AsInteger < 0 then
  10.  
  11.     if (gdFocused in State) then dbgrid1.canvas.brush.color:=clMedGray
  12.     else dbgrid1.canvas.brush.color:=clPaleGreen;
  13.  
  14.   if (Column.Field.Dataset.FieldbyName('ImpAcum').AsInteger < 0) or
  15.     (Column.Field.Dataset.FieldbyName('DiasAcum').AsInteger >24) then
  16.  
  17.     if (gdFocused in State) then dbgrid1.canvas.brush.color:=clBlue
  18.     else dbgrid1.canvas.brush.color:=clPaleRed;
  19.  
  20.   dbgrid1.DefaultDrawColumnCell(rect,DataCol,Column,State)



Las lineas


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


son las que cambian el color segun la condicion

y como dijo Luk2009, dgmultiselect  tiene que ser true
  • 0

#12 felipe

felipe

    Advanced Member

  • Administrador
  • 3.283 mensajes
  • LocationColombia

Escrito 28 julio 2009 - 02:03

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


Saludos!
  • 0

#13 AngelF

AngelF

    Advanced Member

  • Miembros
  • PipPipPip
  • 100 mensajes
  • LocationValencia - España

Escrito 29 noviembre 2011 - 02:53

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
  1. unit UColorDBGrid;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB,
  7.   Grids, DBGrids, RzDBGrid;
  8.  
  9. type
  10.   TColorDBGrid = class(TRzDBGrid)
  11.   private
  12.     FRowColorEven: TColor;
  13.     FRowColorOdd: TColor;
  14.     FColorUnderCursor: TColor; // Added by Angel 29/11/2011 16:27:53
  15.  
  16.     procedure SetRowColorEven(const Value: TColor);
  17.     procedure SetRowColorOdd(const Value: TColor);
  18.     procedure SetColorUnderCursor(const Value: TColor); // Added by Angel 29/11/2011 16:28:55
  19.   protected
  20.     procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
  21.       Column: TColumn; State: TGridDrawState); override;
  22.     procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); // Added by Angel 29/11/2011 16:31:11
  23.   public
  24.     constructor Create(aOwner: TComponent); override;
  25.     function AddColumn(const aFieldName: string;
  26.       const aMaxValue: Double = 0; aFormat: string = ''): TColumn;
  27.   published
  28.     property RowColorEven: TColor read FRowColorEven write SetRowColorEven;
  29.     property RowColorOdd: TColor read FRowColorOdd write SetRowColorOdd;
  30.     property ColorUnderCursor: TColor read FColorUnderCursor write SetColorUnderCursor; // Added by Angel 29/11/2011 16:27:58
  31.   end;
  32.  
  33. type
  34.   THackDBGrid = class(TDBGrid); // Added by Angel 29/11/2011 16:27:43
  35.  
  36. procedure Register;
  37.  
  38. var
  39.   MouseOverRow: integer; // Added by Angel 29/11/2011 16:27:38
  40.  
  41. implementation
  42.  
  43. procedure Register;
  44. begin
  45.   RegisterComponents('Componentes', [TColorDBGrid]);
  46. end;
  47.  
  48. { TColorDBGrid }
  49.  
  50. function TColorDBGrid.AddColumn(const aFieldName: string;
  51.   const aMaxValue: Double = 0; aFormat: string = ''): TColumn;
  52. begin
  53.   Result := Columns.Add;
  54.   Result.FieldName := aFieldName;
  55.   if (DataSource.DataSet.FieldByName(aFieldName) is TNumericField) then
  56.   begin
  57.     if (aFormat = '') then
  58.       aFormat := (DataSource.DataSet.FieldByName(aFieldName) as
  59.         TNumericField).DisplayFormat
  60.     else
  61.       (DataSource.DataSet.FieldByName(aFieldName) as TNumericField).DisplayFormat :=
  62.         aFormat;
  63.     if (aMaxValue <> 0) then
  64.       Result.Width := Canvas.TextWidth(FormatFloat(aFormat, aMaxValue)) + 4;
  65.   end;
  66. end;
  67.  
  68. constructor TColorDBGrid.Create(aOwner: TComponent);
  69. begin
  70.   inherited;
  71.   //---
  72.   FRowColorEven := clWindow;
  73.   FRowColorOdd := $00F8FFC6;
  74. end;
  75.  
  76. procedure TColorDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  77.   Column: TColumn; State: TGridDrawState);
  78. begin
  79.   inherited;
  80.   //---
  81.  
  82.   if (gdSelected in State) and
  83.     (Screen.ActiveControl = Self) and
  84.     (not (csDesigning in ComponentState)) then
  85.     //Nada
  86.   else
  87.     if (MouseOverRow = 1 + THackDBGrid(TColorDBGrid).DataLink.ActiveRecord) then  // Added by Angel 29/11/2011 21:50:52 <-- AQUI SALTA EL ERROR
  88.     begin
  89.       with Canvas do
  90.       begin
  91.         Brush.Color := $0093E4C5;
  92.         Font.Color := clNavy;
  93.         Font.Style := [fsBold];
  94.       end;
  95.     end
  96.     else
  97.       if (Color <> Column.Color) then
  98.         //Define color de columna
  99.       else
  100.       begin
  101.         if odd(DataSource.DataSet.RecNo) then
  102.           Canvas.Brush.Color := FRowColorOdd
  103.         else
  104.           Canvas.Brush.Color := FRowColorEven;
  105.         DefaultDrawColumnCell(Rect, DataCol, Column, State);
  106.       end;
  107. end;
  108.  
  109. procedure TColorDBGrid.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); // Added by Angel 29/11/2011 16:31:11
  110. var
  111.   gc: TGridCoord;
  112. begin
  113.   gc := MouseCoord(x, y);
  114.  
  115.   MouseOverRow := gc.Y;
  116.  
  117.   gc := MouseCoord(X, Y);
  118. end;
  119.  
  120. procedure TColorDBGrid.SetRowColorEven(const Value: TColor);
  121. begin
  122.   FRowColorEven := Value;
  123.   Repaint;
  124. end;
  125.  
  126. procedure TColorDBGrid.SetRowColorOdd(const Value: TColor);
  127. begin
  128.   FRowColorOdd := Value;
  129.   Repaint;
  130. end;
  131.  
  132. procedure TColorDBGrid.SetColorUnderCursor(const Value: TColor); // Added by Angel 29/11/2011 16:29:48
  133. begin
  134.   FColorUnderCursor := Value;
  135.   Repaint;
  136. end;
  137.  
  138. 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.
  • 0




IP.Board spam blocked by CleanTalk.