Alternar colores en dbgrid

[Casimiro Notevi]

Entonces me temo que en ese caso no me vale la propuesta, la condición es que no existan asientos juntos con colores iguales, pero tampoco pueden existir varios colores que confundan al usuario, en principio sólo dos colores.
Es lo que me han pedido, por mí se los presento todos en blanco y negro y se acabó, que el usuario se fije bien


A ver, eso de la línea parece interesante, ¿cómo lo haces?

[cloayza]

Revisando todos los post se me ocurrio hacer lo siguiente...

Me recorde que cuando en la grilla uno realiza seleccion de registros internamente se utiliza un TList para almacenar los bookmark de los registros seleccionados, debido a eso pense en utilizar un TStrings para almacenar la informacion que se requiere por cada registro.

Este es el resultado, tome el codigo del amigo duilioisola y le hice algunos cambios...

Código Delphi [-]
 public
    { Public declarations }
    Sombra:Boolean;
    List:TStrings;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
   index:Integer;
begin
      with TDBGrid(Sender) do
      begin
         if (gdFocused in State) then //Si tiene el foco
         begin
            Canvas.Font.Color := clWhite;
            Canvas.Brush.Color := clHighlight;
         end
         else
         begin
//Busco el Asiento en el List            
Index:=List.IndexOf(DataSource.DataSet.FieldByName('ASIENTO').AsString);
//Obtengo el valor boolean para realizar la pregunta...
            if Boolean(List.Objects[index]) then
            begin
               Canvas.Font.Color := clBlack;
               Canvas.Brush.Color := clYellow;
            end
            else
            begin
               Canvas.Font.Color := clBlack;
               Canvas.Brush.Color := clInfoBk;
            end;
         end;
         DefaultDrawColumnCell(Rect, DataCol, Column, State);
      end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     List:=TStringList.Create; //Creo el list que almacenara los datos de cada rfegistro...
     
     Table1.Active:=True;
end;

procedure TForm1.Table1AfterOpen(DataSet: TDataSet);
begin
   Sombra := True;
end;

procedure TForm1.Table1CalcFields(DataSet: TDataSet);
var
   Index:Integer;
begin
      //Verifico si el Asiento ya esta en la List...
     Index:=List.IndexOf(DataSet.FieldByName('ASIENTO').AsString);
     if Index=-1 then
     begin
          //AL no encontrase en List lo agrego con el valor booleano de sombra...
          List.AddObject(DataSet.FieldByName('ASIENTO').AsString, Pointer(Sombra) );
          Sombra := not Sombra;
     end;
end;

Por supuesto faltan las validaciones...
Saludos cordiales

[[José Luis Garcí]]

Casimiro, la verdad es una idea no la he llevado a la practica, pero me imagino que si la dibujas en el grid directamente te puede pasar que desaparezca al moverse como te ocurre en los colores, más bien pienso que seria añadirle un nuevo campo no visible al grid, y cada vez que ocurra la condición que te comentaba marco la casilla.

De todas maneras, piensa que por el sistema de asignación de color sin anclarlo a una condición estática (en este caso el número de asiento), te pueden desaparecer los colores al moverse el Grid.

[cloayza]

Aqui incorporando muchos colores...

Código Delphi [-]
    Sombra:Boolean;
    List:TStrings;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
   index:Integer;
begin
      with TDBGrid(Sender) do
      begin
         if (gdFocused in State) then //Si tiene el foco
         begin
            Canvas.Font.Color := clWhite;
            Canvas.Brush.Color := clHighlight;
         end
         else
         begin
            {Sombra puede ser 1 o 2. Si está a 0 no esta establecido}
            Index:=List.IndexOf(DataSource.DataSet.FieldByName('ASIENTO').AsString);

            Canvas.Font.Color := clBlack;
           Canvas.Brush.Color := TColor(List.Objects[index]);

         end;
         DefaultDrawColumnCell(Rect, DataCol, Column, State);
      end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     List:=TStringList.Create;
     Table1.Active:=True;
