Ayuda sobre Dbgrid nueva propiedad en Tcolumn Tcollection

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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


Código: [Seleccionar]

Código 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.

[[José Luis Garcí]]

Hola compañeros, el código anterior da errores, por lo que me he puesto hacerlo todo denuevo desde 0 y ahora tengo lo siguiente

Código Delphi [-]
unit Prueba32;
 
interface
 
uses Classes,SysUtils, Db, DBGrids, Grids;
 
type
 
  tdbp32= class;
 
  TMiColumn= Class(TColumn)
  private
     FPrueba: String;
     Fgrip: Tdbp32;
     procedure SetPrueba(value: String);
  public
     constructor create(collection: TCollection);override;
     destructor Destroy; override;
     procedure Assign(source: TPersistent); override;
     property Grid : tDbp32 read FGrip ;
  published
     property Prueba: string read FPrueba write SetPrueba;
  End;
 
  TMiGridColumn = Class(TDBGridColumns)
     function GetItem(AIndex: integer): TMiColumn;
     procedure SetItem(AIndex: integer; const Value: TMiColumn);
  public
     function Add: TMiColumn;
//     function IndexOf(ItemName:string):integer;
//     function ValueOf(ItemName:string):String;
     function ValueOfIndex(aIndex:integer):string;
     procedure Assign(Source: TPersistent); override;
     property Items[AIndex: integer] : TMiColumn read GetItem write SetItem;
  End;
 
  TDBP32 = class(TDBGrid)
   Private
    function GetColumns: TMiGridColumn;
    procedure SetColumns(Value: TMiGridColumn);
  protected
    { Protected declarations }
    function CreateColumns: TDBGridColumns; override;
  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     property Columns: TMiGridColumn read GetColumns write SetColumns;
     function ValueOfIndex(aIndex:integer):string;
  published
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
   RegisterComponents('PRUEBAS', [tdbp32]);
end;
 
{TDBP32}
Function TDBP32.GetColumns: TMiGridColumn;
begin
  Result := TMiGridColumn(inherited Columns)
end;
 
procedure TDBP32.SetColumns(Value: TMiGridColumn);
begin
  TMiGridColumn(Columns).Assign(Value)
end;
 
function TDBP32.CreateColumns: TDBGridColumns;
begin
    Result := TDBGridColumns.Create(Self, TMiColumn);
end;
 
constructor TDBP32.Create(AOwner: TComponent);
var Fcol:TDBGridColumns;
begin
  inherited;
   Fcol:=TDBGridColumns.Create(Self, TMiColumn);
end;
 
destructor TDBP32.Destroy;
begin
  inherited Destroy;
end;
 
function TDBP32.ValueOfIndex(aIndex:integer):string;
begin
   result := Columns.ValueOfIndex(aIndex);
end;
 
{TMiGridColumn}
function TMiGridColumn.GetItem(AIndex: Integer): TMiColumn;
begin
   Result:= TMiColumn(inherited Items[aIndex]);
end;
 
procedure TMiGridColumn.SetItem(AIndex: integer; const Value: TMiColumn);
begin
  inherited SetItem(AIndex, Value);
end;
 
function TMiGridColumn.Add: TMiColumn;
begin
  Result:= TMiColumn(inherited Add);
end;
 
Function TMiGridColumn.ValueOfIndex(aIndex:integer):string;
begin
  if (aIndex >=0) and (aIndex < Count)  then Result:= items[aIndex].Prueba
                                        else Result:='';
end;
 
procedure TMiGridColumn.Assign(Source: TPersistent);
var V_valor:TMiGridColumn;
    V_loop: integer;
begin
    if (Source is TMiGridColumn) then
    begin
      V_valor:=TMiGridColumn(Source);
      Clear;
      for V_loop := 0 to v_Valor.Count - 1 do
        add.Assign(v_Valor.Items[V_loop]);
    end Else Inherited;
end;
 
{TMicolumn}
constructor TMiColumn.Create(collection: TCollection);
begin
    inherited Create(collection);
    FPrueba:='';
end;
 
Destructor TMiColumn.Destroy;
begin
    inherited;
end;
 
procedure TMiColumn.SetPrueba(value: string);
begin
  if FPrueba<>value then FPrueba:=value;
 
end;
 
procedure TMiColumn.Assign(source: TPersistent);
var V_valor:TMiColumn;
begin
   if (source is TMiColumn) then  V_valor:=TMiColumn(source)
                            else  inherited;
end;
 
end.

lo que ocurre es que ahora no da fallos pero no puedo hacer la llamada convencionalmente

Código Delphi [-]
tdbp321.Columns[Column.ID].Prueba:='123';

tengo que hacerlo de la siguiente manera

Código Delphi [-]
tdbp321.Columns.Items[Column.ID].Prueba:='123';

Me podéis decir que estoy haciendo mal y si no es mucho pedir mostrarme el código con la corrección.