28 respuestas en este tema

[Desart]

Hola compañeros estoy trabajando sobre mi componente TextMulGrid y se me platean dudas y problemas, que creo podre resolver, pero llevo varios días, leyendo, estudiando, mirando otros componentes free y no logro entender el funcionamiento de Tcolum y de este el tema de Tcolection, lo que os pido es si no es mucha molestia, el esqueleto (código) de un Dbgrid, en que se añadiera a Column una nueva propiedad llamemoles XXX tipo String, lo que necesito, es como hacer que aparezca en el inspector de objetos y como registrarla, una vez conseguido esto, el resto ya me veo capaz de ir buscándome  la vida en solucionarlo, pero sin esta parte, el componente tiene poca utilidad más.

Gracias por vuestra ayuda

[Delphius]

Hola Desart,
Debes estudiar las clases TCollection y TCollectionItems. La primera es el "contenedor" de la segunda. Notarás que la clase TCollection tiene los métodos para agregar, borrar, etc los TCollectionItems.

Estas clases ofrecen el esqueleto, o armazón básico. De éstas deben HEREDAR tus clases TmyCollection y TMiCollectionItems. Si tus clases no descienden de éstas no se pueda hacer lo que buscas.
Luego está la clase Cliente que hace uso de la colección. Como por ejemplo, como bien señalas está DBGrid que contiene a  a TDBGridColumns (TCollection) y ésta a TColum (TCollectionItem).
Estos clientes se valen de una propiedad PUBLICADA que mantiene a la colección. Por ejemplo la propiedad Panels de un TStatusBar.

Hay un editor genérico de colecciones. Este editor se invoca en tiempo de diseño y es el que se utiliza para generar los items. Necesariamente para conseguir que funcione tu clase descendiente de TCollection debe redefinir el método GetOwner para que pueda aparecer en el inspector de objetos.

Este método lo que hace es localizar al dueño de la colección. Si te fijas en las clases descendientes de TCollection éstas sobreescriben al método y se encargan de apuntar al dueño (la clase cliente).
La clase TCollectionItem también tiene su GetOwner, y en este caso "localiza" a su TCollection al que se insertaron.

Si examinas el código de TCollection y TCollectionItem notarás que se trata de dos "clases amigas". Ambas se comunican y envían mensajes a fin de "sincronizarse". Algunos cambios en una hace que se necesite de cambios en la otra y por ello se necesita de esta comunicación dual. Esto explica, en parte, el uso de GetOwner en la clase TCollectionItem.

Luego tienes en la clase TCollection, una batería de métodos virtuales y/o abstractos que puedes (y algunos deberás) redefinir o sobrescribir. Empecemos con Update. Update es virtual, y se encarga de actualizar la colección para propagar los cambios hacia sus items. Si necesitas alguna acción particular en tu clase descendiente en este punto. Puedes sobreescribirla.
Update se invoca cuando hay cambios por parte de un Item y necesita comunicarselo a los demás.

También está SetItemName. SetItemName, como lo indica su nombre se encarga de asociarle un Nombre al Item insertado. Está definido como virtual. Tu clase descendiente de TCollection podría sobreescribir a este método para proporcionar el nombre predeterminado adecuado a tus necesidades.

Notify es otro método virtual. En principio no es necesario sobreescribirlo. Pero de ser necesario, si necesitas implementar algún comportamiento en particular sobre las notificaciones este es lugar para hacerlo. Notify, a como está implementado en TCollection envía mensajes a sus items dependiendo de la acción realizada:
* cnAdded: se agregó un item a la colección.
* cnExtracting: el item ha sido removido pero no liberado.
* cnDeleting: el item ha sido removido Y liberado.

Notarás que se invoca a Added y a Deleting según sea el caso. Ambos métodos están marcados como deprecated. Son virtuales, si necesitas realizar alguna acción en particular para cada caso puedes redefinirlos.

Ahora vamos con TCollectionItem. Aquí también necesitarás hacer algo de trabajo... al igual que TCollection, esta clase ofrece métodos abstractos y/o virtuales que podrías (y en ciertos casos, deberás) redefinir.

Los TCollectionItem se crean y destruyen, como puedes apreciar, en los métodos Add y Clear de TCollection. Cuando éstos se crean se envian unos mensajes hacia el Item en cuestión y afectan a una propiedad importante: Collection. Esta propiedad apunta a la colección que pertenecen.

El método SetCollection, que es virtual, puede si se desea redefinirse para adaptarlo a nuevas implementaciones. Como está definido, lo que hace es establecer la colección, de una a otra.

SetIndex por defecto mueve el item de una posición a otra. Para luego invocar al método Changed. Si necesitas hacer algo extra y/o redefinir este método para nuevas implementaciones puedes hacerlo ya que es virtual.

Changed es un método protegido y se invoca automáticamente cuando algo en el Item cambia. Este método se encarga de invocar a Update de TCollection para que éste actúe en consecuencia. Es de importancia comprender tanto a Update de TCollection como a Changed de TCollectionItem.

GetDisplayName es un método virtual. Como está implementado regresa el nombre del Item. Gracias a este método es que aparece el nombre en el editor de colecciones. Con SetDisplayName se puede establecer el nombre con el que figurará en la colección. De ser necesario puedes sobreescribirlo.