end;

procedure TForm1.Table1AfterOpen(DataSet: TDataSet);
begin
   Sombra := true;
end;

procedure TForm1.Table1CalcFields(DataSet: TDataSet);
var
   Index:Integer;
   fColor:TColor;
begin
     Index:=List.IndexOf(DataSet.FieldByName('ASIENTO').AsString);
     if Index=-1 then
     begin
          fColor:=RGB(Random(205),Random(205),Random(205));
          List.AddObject(DataSet.FieldByName('ASIENTO').AsString, Pointer(fColor)); //Sombra) );
          Sombra := not Sombra;
     end;
end;

[[Chris]]

Bueno creo que ya tengo una primera alternativa...

Se trata de la mejora del código que ofrecí anteriormente. Solucionando sus problemas. Casimiro tendrá que revisar lots cambios hechos con respecto al programa que el subió hace unas horas.

Aquí el archivo que he subido.

Saludos,
Chris

[[Chris]]

Este es el código:

Código Delphi [-]
procedure TForm24.gr1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
const
    background_colors: array[0..1] of TColor = (clYellow, clWhite);
var
    BackgroundColor: TColor;
begin
if (UltimoValor > qr1.FieldByName('NUMEROASIENTO').Value) then
begin
    if Pos(Format('-%s-', [qr1.FieldByName('NUMEROASIENTO').Value]), GrupoImpar) > 0 then
        BackgroundColor := background_colors[1]
    else
        BackgroundColor := background_colors[0];
end
else
begin
    if qr1.FieldByName('NUMEROASIENTO').Value <> UltimoValor then
            BoolSwitch := (not BoolSwitch);

        BackgroundColor := background_colors[Integer(BoolSwitch)];
        UltimoValor := qr1.FieldByName('NUMEROASIENTO').Value;
end;

if not (gdSelected in State) then
    TDBGrid(Sender).Canvas.Brush.Color := BackgroundColor;

TDBGrid(Sender).DefaultDrawColumnCell(Rect, DataCol, Column, State);

if not (UltimoValor > qr1.FieldByName('NUMEROASIENTO').Value) then
    if (BoolSwitch) and (Pos(Format('-%s-', [qr1.FieldByName('NUMEROASIENTO').Value]), GrupoImpar) = 0) then
        GrupoImpar := (GrupoImpar + Format('-%s-', [qr1.FieldByName('NUMEROASIENTO').Value]));
end;

Cada vez que se hace la consulta hay que reiniciar las variables globales (UltimoValor, GrupoImpar, BoolSwitch) de esta forma:

Código Delphi [-]
  // inicializar los datos del control de grupo
  UltimoValor := 0;
  GrupoImpar := '';
  BoolSwitch := False;

No es un código perfecto. Obviamente se puede obtimizar un poco, de hecho creo que deberían tomarlo tipo pseudocodigo. Pero en mis pruebas ha funcionado según los requerimientos que le entiendo a casimiro. Cualquier inconveniente, pues dejadlo saber.

Saludos,
Chris

[[Chris]]

De última hora he notado que si los registros no traen ningún tipo de orden en NUMEROASIENTO, el código que compartí hace unos minutos no funciona a cómo debería hacerlo. Vamos a trabajar en ello. Ya veremos una solución, nada más que parece no estar nada fácil :/

[rgstuamigo]

Empezado por Casimiro Notevi

...
Y repito, el problema no es pintarlos cuando se se hace el select y se presenta en el grid, el problema viene después cuando te mueves por el grid con teclas o ratón.

