2

いくつかの Delphi 2005 アプリを XE2 に変換しようとしていますが、それらのアプリは使用できなくなったコンポーネントを使用しているため、基本を処理する独自のカスタム コンポーネントを作成しました。コンポーネントをフォームにドロップしても、通常は問題ありません。 、ただし、DFM でプロパティが既に設定されているこのコンポーネントを含む VCL フォームを開くと、問題が発生しました。

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 プロパティがあり、継承されたアイテムを使用するコレクションに 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 を処理できるように、カスタム コンポーネントを作成できるようにする記事や説明を誰か教えてもらえますか? ありがとう。

4

1 に答える 1

3

これは完全な答えではありませんが、始めることができるかもしれません (必要なすべてのプロパティを追加し、 /メソッドTColumnで読み取り/書き込みを実装する必要があります):ReadColumnWriteColumn

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
于 2012-07-18T09:24:06.180 に答える