Se que he sido un tanto extenso, pero a la vez he dado una explicación muy elemental (creeme ). En la ayuda está documentado todo sobre TCollection, TCollectionItem. Aconsejo su lectura, además explora el código de ambas clases. Esto te ayudará a entender el concepto... luego puedes tomar a un cliente en particular y estudiar las clases descendientes de TCollection y TCollectionItem que ofrece.

No es sencillo de entenderlo a la primera. Como podrás apreciar resulta un tanto "aparatoso" porque debes redefinir algunas cosas, heredar y demás.

Espero al menos haber dado un norte.

Saludos,

[Delphius]

Este artículo te podrá ser de guía también.

EDITO:
Ahora recuerdo que en una ocasión el tema se discutió en CD.

Saludos,

[Desart]

Gracias por tu extensa y acertada respuesta Delphius, prometo estudiar el articulo e intentar el seguimiento de tu respuesta, el problema es que llevo  días estudiando, entre otros tantos  la guia de Desarrollo par delphi 5 páginas 1126 a la 1130, los artículos de Ian Martes, componentes como nicedbgrid y Smdbgrid, otros muchos artículos y temas tocados en el foro,  Como ya he comentado otras veces, mis pocos conocimientos fueran sobre programación lineal y aunque parezca mentira, intento hacer un esquema previo y codificación liana a linea en una libreta antes de interpretarlo en el programa (no todo claro y te puedes imaginar los resultados), en cuanto a delphi lo que he aprendido ha sido de manera autodidacta, gracias a los compañeros de los foros y a muchos libros comprados, pero reconozco que mi capacidad de asimilar muchas veces choca con mis conocimientos en Basic, Dbase IV, Clipper y turbo C, como puedes ver todo programación lineal.

        Lo que si se es que cuando veo un código donde sin meter nada más que lo que intento estudiar, suelo asimilar mejor su manera de funcionar, reconozco que no aprendo el por que la mayoría de las veces pero si aprendo de su uso, por eso es por lo que pido el esqueleto de un dbgrid, cuya única nueva propiedad XXX dentro de tColumn, me permitiría asimilar el uso de la Tcolletion, donde me estoy equivocando y por que no me sale  en el código que le he añadido al ExtMulGrid, luego podría aplicar a este código, todos las ideas que tengo en mi mente, como por ejemplo que el grid permita campos encriptados con una función predefinida que se muestre encriptados o desencriptados.

  Mi otro problema es que salgo de casa a las  6,30 para dejar a mi hija en el instituto, regreso como muy temprano de lunes a viernes a alas 4.00, los viernes a las 2.00, tengo que llevar tres días en semana a mi hija a una actividad extra escolar, dedicarle tiempo a la reformas de casa, el programa de la empresa, y tiempo para los míos, después de eso procuro ver algo de cine y cuando queda tiempo los fines de semana a la programación. No me quejo es la vida que yo he elegido, pero si es verdad que no puedo dedicarle todo el tiempo que me apetecería

[Delphius]

Hola,

De mi parte no hay apuro Desart, tu sigue... a tu ritmo y en cuanto el tiempo y tus obligaciones te lo permita (supongo que tu no tienes apuro).

De todas formas al tema lo deberás (o quizá mejor dicho: deberías) analizar con tranquilidad. No es fácil asimilarlo (al menos para mí). Lo que expuse es un resumen de lo poco que aprendí y traducí de la ayuda sobre TCollection y TCollectionItem; como yo estoy estudiando (bueno... ahorita esto está en stand-by) la VCL al llegar a TParam y TParams me tuve que ver obligado a ver las clases TCollection y TCollectionItem.
Yo a eso lo estuve analizando y viendo por casi un mes. Me quedé medianamente conforme: lo suficiente como para entender más o menos su interrelación y uso en lo que respecta para el caso de TParam y TParams.

Mucho no te sabría decir, y de lo que he explorado por la VCL el tema tiene sus mañas. En términos conceptuales (visto desde el plano de los patrones y el uso de técnicas OO) es simple: se trata de una agregación compartida o simplemente agregación. Pero internamente, en términos de código, es denso porque se tiene que analizar a ambas clases en conjunto.

Cuando se entiende el concepto y se ve el código de clases clientes y como ponen en uso las colecciones (grids, statusbar, datasets, TListView, entre otros) se observa que las clases son muy estables y no tienen demasiada variaciones: todas comparten un denominador común y eso es posible ya que TCollection y TCollectionItem ya tienen la estructura formada y esta NO CAMBIA: sólo hay que hacer uso de ellas, extendiéndolas añadiendo nuestras clases y sobreescribiendo los métodos necesarios.

Ve con calma, yo no te apuro. No te sientas amenazado. Ya sabes, si te trabas, ¡aquí estaremos!

Saludos,

[Desart]

Gracias Delphius

[Desart]

Hola compañeros he estado mirando lo links expuestos arriba  usando ademas este otrohttp://delphi.about....t/uc083101d.htm  y en la Página de IGriega el articulo sobre las coleciones, he ido montando este código

delphi

unit DBGridPrueba1;
 
interface
 