A mi me late que la solucion a tu problema ya ha sido resuelta con tanta alternativa que te han dado , pero nada mas se han olvidado de mencionarte algo que es lo siguiente:
Por experiencia propia (y no solo me ha pasado a mi, sino tambien a muchos ) que cuando utilizamos el evento OnDrawColumnCell del DBGrid para por ejemplo pintar algunas filas o celdas del Grid, por algunas extraña razon(Que tengo que invetigarla mas a fondo) al mover el scroll (movernos por los registros)del DBGrid ya sea con el mouse o con el teclado, Windows no dibuja por completo el DBGrid,es decir, pareciera que tiene un comportamiento extraño, por eso es que quizas te ha parecido que las soluciones que te han propuesto no te funcionan bien.
Para solucionar ese problema y hacer que windows redibuje el DBGrid cada ves que te muevas por los registros, es necesario llamar al método Invalidate del DBGrid en algun evento específico, por ejemplo yo utilizo el evento OnDataChange del DataSouce al que está enganchado el DBGrid para hacer el repintado ya que lo veo el más adecuado para hacerlo.

Código Delphi [-]
procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
DBGrid1.Invalidate; //<- Hago que mi DBGrid se redibuje, eso implica que
             // internamente se ejecuta el evento OnDrawColumnCell del DBGrid
end;

Espero haberte aclarado un poco el panorama.
Saludos...

[Casimiro Notevi]

Empezado por Chris

Bueno creo que ya tengo una primera alternativa...Chris

Creo que no vale, el problema es que almacena en un string los números que ya ha presentado para saber con qué color presentarlo, para ello hay que recorrer desde el principio hasta el final todos los registros. Si por ejemplo vas directamente al último con ctrl+fin entonces no guarda esos valores y no puede pintarlos.

[roman]

No sé si sirva para esto, pero lo más parecido que he encontrado en Firebird para las variables de usuario de MySQL es RDB$SET_CONTEXT() y RDB$GET_CONTEXT().

Podrías probar a ver si funcionan similarmente.

// Saludos

[cloayza]

Una pequena optimizacion de codigo que propuse anteriormente.

Código Delphi [-]
 Sombra:Boolean;
    List:TStrings;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ESTE ES EL CODIGO QUE SE REQUIERE...}
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
   index:Integer;
   fColor:TColor;
begin
      if Not Assigned(List) then
         List:=TStringList.Create;

      with TDBGrid(Sender) do
      begin
         if (gdFocused in State) then
         begin
            Canvas.Font.Color := clWhite;
            Canvas.Brush.Color := clHighlight;
         end
         else
         begin
              Index:=List.IndexOf(DataSource.DataSet.FieldByName('ASIENTO').AsString);
              if Index=-1 then
              begin
                   if Sombra then fColor:=clYellow  else fColor:=clInfoBk;
{Para usar multicolores aleatorios descomentar esta linea...}
                   //fColor:=RGB(Random(205),Random(205),Random(205));

                   index:=List.AddObject(Datasource.Dataset.FieldByName('ASIENTO').AsString, Pointer(fColor));

                   Sombra := not Sombra;
              end;

              Canvas.Font.Color := clBlack;
              Canvas.Brush.Color := TColor(List.Objects[index]);

              DefaultDrawColumnCell(Rect, DataCol, Column, State);
          end;
      end;
end;

Saludos cordiales

[[Chris]]

Empezado por Casimiro Notevi

Creo que no vale, el problema es que almacena en un string los números que ya ha presentado para saber con qué color presentarlo, para ello hay que recorrer desde el principio hasta el final todos los registros. Si por ejemplo vas directamente al último con ctrl+fin entonces no guarda esos valores y no puede pintarlos.

Tienes razón. De hecho, ni conocía -o ya se me había olvidado- ese acceso por teclado (CRTL + END). Habrá que modificar el código entonces. Teniendo en cuenta lo que has dicho, podría almacenarse los número al momento de cambiar el registro actual. No sé exactamente como se haría esto, pero debe haber alguna forma de hacerlo.

[Casimiro Notevi]

Empezado por rgstuamigo

[..] invalidate [..]

He probado 3 alternativas y con el invalidate y sin él... hace lo mismo

Empezado por Chris

Tienes razón. De hecho, ni conocía -o ya se me había olvidado- ese acceso por teclado (CRTL + END).

