delphi - 在自定义 Delphi 组件中实现 Columns.Columns 属性

Question

我正在将几个 Delphi 2005 应用程序转换为 XE2，它们使用的组件不再可用，因此我编写了自己的自定义组件来处理基础知识，当您删除该组件时，这通常是可以的但是，当我打开包含该组件的 VCL 表单(该组件的属性已在 DFM 中设置)时，我遇到了问题。

Delphi 2005 DFM 包含如下内容:

  object ExtendedGrid1: TExtendedGrid
    Left = 32
    Top = 16
    Width = 577
    Height = 257
    TabOrder = 0
    Columns.Columns = (
      'OE6.02'
      (
        'Test1'
        64
        False
        0
        'clWindowText'
        -11
        'Tahoma'
        0
        8
        False
        False
        False
        False
        0
        1
        0
        0
        0
        1
        0
        'clWindowText'
        -11
        'Tahoma'
        0
        8
        False
        False
        False
        False
        0
        1
        0
        'test2'
        64
        False
        0
        'clWindowText'
        -11
        'Trebuchet MS'
        0
        8
        True
        True
        False
        False
        0
        1
        0
        0
        0
        1
        0
        'clWindowText'
        -11
        'Tahoma'
        0
        8
        False
        False
        False
        False
        0
        1
        0
        ''
        '0'))
    RowHeights = (
      19
      19)
  end

即使我的组件具有基于从 TCollection 继承的类的 Columns 属性，并且我已向使用继承的 Items 的集合添加了 Columns 属性，但当我尝试在设计器中打开表单时，我收到此错误:

创建表单时出错:读取 MyGrid1.Columns.Columns 时出错:属性列不存在。

如果我创建组件的新副本，然后设置列，我会在 DFM 中看到完全不同的内容:

Columns = <
  item
    Title = 'Test1'
    Width = 64
    Editable = False
    HeaderClipStyle = csClip
    HeaderFont.Charset = DEFAULT_CHARSET
    HeaderFont.Color = clWindowText
    HeaderFont.Height = -11
    HeaderFont.Name = 'Tahoma'
    HeaderFont.Style = []
    HeaderHAlign = haRight
    HeaderInnerBevel = bvNone
    HeaderOuterBevel = bvNone
    HeaderBorderWidth = 0
    HeaderBevelWidth = 0
    ContentsClipStyle = csClip
    ContentsFont.Charset = DEFAULT_CHARSET
    ContentsFont.Color = clWindowText
    ContentsFont.Height = -11
    ContentsFont.Name = 'Tahoma'
    ContentsFont.Style = []
    ComboFilled = False
    ComboEditable = False
  end
  item
    Title = 'test2'
    Width = 64
    Editable = False
    HeaderClipStyle = csClip
    HeaderFont.Charset = DEFAULT_CHARSET
    HeaderFont.Color = clWindowText
    HeaderFont.Height = -11
    HeaderFont.Name = 'Trebuchet MS'
    HeaderFont.Style = []
    HeaderInnerBevel = bvNone
    HeaderOuterBevel = bvNone
    HeaderBorderWidth = 0
    HeaderBevelWidth = 0
    ContentsClipStyle = csClip
    ContentsFont.Charset = DEFAULT_CHARSET
    ContentsFont.Color = clWindowText
    ContentsFont.Height = -11
    ContentsFont.Name = 'Tahoma'
    ContentsFont.Style = []
    ComboFilled = False
    ComboEditable = False
  end
  end>

任何人都可以向我指出一些文章或解释，使我能够编写自定义组件，以便它可以处理旧的 Delphi 2005 DFM 吗？谢谢。

Answer 1

这不是一个完整的答案，但它可能会帮助您入门(您需要将所有必需的属性添加到 TColumn 并在 ReadColumn/WriteColumn方法):

unit Unit2;

interface

uses
  Classes, SysUtils, Contnrs;

