DELPHI基础教程：Delphi自定义部件开发（三）[3]

Posted 2023-05-01

参考技术A

　　控制Delphi是否存储属性的方法是在属性声明后面加stored指令 后跟True或False 或者是布尔方法名 你可以给任何属性的声明或重声明加stored表达式 下面的代码显示了部件声明三种新属性 一个属性是总是要存储 一个是不存 第三个则决定于布尔方法的值

　　type

　　TSampleCompiment = class（TComponent）

　　protected

　　function storeIt: Boolean;

　　public 正常情况下在不存

　　property Important: Integer stored True; 总是存储

　　published 正常情况下保存

　　property UnImportant: Integer stored False; 不存

　　property Sometimes: Integer stored StoreIt; 存储依赖于函数值

　　end;

　　④ 载入后的初始化

　　在部件从存储的描述中读取所有的属性后 它调用名为Loaded的虚方法 这提供了按需要执行任何初始化的机会 调用Loaded是在窗体和它的控制显示之前 因此 不需要担心初始化会带来屏幕闪烁

　　在部件载入属性时初始化它 要覆盖Loaded方法

　　在Loaded方法中 要做的第一件事是调用继承的Loaded方法 这使得在你的部件执行初始化之前 任何继承的属性都已初始化

　　下面的代码来自于TDatabase部件 在装入后 TDatabase试图重建在它存储时已打开的连接 并描述在连接发生异常时如何处理

　　procedure TDatabase Loaded

　　begin

　　inherited Loaded; 总是先调用继承的方法

　　Modified; 设置内部标志

　　try

　　if FStreamedConnected then Open; 重建联接

　　except

　　if csDesigning in ComponentState then 在设计时

　　Application HandleException（self） 让Delphi处理异常

　　else raise; 否 则

　　end;

　　end;

　 　 Delphi部件编程实例

　　 创建数据库相关的日历控制 TDBCalendar

　　当处理数据库联接时 将控制和数据直接相联是很重要的 就是说 应用程序可以建立控制与数据库之间的链 Delphi包括了数据相关的标签 编辑框 列表框和栅格 用户可以使自己的控制与数据相关

　　数据相关有若干等级 最简单的是只读数据相关或数据浏览 以及反映数据库当前状态的能力 比较复杂的是数据相关的编辑 也即用户可以在控制上操作数据库中的数据

　　在本部分中将示例最简单的情况 即创建联接数据库的单个字段的只读控制 本例中将使用Component Palette的Samples页中的TCalendar部件

　　创建数据相关的日历控制包括下列几步

　　● 创建和注册部件

　　● 使控制只读

　　● 增加数据联接（Data Link）

　　● 响应数据改变

　　 创建和注册部件

　　每个部件的创建都从相同的方式开始 在本例中将遵循下列过程

　　● 将部件库单元命名为DBCal

　　● 从TCalendar继承一个新部件 名为TDBCalendar

　　● 在Component Palette的Samples页中注册TDBCalendar

　　下面就是创建的代码

　　unit DBCal;

　　interface

　　uses SysUtils WinTypes WinProc Messages Classes Graphics Controls

　　Forms Grids Calendar;

　　type

　　TDBCalendar=class（TCalendar）

　　end;

　　procedure Register;

　　implementation

　　procedure Register;

　　begin

　　RegisterComponents（Samples [TDBabendar]）

　　end;

　　end

　　 使控制只读

　　因为这个数据日历以只读方式响应数据 所以用户不能在控制中改变数据并指望它们反映到数据库中

　　使日历只读包含下列两步

　　● 增加只读属性

　　● 允许所需的更新

　　 增加只读属性

　　给日历控制增加只读选项是直接过程 通过增加属性 可以提供在设计时使控制只读的方法 当属性值被设为True 将使控制中所有元素不可被选

　　⑴ 增加属性声明和保存值的private域

　　type

　　TDBCalendar=class（TClendar）

　　private

　　FReadOnly: Boolean;

　　public

　　constructor Create （Aowner: TComponent） override;

　　published

　　property ReadOnly: Boolean read FReadOnly write FReadOnly default True;

　　end;

　　constructor TDBCalendar Create（Aowner: TComponent）