Está duro de roer el hueso

Empezado por cloayza

Una pequena optimizacion de codigo que propuse anteriormente.

Nada, acaba alternando colores incorrectamente.

[Casimiro Notevi]

Empezado por roman

No sé si sirva para esto, pero lo más parecido que he encontrado en Firebird para las variables de usuario de MySQL es RDB$SET_CONTEXT() y RDB$GET_CONTEXT().

Podrías probar a ver si funcionan similarmente.
// Saludos

Voy a ver qué encuentro sobre eso

[roman]

Empezado por Chris

Tienes razón. De hecho, ni conocía -o ya se me había olvidado- ese acceso por teclado (CRTL + END). Habrá que modificar el código entonces.

Es que no sólo es eso. Hay muchas formas de desplazarse por un DBGrid. De entrada puedes arrastrar el botón de la barra de desplazamiento a una posición arbitraria, o puedes moverte por código, por ejemplo, mediante una búsqueda, etc.

El evento DrawColumnCell existe porque en la práctica es casi imposible predecir cuales celdas han de dibujarse. Por ello es que considero que cualquier técnica que recurra a una suerte de "último valor" fallará tarde o temprano pues presupone un pintado secuencial de las filas, cosa que no siempre se dará de esa manera.

// Saludos

[Casimiro Notevi]

Empezado por roman

Código SQL [-]set @asiento=0,@colorear=0;
select asiento, control, fecha, if (@asiento <> asiento, @colorear:=1-@colorear, @colorear) as colorear, @asiento:=asiento
from tabla
order by fecha, asiento, control

Cómo se traduce esta línea a:
if (@asiento <> asiento, @colorear:=1-@colorear, @colorear) as colorear, @asiento:=asiento

if @asiento<>asiento then
@colorear = 1-@colorear
else
@asiento = @colorear;
@asiento = asiento;

Supongo que @loquesea quiere decir que es una variable.

[[Delphius]]

Empezado por Chris

No pensaba en contestarte xq era desvirtuar el hilo. Pero has sido demaciado tosco y necesito contestar tus desagradables palabras.

Bien merecido lo tengo, y si... me pasé de las manos. Era mi total intención llamarte la atención.

Empezado por Chris

Creo que lo que a tí te molesta es una opinión contraria a tus ideas.

No tengo problemas en que se me critique mis ideas. No lo que no pienso tolerar en una persona es pretender acabar un buen debate y discusión exponiendo púlblicamente la frase "¡Y punto!" o similar. Al decirlo ya pretendiste dar por acabado todo intento de negociar o de analizar otras perspectivas.

Y voy a seguir insistiendo... punto final no se vale ganar... yo también puedo ser muy infantil y bien gallego.

Y si te quiero llamar la atención lo voy a hacer a mi estilo cómico, y de mal humor... ¿A poco te no agrada NewDelphius? Ba... pensé que lo extrañaban por aquí.

[quote=Chris;386915]
No critique a cada una de las personas que propuso una solución, hay muchas soluciones propuestas si te fijas en todo el hilo. Critiqué, no solo la solución propuesta por Roman y desarrollada por tí, sino todas las que usen de muleta a la base de datos.
[quote]
A veces nos vemos obligados a emplear esas muletas Cris... entiende eso de una vez.
El que se hace UNA VEZ en todo el sistema no es un gran pecado... ¡entendelo! abrí un poco la cabeza.

Si prestaras atención te darás cuenta que inicialmente yo le estaba dando vueltas por el lado cliente. Y luego viendo como se estaba dando el hilo y aprovechando una SUGERENCIA de roman es que me tomé la buena volutad de seguir por ese lado y ver que más hay.

Soy yo y otros usuarios quienes impulsados por traer nuevas visiones, propuestas y alternativas no nos queremos quedar en un sólo lado.

Y disculpa que lo diga pero no por utilizar esas "salidas fáciles" nos hace ser muletas.

Empezado por Chris

