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.