type
  TColumn = class
  private
    FName: string;
    FWidth: Integer;
  public
    property Name: string read FName;
    property Width: Integer read FWidth;
  end;

  TColumns = class(TPersistent)
  private
    FItems: TObjectList;
    FOwner: TComponent;
    function GetCount: Integer;
    function GetItems(Index: Integer): TColumn;
  protected
    procedure DefineProperties(Filer: TFiler); override;
    function GetOwner: TPersistent; override;
    function ReadColumn(Reader: TReader): TColumn;
    procedure ReadColumns(Reader: TReader);
    procedure WriteColumn(Writer: TWriter; Column: TColumn);
    procedure WriteColumns(Writer: TWriter);
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TColumn read GetItems; default;
  end;

  TTestComponent = class(TComponent)
  private
    FColumns: TColumns;
    procedure AddTestColumns;
    procedure SetColumns(Value: TColumns);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Columns: TColumns read FColumns write SetColumns;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Test', [TTestComponent]);
end;

{ TColumns }

function TColumns.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TColumns.GetItems(Index: Integer): TColumn;
begin
  Result := TColumn(FItems[Index]);
end;

function TColumns.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TColumns.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Columns', ReadColumns, WriteColumns, Count > 0);
end;

function TColumns.ReadColumn(Reader: TReader): TColumn;
begin
  Result := TColumn.Create;
  try
    Result.FName := Reader.ReadString;
    Result.FWidth := Reader.ReadInteger;
  except
    Result.Free;
    raise;
  end;
end;

procedure TColumns.ReadColumns(Reader: TReader);
var
  Version: string;
begin
  Reader.ReadListBegin;
  Version := Reader.ReadString;
  if Version = 'OE6.02' then
  begin
    Reader.ReadListBegin;
    FItems.Clear;
    while not Reader.EndOfList do
      FItems.Add(ReadColumn(Reader));
    Reader.ReadListEnd;
  end;
  Reader.ReadListEnd;
end;

procedure TColumns.WriteColumn(Writer: TWriter; Column: TColumn);
begin
  Writer.WriteString(Column.FName);
  Writer.WriteInteger(Column.FWidth);
end;

procedure TColumns.WriteColumns(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  Writer.WriteString('OE6.02');
  Writer.WriteListBegin;
  for I := 0 to Count - 1 do
    WriteColumn(Writer, Items[I]);
  Writer.WriteListEnd;
  Writer.WriteListEnd;
end;

constructor TColumns.Create(AOwner: TComponent);
begin
  inherited Create;
  FOwner := AOwner;
  FItems := TObjectList.Create;
end;

destructor TColumns.Destroy;
begin
  FItems.Free;
  inherited Destroy;
end;

procedure TColumns.Assign(Source: TPersistent);
var
  Column: TColumn;
  I: Integer;
begin
  if Source is TColumns then
  begin
    FItems.Clear;
    for I := 0 to TColumns(Source).Count - 1 do
    begin
      Column := TColumn.Create;
      try
        Column.FName := TColumns(Source)[I].FName;
        Column.FWidth := TColumns(Source)[I].FWidth;
        FItems.Add(Column);
      except
        Column.Free;
        raise;
      end;
    end;
  end;
end;

{ TTestComponent }

procedure TTestComponent.AddTestColumns;
  procedure AddColumn(const AName: string; AWidth: Integer);
  var
    Column: TColumn;
  begin
    Column := TColumn.Create;
    try
      Column.FName := AName;
      Column.FWidth := AWidth;
      FColumns.FItems.Add(Column);
    except
      Column.Free;
      raise;
    end;
  end;
begin
  AddColumn('Test1', 64);
  AddColumn('Test2', 128);
end;

procedure TTestComponent.SetColumns(Value: TColumns);
begin
  FColumns.Assign(Value);
end;

constructor TTestComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FColumns := TColumns.Create(Self);
  AddTestColumns;
end;

destructor TTestComponent.Destroy;
begin
  FColumns.Free;
  inherited Destroy;
end;

end.

此代码在 .dfm 中产生以下结果:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 282
  ClientWidth = 418
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object TestComponent1: TTestComponent
    Columns.Columns = (
      'OE6.02'
      (
        'Test1'
        64
        'Test2'
        128))
    Left = 200
    Top = 144
  end
end