Las critico (en el mejor sentido de la palabra) y lo seguiré haciendo.

Actitudes cerradas la podemos tener todos, aunque reconozco que no eres la persona más cerrada... mi padre te lleva mucha ventaja.

Ojalá Cris no te vea por aquí tratando de darle un giro a tus ideas y desafiar tu postura... sería un duro golpe darle un repaso al archivo de tus palabras.

Te aviso que el tiempo es un buen maestro de que nuestras visiones pueden (y van) a cambiar.

Yo soy bastante crítico, pero al menos dejo un espacio a la posibilidad de un arreglo y de ser un poco más abierto o de darle una posibilidad de que me cautive y se defienda. Tu por parte cerraste las puertas ni bien al comienzo de haber dado la propuesta a Casimiro.

Empezado por Chris

Creo que mi critica no fue en mal modo, si te fijas, eres el único que la ha tomado a mal. Te has ahogado en un vaso de agua sinceramente.

Si lo fue. Yo no voy a permitir que un usuario, sea quien sea, nos haya llamado en forma indirecta, y con cierta soberbia, ineficientes.

Lee tu frase por favor:

Empezado por Chris

o es muy buena idea que la base de datos funcione de muleta de un programador que no pudo solucionar un problema de la GUI

Caratulas a un desarrollador de rengo, inepto... que no pudo hacer solucionar un problema sencillo de la GUI.
Ese es el mensaje que transmite tus palabras... Deberías saber que significa llamar a alguien de/usar muletas: rengo, mula, tonto. Obstinado, tosco, grosero.

Llamaste de muletas a Casi, Roman, a mi, y a fjcg02 cuando empezamos a darle una nueva posibilidad. Nos tiraste y sentenciaste en la cara con tu punto final.

Eso no lo voy a permitir.

Yo si he sido muleta en la forma de dirigirme hacia tí, pero no en el hilo al probar otras alternativas.

Empezado por Chris

Sabes leer, pero no interpretar. Casimiro hizo lo correcto, vino a pedir ayuda a otros programadores.

Si, ¡y le tiras en la cara de que no pudo resolver un problema y debe recurrir a una muleta porque es rengo!
Eso no es apropiado Cris.
El vino porque tiene un problema, de no tenerlo no hubiera dicho nada. Tu estuviste de más al meter la muleta.

Ojalá no te veas envuelto en una.

Empezado por Chris

Si así lo quieres ver desde tu distorsionada perspectiva.... allá tú. El que se pretende con aires de superioridad eres tú.

Yo no vine con aires de galantería ni superioridad. Estoy seguro de que aquí en ClubDelphi hay personas que saben muchísimo más que yo.
De que se, se... algo se. Muchísimo no... poco... no sabría decirlo. Pero no puedo ni me atrevería de llamar muletas a otro.

Empezado por Chris

No toleras la más mínima critica a tus opiniones o en este caso, a tu manera de solucionar las cosas.

Admito que puedo llegar a ser intolerante en algunas cosas pero en esto no.
Repito que eres tu el que ha sido intolerante: no toleraste la nueva propuesta que se estaba analizando... repito de nuevo: tu sentenciaste... tu dictaste... tu quisiste poner punto final.

A todo eso yo es que le quiero poner punto final.

Empezado por Chris

No programo desde ayer, sé que es KISS. Yo creo que lo único que sabes es que KISS es la abreviación de "Keep it simple stupid", más no sabes lo que eso conlleva. Puedes aprenderlo aquí.

A ver cris, no me vengas pretender enseñarme lo que significa. Senalé el principio KISS para apuntar que a veces es mejor optar por ciertas simplezas sabiendo que hay otros factores que tu no estabas considerando: entre ellos, que Casimiro está presionado para tenerlo para ayer, que no tiene presupuesto para mucho, que el enfoque que tu estabas dando estaba demostrando no ser el más adecuado.

Se te indicó que había una serie de problemas y tu le seguías dando... eres tu el que se ha sido insistente.