uses
  SysUtils, Classes, Controls, Grids, DBGrids;
 
 type
  TOurCollectionItem = class(TCollectionItem)
  private
    FSomeValue : String;
  protected
    function GetDisplayName : String; override;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property SomeValue : String
      read FSomeValue
      write FSomeValue;
  end;
 
  TOurCollection = class(TCollection)
  private
    FOwner : TComponent;
    function GetItem(Index: Integer): TOurCollectionItem;
    procedure SetItem(Index: Integer; Value:TOurCollectionItem);
  protected
    function GetOwner : TPersistent; override;
    procedure Update(Item: TOurCollectionItem);
  public
    constructor Create(AOwner : TComponent);
    function Add : TOurCollectionItem;
    function Insert(Index: Integer): TOurCollectionItem;
    property Items[Index: Integer]: TOurCollectionItem
      read GetItem
      write SetItem;
  end;
 
  TCollectionComponent = class(TComponent)
  private
    FOurCollection : TOurCollection;
    procedure SetOurCollection(const Value:
      TOurCollection);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property OurCollection : TOurCollection
      read FOurCollection
      write SetOurCollection;
  end;
 
 
type
  TDBGridPruebas = class(TDBGrid)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('PRUEBAS', [TDBGridPruebas]);
end;
 
procedure TOurCollectionItem.Assign(Source: TPersistent);
begin
  if Source is TOurCollectionItem then
    SomeValue := TOurCollectionItem(Source).SomeValue
  else
    inherited; //raises an exception
end;
 
function TOurCollectionItem.GetDisplayName: String;
begin
  Result := Format('Item %d',[Index]);
end;
 
constructor TOurCollection.Create(AOwner: TComponent);
begin
  inherited Create(TOurCollectionItem);
  FOwner := AOwner;
end;
 
function TOurCollection.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
 
constructor TCollectionComponent.Create(AOwner: TComponent);
begin
  inherited;
  FOurCollection := TOurCollection.Create(Self);
end;
 
destructor TCollectionComponent.Destroy;
begin
  FOurCollection.Free;
  inherited;
end;
 
procedure TCollectionComponent.SetOurCollection(
  const Value: TOurCollection);
begin
  FOurCollection.Assign(Value);
end;
 
function TOurCollection.GetItem(Index: Integer): TOurCollectionItem;
begin
     result := inherited Items[Index] as TOurCollectionItem;
end;
 
function TOurCollection.Add: TOurCollectionItem;
begin
  result := inherited Add as TOurCollectionItem;
end;
 
procedure TOurCollection.SetItem(Index: Integer; Value: TOurCollectionItem);
begin
  inherited Items[Index] := Value;
end;
 
 
function TOurCollection.Insert(Index: Integer): TOurCollectionItem;
begin
  inherited Insert(Index);
end;
 
procedure TOurCollection.Update(Item: TOurCollectionItem);
begin
    inherited Update(Item);
end;
 
end.

Pero aun Así no me sale en el Tcolumn la propiedad expuesta FSomeValue,  si podeis ayudarme.

[egostar]

Hola

No se mucho de esto pero.... no le hace falta un procedure SetSomeValue ?

Algo así

delphi

type
  TOurCollectionItem = class(TCollectionItem)
  private
    FSomeValue : String;
    procedure SetSomeValue(const value:string);
  protected
    function GetDisplayName : String; override;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property SomeValue : String read FSomeValue  write SetSomeValue;
  end;
 
procedure TOurCollection.SetSomeValue(const Value: string);
begin
  FSomeValue := Value;
end;

Salud OS

[Héctor Randolph]

Hola Desart

Siguiendo tu código, creaste una colección (TOurCollection ) y definiste los elementos de la colección (TOurCollectionItem ) esto es correcto. Sin embargo, no veo en dónde los estás utilizando, es decir, tienes un derivado de TDBGrid (TDBGridPruebas ) e incluso lo registraste como componente para que aparezca en la paleta de Delphi, pero no has hecho nada con él.

Tal vez lo que requieres es definir una nueva propiedad para que aparezca en el editor algo como esto:

delphi

type
  TDBGridPruebas = class(TDBGrid)
  private
    { Private declarations }
    FColumnas:TOurCollection 
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwer: TComponent);override;
    destructor Destroy;
  published
    { Published declarations }
    Columnas:TOurCollection read FColumnas write FColumnas; 
  end;
implementation
 
procedure TDBGridPruebas.Create(AOwer: TComponent);
begin
  inherited Create(AOwner);
  FColumnas:=TOurCollection.Create;
end;
 
procedure TDBGridPruebas.Destroy;
begin
  FreeAndNil(FColumnas);
  inherited Destroy;
end;

El código que estoy poniendo lo hago de memoria y no lo he probado pero con algunos ajuste debería funcionar.

Saludos

[Delphius]

Hola Desart,
No vi bien el código, hoy estoy bastante dormido. Pero de lo que aprecio el TCollectionComponent está sobrando.

El asunto es:
1. Diseñar una clase que descienda de TCollection y sobreescribir los métodos.
2. Diseñar una clase que descienda de TCollectionItem y sobrescribir los métodos.
3. Diseñar la clase cliente (la que hará uso de los TCollection... en tu caso tu nuevo DBGrid) y añadir una propiedad PUBLICADA que haga referencia al TCollection que diseñaste.

Si me das el tiempo me pongo a ver con calma bien el código y ver en que más está fallando.

Saludos,

[Desart]

Hola Compañeros Creo Que lo he resuelto  , estudiando El código del DbgridCheck y El de Smdbgrid, he llegado a este código, no lo doy por cerrado, por si encontráis algo que este mal o a depurar. Quedo a la Espera de los Comentarios

delphi