　　begin

　　inherited Create（AOwner）

　　FReadOnly := True;

　　end;

　　⑵ 覆盖SelectCell方法 使得当控制是只读时 不允许选择

　　function TDBCalendar SelectCell（ACol Arow: Longint） Boolean;

　　begin

　　if FReadOnly then

　　Result := False

　　else

　　Result := inherited SelectCell（Acol ARow）

　　end;

　　还要在TDBcalendar的声明中声明SelectCell

　　如果现在将Calendar加入窗体 会发现部件完全忽略鼠标和击键事件 而且当改变日期时 也不能改变选择的位置 下面将使控制响应更新

　　 允许所需的更新

　　只读日历使用SelectCell方法实现各种改变 包括设置Row和Col的值 当日期改变时 UpdateCalendar方法设置Row和Col的值 但因为SelectCell不允许你改变 即使日期改变了 选择仍留在原处

　　可以给日历增加一个Boolean标志 当标志为True时允许改变

　　type

　　TDBCalendar=class（TCalendar）

　　private

　　Fupdating: Boolean;

　　protected

　　function SelectCell（Acol Arow: Longint） Boolean; override;

　　public

　　procedure UpdateCalendar; override;

　　end;

　　function TDBCalendar SelectCell（ACol ARow: Longint） Boolean;

　　begin

　　if （not FUpdating） and FReadOnly then

　　Result := False 如果更新则允许选择

　　else

　　Result := inherited SelectCell（ACol ARow） 否则调用继承的方法

　　end;

　　procedure UpdateCalendar;

　　begin

　　FUpdating := True; 将标志设为允许更新

　　try

　　inherited UpdateCalendar; 象通常一样更新

　　finally

　　FUpdating := False; 总是清除标志

　　end;

　　end;

　　现在日历仍旧不允许用户修改 但当改变日期属性时能正确反映改变 目前已有了一个真正只读控制 下一步是增加数据浏览能力

　　 增加数据联接

　　控制和数据库的联接是由一个名为DataLink的对象处理 Delphi提供了几种类型的Datalink 将控制与数据库单个域相联的DataLink对象是TFieldDatalink Delphi也提供了与整个表相联的DataLink

　　一个数据相关控制拥有DataLink对象 就是说 控制负责创建和析构DataLink

　　要建立作为拥有对象的Datalink 要执行下列三步

　　● 声明对象域

　　● 声明访问属性

　　● 初始化DataLink

　　⑴ 声明对象域

　　每个部件要为其拥有对象声明一个对象域 因此 日历对象DataLink 声明TFieldDataLink类型的域

　　日历部件中DataLink的声明如下

　　type

　　TDBCalendar = class（TSampleCalendar）

　　private

　　FDataLink: TFieldDataLink;

　　…

　　end;

　　⑵ 声明访问属性

　　每一个数据相关控制有一个DataSource属性 该属性描述应用程序给控制提供数据的数据源 而且 访问单个域的数据库还需要一个DataField 属性描述数据源中的域

lishixinzhi/Article/program/Delphi/201311/25115

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

【中文标题】在自定义 Delphi 组件中实现 Columns.Columns 属性

【英文标题】：Implement Columns.Columns property in custom Delphi component

【发布时间】：2012-07-17 03:25:24

【问题描述】：

我正在将几个 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 属性，并且我已将 Columns 属性添加到使用继承的 Items 的集合中，但当我尝试在设计器中打开表单时出现此错误：

创建表单时出错：读取 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's？谢谢。

【问题讨论】：

我怀疑您将需要使用 WriteListBegin/WriteListEnd 和 ReadListBegin/ReadListEnd。看看如何在 TCustomGrid 中处理 RowHeights 和 ColWidths 属性。查看 TCustomGrid.DefineProperties。

【参考方案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

【讨论】：

这对于能够从旧的 Delphi 2005 表单中读取列属性信息非常有效。然而，虽然我最初使用 TCollection 和 TCollectionItem，它自动包含组件的集合属性编辑器，但新的实现不允许我通过设计器更改单个列对象的属性。当我在对象检查器中查看网格时，Columns 属性不再具有 ... 按钮。我需要编写自己的属性编辑器吗？