No supiste ver que había algo más que se tenía en cuenta... Y la propuesta KISS de por el lado de la base de datos si bien puede que no sea lo más adecuado al menos podría traer algo de equilibrio y permitiría salir de prisas.

Luego, podría destinar tiempo, para una siguiente versión, o mejora al sistema analizarlo con otras perspectivas.

Empezado por Chris

Si no sabías, hay otra regla en el desarrollo de software: NO DES NADA POR SENTADO. Deberías tenerla siempre en cuenta porque es una de la más importantes.

Una de las más importante pero no la más importante.
Si no hay nada que dejar por sentado... entonces creo yo que te deberías comer esas palabras: diste por sentado, sentenciaste de que habrá problemas de perfomance con el SP. ¿Tienes los suficientes elementos como para afirmar con total certeza de que el SP le será muy lento, que sus usuarios se quejarán?

Deja eso a Casi... tu que quedaste sentado, encerrado en la idea del cliente, en verlo por el lado del swich booleano, de compararlo con una variable "anterior".

Pero te viste muy "lerdo" al no captar de que la solución que tu proponías no estaba correcta.

Me alegra de que insistieras en tus ideas, de que buscaras mejorar tu código pero te veníamos diciendo de una u otra forma que hacía falta algo más.

TU diste por sentado algunas cosas...

Empezado por Chris

Creo que en esa frase te estás reflejando tú. Te juro que no me siento aludido.

Error, te reflejaste tú. Ti diste el punto final hace tiempo... te lo voy a hacer recordar. ¿Viste de feo que alguien te lo diga?
A mi no me afecta en lo más mínimo... yo más que nada te lo señalo para que en lo sucesivo sea más cuidadoso cuando pretendas callar a alguien diciéndole "Punto".

Las palabras te van a rebotar, yo no le voy a seguir dando al debate... No tiene sentido discutir más.... Ya te dije lo que te debía decir, pero te digo que pueden venir otros a decirte que ese "Punto" estuvo de más.

Si no te lo dijeron los demás, no quiere decir que se pueda pasar. Yo al menos no lo iba dejar pasar... Porque al tema lo veníamos tratando bien. Si tu lo querías cerrar, consideré bueno hacerte llamar la atención de que el tema todavía estaba abierto.

Te aviso Cris que no es la primera vez que veo en ti la idea de dar esas estocadas finales.... y no es la primera vez tampoco que intentas pasar de "fino" una indirecta como muletas. En ese entonces no me ví en esos hilos... pero a esta no la dejo pasar.

Saludos,
PD: Disculpen que metiera dervirtuadas al hilo.

[[Delphius]]

Empezado por Casimiro Notevi

Cómo se traduce esta línea a:
if (@asiento <> asiento, @colorear:=1-@colorear, @colorear) as colorear, @asiento:=asiento

if @asiento<>asiento then
@colorear = 1-@colorear
else
@asiento = @colorear;
@asiento = asiento;

Supongo que @loquesea quiere decir que es una variable.

Eefectivamente Casimiro. Es la traducción correcta.
Y el @ es para simbolizar y declarar una variable.... al igual que en MS SQL Server.

[[Delphius]]

La idea de tener una Lista, a modo de campo ficticio como el campo "Colorear" o la idea de un campo en el DBGrid y que no se muestre para que almacena un número identificador del color debería funcionar.

A como veo, es necesario tener una lista o una estructura, o algo por el estilo, que lleve la referencia sobre el color al pintar. No basta con aplicar técnica de comparación con valores anteriores, o siguientes... hay que verlo globalmente: como un conjunto de registros.

Supuestamente, de ese modo en el evento OnDrawColumnCell se podría consultar dicho valor con algo como Lista[DBGrid.RecNo] y si es 0,1,2 o lo que fuese pintar de un color a otro.

En teoría por más que se dezplazara por los registros, al consultar el RecNo (sabiendo que en la lista estarán todos los registros devueltos por la consulta) se debería poder recuperar el valor correcto y pintar de forma inequívoca la fila.