unit DBGridPrueba1;
 
interface
 
uses
  SysUtils, Classes, Controls, Grids, DBGrids, Graphics;
//****************************************************************************//
 type
  TMiColumn = class(TCoLumn)
  private
    FSomeValue : String;
    FValueLow: Integer;
    FCcolorValueLow: Tcolor;
    FChekValueLow: Boolean;
    procedure SetSomeValue(Value: string);
    procedure SetColorValueLow(Value: Tcolor);
    procedure SetValueLow(Value:Integer);
    procedure SetCheckValueLow(Value:Boolean);
  protected
  public
    constructor Create(Collection:TCollection); override;
    destructor Destroy; override;
  published
    property SomeValue :     String   read FSomeValue       write SetSomeValue;
    property ValueLow  :     Integer  read FValueLow        write SetValueLow       default 0;
    property ColorValueLow:  Tcolor   read FCcolorValueLow  write SetColorValueLow  default clYellow;
    property CheckValueLow:  Boolean  read FChekValueLow    write SetCheckValueLow  default False;
  end;
//****************************************************************************//
  TMiGridColumns  = class(TDBGridColumns)
  private
    function GetColumn(Index: Integer): TMiColumn;
    procedure SetColumn(Index: Integer; Value: TMiColumn);
  protected
  public
    function Add: TMiColumn;
    property Items[Index: Integer]: TMiColumn read GetColumn write SetColumn; default;
  end;
//****************************************************************************//
type
  TDBGridPruebas = class(TDBGrid)
  private
    { Private declarations }
    function GetColumns: TMiGridColumns;
    procedure SetColumns(Value: TMiGridColumns);
  protected
    { Protected declarations }
    function CreateColumns: TDBGridColumns; override;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy;
     property Columns: TMiGridColumns read GetColumns write SetColumns;
  published
    { Published declarations }
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('PRUEBAS', [TDBGridPruebas]);
end;
 
{TMiculumn}
constructor TMiColumn.Create(Collection: TCollection);
begin
   inherited Create(Collection);
   FSomeValue:='';
   FValueLow:=0;
   FCcolorValueLow:=clYellow;
   FChekValueLow:=False;
end;
 
Destructor TMiColumn.Destroy;
begin
   inherited
end;
 
procedure TMiColumn.SetSomeValue(Value: string);
begin
   if FSomeValue<>Value then FSomeValue:=Value;
end;
 
procedure TMiColumn.SetColorValueLow(Value: Tcolor);
begin
   if FCcolorValueLow<>Value then FCcolorValueLow:=Value;
end;
 
procedure TMiColumn.SetValueLow(Value: Integer);
begin
  if FValueLow<>Value then FValueLow:=Value;
end;
 
procedure TMiColumn.SetCheckValueLow(Value: Boolean);
begin
   if  FChekValueLow<>Value then   FChekValueLow:=Value;
end;
 
{TMiGridColumns}
function TMiGridColumns.Add: TMiColumn;
begin
  Result := TMiColumn(inherited Add);
end;
 
function TMiGridColumns.GetColumn(Index: Integer): TMiColumn;
begin
  Result := TMiColumn(inherited Items[Index]);
end;
 
procedure TMiGridColumns.SetColumn(Index: Integer; Value: TMiColumn);
begin
  Items[Index].Assign(Value);
end;
 
 {TDBGridPruebas}
constructor TDBGridPruebas.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
end;
 
destructor TDBGridPruebas.Destroy;
begin
  inherited Destroy;
end;
 
function TDBGridPruebas.GetColumns: TMiGridColumns;
begin
  Result := TMiGridColumns(inherited Columns)
end;
 
procedure TDBGridPruebas.SetColumns(Value: TMiGridColumns);
begin
  TMiGridColumns(Columns).Assign(Value)
end;
 
function TDBGridPruebas.CreateColumns: TDBGridColumns;
begin
    Result := TDBGridColumns.Create(Self, TMiColumn);
end;
end.

[Delphius]

Hola Desart,
Desconozco las clases DbgridCheck y Smdgrid, pero de lo que estuve viendo de tu código y de lo que ví en el código del DBGrid, creo que podría funcionar.

No lo he probado aún, pero de lo veo al principio me temía algunos goteos de memoria, y alguna que otra mala asignación de los items en tu colección e incluso en la vinculación de tu clase TCollection. Pero revisando mejor me he dado cuenta de que estás invocando a los respectivos métodos de su padre cuando es necesario con inherited.

Yo a esto, como dije antes, mucho no se... y requiere de mucha visión y análisis. A mi todavía se me hace un lío. Lo que me preocupa es el vínculo entre tu clase TMiGridColumns y tu Grid. Supuestamente gracias a que sobreescribes el método CreateColumns para devolver las clases adecuadas y asociarlo al Grid bastaría... pero no estoy totalmente seguro.

Me mareo para entenderle la mano    , y eso se debe a que cuando lo estudié al concepto no lo puse en práctica sólo lo he revisado como para captar mejor el uso de TParam y TParams.

De la revisión intuyo que podría, y debería, funcionar; pero no puedo quitarme la sensación de incomodidad por mi falta de práctica del concepto. ¿Te aparece el editor de colecciones? ¿Puedes ver bien la propiedad Items? ¿Que clase figura en el editor? La que definiste o su padre... Si esto te da bien OK, entonces es de suponer que lo demás anda bien.... Ya que las clases en las que te basaste hacen casi todo el trabajo y éstas ya tienen los controles y asignaciones bien elaborados (sobre todo la de creación y liberación, que es lo que me preocupa).

