测试Delphi控件属性保存到dfm

 控件单元代码:

unit TstControl;

interface

uses Classes, SysUtils, Controls;

type
  //定义控件的属性类型    类型中的published方法可以自动保存到dfm中
  TAuthorInfo = class(TPersistent)
  private
    FAuthorName: string;
    FSex: string;
    FCompany: string;
    FAge: Integer;
    procedure ReadAuthorInfo(Reader: TReader);
    procedure WriteAuthorInfo(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override; //从新此方法可以将非published属性保存到dfm中
  public
    function ToString: string;
    //定义在public中的属性如果要保存到dfm中必须重新DefineProperties,注册读写方法
    property Age: Integer read FAge write FAge;
  published
    //定义在published节中的属性可以自动保存到dfm中
    property AuthorName: string read FAuthorName write FAuthorName;
    property Sex: string read FSex write FSex;
    property Company: string read FCompany write FCompany;
  end;
  //枚举类型可以自动保存到dfm
  TWorkType = (wtManager, wtProgrammer);

  TTstControl = class(TWinControl)
  private
    FAuthorInfo: TAuthorInfo;
    FWorkType: TWorkType;
    FAge: Integer;
    FAuthorName: string;
  protected

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AuthorInfor: TAuthorInfo read FAuthorInfo write FAuthorInfo;
    property WorkType: TWorkType read FWorkType write FWorkType;
    property Age: Integer read FAge write FAge;
    property AuthorName: string read FAuthorName write FAuthorName;
  end;

implementation

{ TAuthorInfo }

procedure TAuthorInfo.DefineProperties(Filer: TFiler);
  function WriteAge: Boolean;
  var
    I: Integer;
    oInfo: TAuthorInfo;
  begin
    oInfo := TAuthorInfo(Filer.Ancestor);
    if (oInfo = nil) then
      Result := True
    else
      Result := oInfo.Age <> FAge;
  end;
begin
  inherited DefineProperties(Filer);
  //定义Age属性在dfm中的读写方法
  Filer.DefineProperty('Age', ReadAuthorInfo, WriteAuthorInfo, WriteAge);
end;

procedure TAuthorInfo.ReadAuthorInfo(Reader: TReader);
begin
  FAge := Reader.ReadInteger;
end;

function TAuthorInfo.ToString: string;
begin
  Result := Format('[%s], [%s], [%s]就职', [AuthorName, Sex, Company])
end;

procedure TAuthorInfo.WriteAuthorInfo(Writer: TWriter);
begin
  Writer.WriteInteger(FAge);
end;

{ TTstControl }

constructor TTstControl.Create(AOwner: TComponent);
begin
  inherited;
  FAuthorInfo := TAuthorInfo.Create;
end;

destructor TTstControl.Destroy;
begin
  FAuthorInfo.Free;
  inherited;
end;

end.

控件属性编辑器窗体单元:

unit AuthorInfoEditor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DesignEditors, DesignIntf;

type

  TAuthorInfoEditor = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetAttributes : TPropertyAttributes; override;
    function GetValue : String; override;
  end;

  TFrmAuthorInforEditor = class(TForm)
    Label1: TLabel;
    EdtName: TEdit;
    Label2: TLabel;
    CbSex: TComboBox;
    Label3: TLabel;
    EdtCompany: TEdit;
    Button1: TButton;
    Button2: TButton;
    Label4: TLabel;
    EdtAge: TEdit;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FAuthorName: string;
    FSex: string;
    FCompany: string;
    function GetAuthorName: string;
    function GetCompany: string;
    function GetSex: string;
    procedure SetAuthorName(const Value: string);
    procedure SetCompany(const Value: string);
    procedure SetSex(const Value: string);
    function GetAge: Integer;
    procedure SetAge(const Value: Integer);
  public
    property  AuthorName: string read GetAuthorName write SetAuthorName;
    property Sex: string read GetSex write SetSex;
    property Company: string read GetCompany write SetCompany;
    property Age: Integer read GetAge write SetAge;
  end;

var
  FrmAuthorInforEditor: TFrmAuthorInforEditor;

implementation

uses TstControl;

{$R *.dfm}

{ TAuthorInfoEditor }

procedure TAuthorInfoEditor.Edit;
var
  frm: TFrmAuthorInforEditor;
  oInfo: TAuthorInfo;
begin
  //inherited;
  frm := TFrmAuthorInforEditor.Create(Application);
  try
    oInfo := TAuthorInfo(TTstControl(GetComponent(0)).AuthorInfor);
    frm.AuthorName := oInfo.AuthorName;
    frm.Sex := oInfo.Sex;
    frm.Company := oInfo.Company;
    frm.Age := oInfo.Age;
    if frm.ShowModal = IDYES then
    begin
      oInfo.AuthorName := frm.AuthorName;
      oInfo.Sex := frm.Sex;
      oInfo.Company := frm.Company;
      oInfo.Age := frm.Age;
      Modified;
    end;
  finally
    frm.Free;
  end;
end;

function TAuthorInfoEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

function TAuthorInfoEditor.GetValue: String;
var
  oInfo: TAuthorInfo;
begin
  oInfo := TTstControl(GetComponent(0)).AuthorInfor;
  Assert(oInfo <> nil, '空指针错误。');
  Result := oInfo.ToString;
end;

procedure TFrmAuthorInforEditor.Button1Click(Sender: TObject);
begin
  ModalResult := mrNo;
end;

procedure TFrmAuthorInforEditor.Button2Click(Sender: TObject);
begin
  ModalResult := mrYes;
end;

function TFrmAuthorInforEditor.GetAge: Integer;
begin
  Result := StrToIntDef(EdtAge.Text, 0);
end;

function TFrmAuthorInforEditor.GetAuthorName: string;
begin
  Result := EdtName.Text;
end;

function TFrmAuthorInforEditor.GetCompany: string;
begin
  Result := EdtCompany.Text;
end;

function TFrmAuthorInforEditor.GetSex: string;
begin
  Result := CbSex.Text;
end;

procedure TFrmAuthorInforEditor.SetAge(const Value: Integer);
begin
  EdtAge.Text := IntToStr(Value);
end;

procedure TFrmAuthorInforEditor.SetAuthorName(const Value: string);
begin
  EdtName.Text := Value;
end;

procedure TFrmAuthorInforEditor.SetCompany(const Value: string);
begin
  EdtCompany.Text := Value;
end;

procedure TFrmAuthorInforEditor.SetSex(const Value: string);
begin
  CbSex.ItemIndex := CbSex.Items.IndexOf(Value);
end;

end.

dfm:

object FrmAuthorInforEditor: TFrmAuthorInforEditor
  Left = 0
  Top = 0
  Caption = #20316#32773#20449#24687#32534#36753#22120
  ClientHeight = 179
  ClientWidth = 300
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 64
    Top = 24
    Width = 36
    Height = 13
    Caption = #22995#21517#65306
  end
  object Label2: TLabel
    Left = 64
    Top = 48
    Width = 36
    Height = 13
    Caption = #24615#21035#65306
  end
  object Label3: TLabel
    Left = 64
    Top = 75
    Width = 36
    Height = 13
    Caption = #20844#21496#65306
  end
  object Label4: TLabel
    Left = 64
    Top = 104
    Width = 36
    Height = 13
    Caption = #24180#40836#65306
  end
  object EdtName: TEdit
    Left = 106
    Top = 21
    Width = 121
    Height = 21
    TabOrder = 0
  end
  object CbSex: TComboBox
    Left = 106
    Top = 48
    Width = 121
    Height = 21
    ItemHeight = 13
    ItemIndex = 0
    TabOrder = 1
    Text = #30007
    Items.Strings = (
      #30007
      #22899)
  end
  object EdtCompany: TEdit
    Left = 106
    Top = 75
    Width = 121
    Height = 21
    TabOrder = 2
  end
  object Button1: TButton
    Left = 176
    Top = 134
    Width = 75
    Height = 25
    Caption = 'Cancel'
    TabOrder = 3
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 95
    Top = 134
    Width = 75
    Height = 25
    Caption = 'ok'
    TabOrder = 4
    OnClick = Button2Click
  end
  object EdtAge: TEdit
    Left = 106
    Top = 102
    Width = 121
    Height = 21
    TabOrder = 5
    Text = '0'
  end
end

控件注册单元:

unit RegTstControl;

interface

uses Classes, SysUtils, TstControl;

procedure Register;

implementation

uses AuthorInfoEditor, DesignIntf;

procedure Register;
begin
  RegisterComponents('TestControl', [TTstControl]);
  RegisterPropertyEditor(TypeInfo(TAuthorInfo), TTstControl, 'AuthorInfor', TAuthorInfoEditor);
end;

end.

 

 

阅读更多
个人分类: Delphi
上一篇Delphi的组件读写机制
下一篇Delph组件如何使用自己的图标
想对作者说点什么? 我来说一句

没有更多推荐了,返回首页

关闭
关闭