Es fundamental que exista un proceso que se encargue de analizar el conjunto de datos previamente y llenar la lista con los valores adecuados.
Una vez hecho esto recién ya es posible pintar.

Saludos,

[cloayza]

Empezado por Casimiro Notevi

Nada, acaba alternando colores incorrectamente.

Amigo he implementado el codigo en ejemplo de Chris, y me anda de maravillas...

Te copio el codigo completo de la unidad.

Código Delphi [-]
unit Unit24;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, IBCustomDataSet, IBDatabase, StdCtrls, ComCtrls, Grids, DBGrids;

type
  TForm24 = class(TForm)
    gr1: TDBGrid;
    DS1: TDataSource;
    dtp1: TDateTimePicker;
    lb1: TLabel;
    btn1: TButton;
    DB1: TIBDatabase;
    TR1: TIBTransaction;
    QR1: TIBDataSet;
    QR1CODIGOAPUNTE: TIntegerField;
    QR1CODIGOEMPRESA: TIntegerField;
    QR1EJERCICIO: TSmallintField;
    QR1NUMEROASIENTO: TIntegerField;
    QR1LINEAASIENTO: TIntegerField;
    QR1FECHAASIENTO: TDateField;
    QR1CODIGOCUENTA: TIBStringField;
    QR1CONCEPTO: TIBStringField;
    QR1DEBE: TFloatField;
    QR1HABER: TFloatField;
    QR1FECHACREACION: TDateField;
    QR1HORACREACION: TTimeField;
    procedure btn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure gr1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure dtp1Exit(Sender: TObject);
  private
    { Private declarations }
{    nValorAnt: Integer;
    FColor, BColor: TColor;
    UltimoValor: Variant;
    BoolSwitch: Boolean;
    GrupoImpar: String;
}
  public
    { Public declarations }
    Sombra:Boolean;
    List:TStrings;
  end;

var
  Form24: TForm24;

implementation

{$R *.dfm}

procedure TForm24.btn1Click(Sender: TObject);
begin
  db1.Open;
  tr1.Active:=True;
  qr1.Close;
  qr1.selectsql.text := 'select * from tbapuntes where codigoempresa=2 and ejercicio=2 and codigoestadoapunte=2 '+
                        'and fechaasiento  between :fechadesde and :fechahasta '+
                        'order by codigoempresa, ejercicio, numeroasiento, lineaasiento';
  qr1.Params[0].AsDate := dtp1.Date;
  qr1.Params[1].AsDate := dtp1.Date;

  if Assigned(List) then
     List.Clear;

  // inicializar los datos del control de grupo
  qr1.Open;
  gr1.SetFocus;
end;

procedure TForm24.dtp1Exit(Sender: TObject);
begin

  btn1.SetFocus;
end;

procedure TForm24.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     DB1.Close;
end;

procedure TForm24.gr1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
   index:Integer;
   fColor:TColor;
begin
      if Not Assigned(List) then
         List:=TStringList.Create;

      with TDBGrid(Sender) do
      begin
         if (gdFocused in State) then
         begin
            Canvas.Font.Color := clWhite;
            Canvas.Brush.Color := clHighlight;
         end
         else
         begin
              Index:=List.IndexOf(DataSource.DataSet.FieldByName('NUMEROASIENTO').AsString);
              if Index=-1 then
              begin
                   if Sombra then fColor:=clYellow  else fColor:=clInfoBk;

                   //fColor:=RGB(Random(205),Random(205),Random(205));

                   index:=List.AddObject(Datasource.Dataset.FieldByName('NUMEROASIENTO').AsString, Pointer(fColor));

                   Sombra := not Sombra;
              end;

              Canvas.Font.Color := clBlack;
              Canvas.Brush.Color := TColor(List.Objects[index]);

              DefaultDrawColumnCell(Rect, DataCol, Column, State);
          end;
      end;
end;

end.

Saludos cordiales