Saludos,

[Desart]

Gracias Delphius, esta probado y funciona, el problema lo tengo ahora al integrar las nuevas funciones en el dbgrid, con la llamada a las propiedades y tambien con el repintado del dbgrid.

  El problema  con las propiedades usos Self(del TdbgridPruebas).Columnus[Column.id].FSomeValue, por ejemplo y funciona bien con un grid, cuando pongo dos en el mismo form me da un error, no te lo pongo ahora por que estoy en la empresa, en cuanto a lo segundo estoy bloqueado.

  He visto en varios Componentes que antes de las propiedades y otras cases hacen

        TDBGridPruebas = Class;  //<--- Aqui me marca un error


  y luego mucho más abajo se pone la creación correcta

        TDbgridPruebas = class(TDbGrid);  //(2)


El problema es que no se por que me marca un error, no se si es un problema de uses ya que tengo

              Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls,
              Graphics, Grids, DBCtrls, Db, Menus, ImgList, DBGrids, Variants;

O si el problema esta en la creación (2)

[Desart]

Hola compañeros persiste el error cuando entro en columnas del gris, mostrandome un indice mayor, expongo este hilo, por si podeis ayudarme

[Delphius]

Hola Desart,
Lamentablemente en esto no te sabría ayudar.

Mis conocimientos no llegan hasta eso, y no dispongo del suficiente tiempo como para sentarme tranquilo a pensar.

Ojalá alguien más pueda darte una mano. Disculpa.

Saludos,

[Desart]

hola compañeros, sigo con el problema, pero decididamente el problema esta en el Self. Pero mi duda es la siguiente, en la mayoría de los componentes de Grids que he mirado, existe

delphi

TNombreGrid = Class;

Luego más adelante se implementa como

delphi

TNombreGrid = Class(TCumstomGrid)

Pero si lo intento me da un error, en la primera declaración de clase, pero no se por que, si por falta de un uses, o por mala declaración, no sé la verdad, si podéis echarme una mano os lo agradezco.

[andres1569]

Hola Jose Luís, contestando a los problemas que te surgen:

1º) Lo de declarar dos veces la misma clase, que has copiado de otros componentes. Esto se llaman declaraciones forward. Es útil cuando declaras dos o más clases en las que una hace referencia a otra en su declaración (variables, métodos o propiedades), y a la vez la otra hace referencia a la primera. Esto tiene el problema de que siempre habrá una que vaya en primer lugar, y ésta no puede saber de la existencia de la segunda; ¿la solución? emplear las declaraciones forward, en que declaras una clase en la parte de arriba simplemente para darla a conocer, y más adelante ya la desarrollas, volviéndola a declarar y especificando ya de qué clase hereda y toda la serie de métodos y propiedades.

Aunque lo hayas tomado de otros componentes deberías plantearte si te hace falta realmente: lo puedes saber muy fácilmente, eliminas la primera declaración (TDBGridPruebas = Class;) y si te salta un error en otra clase diciendo que no conoce a TDBGridPruebas entonces es que sí hacía falta esa declaración previa. Y en caso de que te haga falta, veamos el error que te salta:

delphi

Type
  TDBGridPruebas = Class; //<--- Aqui me marca un error 
 
y luego mucho más abajo se pone la creación correcta
 
Type
  TDbgridPruebas = Class(TDBGrid); //(2)

He investigado ese error y se produce porque entre una y otra declaración vuelves a meter una cláusula Type. Esto no me había pasado nunca hasta que lo he comprobado, por lo visto éso causa un error del tipo "class TDBGridPruebas is not yet completely defined", debe ser que las declaraciones forward precisan estar definidas en el ámbito de una sola sección Type. Como dicha cláusula Type está de sobra, la puedes eliminar y no te saltará el error.

2º) Sobre repintados del DBGridPruebas. No sé exactamente qué es lo que te pueda estar fallando, o que eches de menos, pero me imagino que quizás al asignar un valor de una de las columnas (TMiColumn) éste no lo ves reflejado inmediatamente en pantalla. Para lograrlo, los métodos Set que utilizas para asignar propiedades deben hacer algo más que fijar la propiedades, además deben notificarlo. Te pongo un ejemplo de cómo quedaría uno de esos métodos y ya adaptas tu los otros:

delphi

procedure TMiColumn.SetColorValueLow(Value: Tcolor);
begin
  if FCcolorValueLow <> Value then 
  begin
    FCcolorValueLow := Value;
    Changed(False);
  end;  
end;

Ahora, cuando el valor asignado es diferente al que había, aparte de asignar el nuevo valor, se llama al método Changed. Éste es un método de la clase TCollectionItem que se encarga de notificar a la colección que un Item ha cambiado, y la colección ya se encarga de notificárselo a su propietario (GetOwner) para que se repinte o haga lo que crea conveniente (de esto ya se encarga la misma clase TDBGridColumns en su método Update que avisa al Grid padre de que debe repintarse).

3º) Accesos fallidos a cada columna mediante Self(del TdbgridPruebas).Columns[Column.id].FSomeValue.

El problema aquí es el siguiente: cuando sobreescribes el método CreateColumns en la clase TDBGridPruebas, debes crear una colección del tipo que a tí te interesa, en tu caso TMiGridColumns. Ese método ya está pensado para facilitar la tarea al porogramador que, como tú, quiere crear su propio tipo de colección de columnas, sin usar el que viene por defecto. Por lo tanto, ahí debes crear una instancia de tu tipo, no del que trae Delphi:

delphi

function TDBGridPruebas.CreateColumns: TDBGridColumns;
begin
    Result := TDBGridColumns.Create(Self, TMiColumn);
end;
 
Sustituir por:
 
function TDBGridPruebas.CreateColumns: TDBGridColumns;
begin
    Result := TMiGridColumns.Create(Self, TMiColumn);
end;

Puesto que TMiGridColumns tiene una propiedad Columns que devuelve elementos del tipo TMiColumn, ahora cuando accedas a dichas columnas mediante Self(del TDBGridPruebas).Columns[Column.id].SomeValue, accederá a una columna del tipo deseado y no debería darte dicho error (aunque no lo he probado, creo que no debes tener problemas). Por cierto, puedes eliminar ya lo de Self dejando simplemente Columns[Column.id].SomeValue.

Saludos

[andres1569]

Hola:

Otra cosa que he visto y que puede que esté dando problemas es que declaras una propiedad public Columns en la clase TDBGridPruebas, con sus respectivos métodos de lectura y escritura GetColumns y SetColumns. Esta propiedad oculta a la propiedad del mismo nombre de la clase ancestra TDBGrid, que allí es published, por lo que me temo que origina un conflicto entre las columnas que creas en diseño (las del TDBGrid) y las que accedes en ejecución (las del TDBGridPruebas), ya que se comportan como propiedades distintas.

Una vez que usas el método CreateColumns para crear tu propia instancia de columnas, tal como te comenté en mi anterior mensaje, esto es suficiente puesto que la clase TDBGrid asigna la instancia que tú creas a una variable interna llamada FColumns y ya se encarga de gestionarla para leerla y escribirla, y que aparezca en el Object Inspector, así que mi consejo es que no declares de nuevo ninguna propiedad Columns y que elimines también los dos métodos GetColumns y SetColumns.

Resumiendo, basta con llamar a CreateColumns para que todo funcione correctamente, dejando que la clase TDBGrid haga el resto.

Saludos

[Desart]

Muchas gracias Andres1569, te prometo que esta semana estudio lo que me dices y te comento en este foro como me fue.

[Desart]

Hola andres1569, lo he intentado y  sigo frustrado, como tigre en una caja de zapatos, he añadido algo, más estudiado del TSMDBGRID
pero aún así nada. Te expongo el código a ver si tú o alguno de los compañeros sabe cual es el programa.

delphi

unit DBGridPrueba2;
 
interface
 
uses
  SysUtils, Classes, Controls, Grids, DBGrids, Graphics, Windows, Variants, DB, Dialogs;
//****************************************************************************//
 
 type
  TxDBGridPruebas= class;
  TXValueType = (ValueInteger,ValueFloat);
  TxMiColumn = class(TCoLumn)
  private
    FSomeValue : String;
    FXValueType: TXValueType;  //Elegimos tipo de valor Integer o Float
    FCheckValueType: Boolean;   //Si queremos chequear que el campo sea igual al tipo elegido
    FValueLow: String;      //Valor inferior o igual
    FCcolorValueLow: Tcolor;    //Color PAra este valor
    FChekValueLow: Boolean;     //Activar
    FValueMax: String;
    FCcolorValueMax: Tcolor;
    FChekValueMax: Boolean;
    FCcolorValueMid: Tcolor;
    FChekValueMid: Boolean;
    procedure SetSomeValue(Value: string);
    procedure SetColorValueLow(Value: Tcolor);
    procedure SetValueLow(Value:string);
    procedure SetCheckValueLow(Value:Boolean);
    procedure SetColorValueMax(Value: Tcolor);
    procedure SetValueMax(Value:string);
    procedure SetCheckValueMax(Value:Boolean);
    procedure SetColorValueMid(Value: Tcolor);
    procedure SetCheckValueMid(Value:Boolean);
    procedure SetXValueType(Value: TXValueType);
    procedure SetCheckValueType(Value: Boolean);
  protected
    function GetGrid: TxDBGridPruebas;
  public
    constructor Create(Collection:TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property SomeValue :     String       read FSomeValue       write SetSomeValue;
    property ValueLow  :     string       read FValueLow        write SetValueLow;
    property ColorValueLow:  Tcolor       read FCcolorValueLow  write SetColorValueLow  default clRed;
    property CheckValueLow:  Boolean      read FChekValueLow    write SetCheckValueLow  default False;
    property ValueMax  :     string       read FValueMax        write SetValueMax;
    property ColorValueMax:  Tcolor       read FCcolorValueMax  write SetColorValueMax  default clGreen;
    property CheckValueMax:  Boolean      read FChekValueMax    write SetCheckValueMax  default False;
    property ColorValueMid:  Tcolor       read FCcolorValueMid  write SetColorValueMid  default clYellow;
    property CheckValueMid:  Boolean      read FChekValueMid    write SetCheckValueMid  default False;
    property XValueType:     TXValueType  read FXValueType      write SetXValueType     default ValueInteger;
    property ChekValueType:  Boolean      read FCheckValueType  write SetCheckValueType default False;
  end;
//****************************************************************************//
// TxDBGridPruebas = class;
  TxMiGridColumns  = class(TDBGridColumns)
  private
    function GetColumn(Index: Integer): TxMiColumn;
    procedure SetColumn(Index: Integer; Value: TxMiColumn);
  protected
  public
    function Add: TxMiColumn;
    property Items[Index: Integer]: TxMiColumn read GetColumn write SetColumn; default;
  end;
//****************************************************************************//
 
  TxDBGridPruebas = class(TDBGrid)
  private
    { Private declarations }
//    function GetColumns: TxMiGridColumns;
//    procedure SetColumns(Value: TxMiGridColumns);
  protected
    { Protected declarations }
    function CreateColumns: TDBGridColumns; override;
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy;
 
  published
    { Published declarations }
//       property Columns: TxMiGridColumns read GetColumns write SetColumns;
  end;
 
procedure Register;
 
implementation
 
 
procedure Register;
begin
  RegisterComponents('PRUEBAS', [TxDBGridPruebas]);
end;
//-----------------------------------------------------------------------------
//*************************************************[ PAra los cambios del Ddbgrid  ]******
//
//-----------------------------------------------------------------------------
Procedure MixChange(Value:Boolean);
begin
    if Value=True then   TDBGrid(TxDBGridPruebas).Invalidate;
end;
 
{TMiculumn}
constructor TxMiColumn.Create(Collection: TCollection);
begin
   inherited Create(Collection);
   FSomeValue:='';
   FValueLow:='0';
   FCcolorValueLow:=clRed;
   FChekValueLow:=False;
   FValueMax:='0';
   FCcolorValueMax:=clGreen;
   FChekValueMax:=False;
   FCcolorValueMid:=clYellow;
   FChekValueMid:=False;
   FCheckValueType:=False;
end;
 
Destructor TxMiColumn.Destroy;
begin
   inherited
end;
 
procedure TxMiColumn.Assign(Source: TPersistent);
var               //Mirado y copuiado de Smdbgrid y mitecGrid
colSource: TxMiColumn;
begin
  inherited Assign(Source);
 
  if Source is TxMiColumn then
  begin
    colSource := TxMiColumn(Source);
    if Assigned(Collection) then
      Collection.BeginUpdate;
    try
      ValueLow := colSource.ValueLow;
      CheckValueLow:= colSource.CheckValueLow;
      ColorValueLow:=colSource.ColorValueLow;
      SomeValue:= colSource.SomeValue;
      XValueType:= colSource.XValueType;
      ChekValueType:= colSource.ChekValueType;
      ValueMax := colSource.ValueMax;
      CheckValueMax:= colSource.CheckValueMax;
      ColorValueMax:=colSource.ColorValueMax;
      ValueLow := colSource.ValueLow;
      CheckValueMid:= colSource.CheckValueMid;
      ColorValueMid:=colSource.ColorValueMid;
    finally
      if Assigned(Collection) then
        Collection.EndUpdate;
    end;
  end;
end;
 
function TxMiColumn.GetGrid;    //Mirado y copuiado de Smdbgrid y mitecGrid
begin
    if Assigned(Collection) and (Collection is TxMiGridColumns) then
    Result := TxDBGridPruebas(inherited Grid)
  else
    Result := nil;
end;
 
procedure TxMiColumn.SetSomeValue(Value: string);
begin
   if FSomeValue<>Value then FSomeValue:=Value;
//   TDBGrid(TDBGridPruebas).Invalidate;
Changed(False);
end;
 
procedure TxMiColumn.SetXValueType(Value: TXValueType);
begin
   if FXValueType<>value then FXValueType:=Value;
//   TDBGrid(TxDBGridPruebas).Invalidate;
Changed(False);
end;
 //*********************LOW
procedure TxMiColumn.SetColorValueLow(Value: Tcolor);
begin
   if FCcolorValueLow<>Value then FCcolorValueLow:=Value;
   Changed(False);
//     FChekValueLow:=False;
end;
 
procedure TxMiColumn.SetValueLow(Value: string);
begin
  if FValueLow<>Value then FValueLow:=Value;
  FChekValueLow:=False;
  Changed(False);
end;
 
procedure TxMiColumn.SetCheckValueLow(Value: Boolean);
begin
   if  FChekValueLow<>Value then   FChekValueLow:=Value;
   Changed(False);
//   TDBGrid(TDBGridPruebas).Invalidate;
end;
 //********************MAX
procedure TxMiColumn.SetColorValueMax(Value: TColor);
begin
   if FCcolorValueMax<>Value then FCcolorValueMax:=Value;
//     FChekValueMax:=False;
Changed(False);
end;
 
procedure TxMiColumn.SetValueMax(Value:string);
begin
   if FValueMax<>Value then FValueMax:=Value;
//   FChekValueMax:=False;
Changed(False);
end;
 
procedure TxMiColumn.SetCheckValueMax(Value: Boolean);
begin
   if  FChekValueMax<>Value then   FChekValueMax:=Value;
//   MixChange(true);
//   TDBGrid(TDBGridPruebas).Invalidate;
Changed(False);
end;
//***********************MID
procedure TxMiColumn.SetColorValueMid(Value: TColor);
begin
    if FCcolorValueMid<>Value then FCcolorValueMid:=Value;
//    FChekValueMid:=False;
Changed(False);
end;
 
procedure TxMiColumn.SetCheckValueMid(Value: Boolean);
begin
   if  FChekValueMid<>Value then   FChekValueMid:=Value;
//   TDBGrid(TDBGridPruebas).Invalidate;
Changed(False);
end;
procedure TxMiColumn.SetCheckValueType(Value: Boolean);
begin
  if FCheckValueType<>Value then  FCheckValueType:=Value;
  Changed(False);
 
end;
 
{TMiGridColumns}
function TxMiGridColumns.Add: TxMiColumn;
begin
  Result := TxMiColumn(inherited Add);
end;
 
function TxMiGridColumns.GetColumn(Index: Integer): TxMiColumn;
begin
  Result := TxMiColumn(inherited Items[Index]);
end;
 
procedure TxMiGridColumns.SetColumn(Index: Integer; Value: TxMiColumn);
begin
  Items[Index].Assign(Value);
//  TDBGrid(TxDBGridPruebas).Invalidate;
end;
 
 {TDBGridPruebas}
constructor TxDBGridPruebas.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
end;
 
destructor TxDBGridPruebas.Destroy;
begin
  inherited Destroy;
end;
 
//function TxDBGridPruebas.GetColumns: TxMiGridColumns;
//begin
//  Result := TxMiGridColumns(inherited Columns)
//end;
 
//procedure TxDBGridPruebas.SetColumns(Value: TxMiGridColumns);
//begin
//  TxMiGridColumns(Columns).Assign(Value)
//end;
 
function TxDBGridPruebas.CreateColumns: TDBGridColumns;
begin
//    Result := TDBGridColumns.Create(Self, TxMiColumn);
     Result := TxMiGridColumns.Create(Self, TxMiColumn);
end;
 
procedure TxDBGridPruebas.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
//      Columns[Column.ID].
 
 
    if Column.Field.DataSet.FieldByName(Self.Columns[Column.ID].FieldName).AsString<>'' then  //Comprobamos qe el campo no este vacio
    BEGIN   //No se si cambioralo por isnull
      if (Columns[Column.ID].FCheckValueType=true) then
      begin
          begin
             if Columns[Column.ID].FChekValueLow=true then
             begin
                if Column.Field.DataSet.FieldByName(Columns[Column.ID].FieldName).AsInteger <= StrToInt(Columns[Column.ID].FValueLow) then
                    Canvas.Brush.Color:=Columns[Column.ID].ColorValueLow;
                DefaultDrawColumnCell(rect,DataCol,Column,State);
             end;
             if Columns[Column.ID].CheckValueMax=true then
             begin
                if Column.Field.DataSet.FieldByName(Columns[Column.ID].FieldName).AsInteger >= StrToInt(Columns[Column.ID].ValueMax) then
                    Canvas.Brush.Color:=Columns[Column.ID].ColorValueMax;
                DefaultDrawColumnCell(rect,DataCol,Column,State)
             end;
             if Columns[Column.ID].CheckValueMid=true then
             begin
                if ((Column.Field.DataSet.FieldByName(Columns[Column.ID].FieldName).AsInteger > StrToInt(Columns[Column.ID].ValueLow)) and
                   (Column.Field.DataSet.FieldByName(Columns[Column.ID].FieldName).AsInteger < StrToInt(Columns[Column.ID].ValueMax))) then
                    Canvas.Brush.Color:=Columns[Column.ID].ColorValueMid;
                DefaultDrawColumnCell(rect,DataCol,Column,State)
             end;
          end;
      end else begin           //Aqui ira para float
//          if (.Columns[Column.ID].FCheckValueType=true) then if (.Columns[Column.ID].FXValueType=ValueFloat) and (Column.Field.DataType = ftFloat) then
//                                                             else if (.Columns[Column.ID].FXValueType=ValueFloat) then
         begin
           if Columns[Column.ID].ChekValueLow=true then
           begin
              if Column.Field.DataSet.FieldByName(Columns[Column.ID].FieldName).AsFloat <= StrToFloat(Columns[Column.ID].ValueLow) then
                  Canvas.Brush.Color:=Columns[Column.ID].ColorValueLow;
              DefaultDrawColumnCell(rect,DataCol,Column,State);
           end;
           if Columns[Column.ID].CheckValueMax=true then
           begin
              if Column.Field.DataSet.FieldByName(Columns[Column.ID].FieldName).AsFloat >= StrToFloat(Columns[Column.ID].ValueMax) then
                  Canvas.Brush.Color:=Columns[Column.ID].ColorValueMax;
              DefaultDrawColumnCell(rect,DataCol,Column,State)
           end;
           if Columns[Column.ID].CheckValueMid=true then
           begin
              if ((Column.Field.DataSet.FieldByName(Columns[Column.ID].FieldName).AsFloat > StrToFloat(Columns[Column.ID].ValueLow)) and
                 (Column.Field.DataSet.FieldByName(Columns[Column.ID].FieldName).AsFloat < StrToFloat(Columns[Column.ID].ValueMax))) then
                  Canvas.Brush.Color:=Columns[Column.ID].ColorValueMid;
              DefaultDrawColumnCell(rect,DataCol,Column,State)
           end;
         end;
      end;
    END;
end;
end.

No puedo ejecutar ya que todas las propiedades nuevas no las encuentra y si añado la propiedad columns, con sus metodos de lectura y grabacion, compila pero persiste el error

List index out bounds (x)  Donde X es un número