Delphi组件与属性编辑器
(一)前言
本文将用一个例子描述组件开发与属性编辑器。
例子(TdsWaitDialogEx)是一个可视组件，调用其show方法后显示一个Dialog,
其中包含一个TAnimate,两个提示信息(即TLabel),一个进度条(TGauge)。
枚举属性：DialogStyle，AViposition
记录属性：Options
属性集合对象从TPersistent继承，本文例中AVISource属性集合包含TAnimate
的动画属性CommonAVI、FileName
属性编辑器应用与AVISource的FileName属性,即String型FileName编辑时弹出一个
TOpenDialog,其过滤Filter为*.avi
(二)组件包dsDlgPack.dpk
为了便于发布、安装等，要用到要组件包.dpk。
在Delphi6以后的版本中(我不知D5以前的版本怎样)，有若干文件Delphi没有发布,如PRoxies。
安装组件时若用到这些文件，可绕过这些文件而用包含这些文件的包。
本例属性编辑器用到DesignEditors文件，而DesignEditors中需要Proxies文件，因此在发布此组件
的包(.dpk)中包含designide，解决了Proxies不存在的问题，这样装组件就会成功
package dsDlgPack;
...
requires
rtl,
vcl,
VclSmp,
designide;
contains
dsDlgWaitEx in 'dsDlgWaitEx.pas' {DlgWaitEx},
dsDlgWaitExReg in 'dsDlgWaitExReg.pas';
end.
(三)组件注册文件dsDlgWaitExReg.pas
问：为什么要多用这样一个文件? 因为：
如果dsDlgWaitExReg.pas中的代码合并到dsDlgWaitEx.pas中，虽然dsDlgPack.dpk中包含designide
解决了安装组件时Proxies不存在的问题，但是在应用程序调用此组件时仍出Proxies不存在的问题，
因为DesignEditors中需要用到Proxies文件；因此象下面这段代码单独形成文件，应用程序调用此组
件是不需用到dsDlgWaitExReg.pas，可绕过Proxies不存在问题。
unit dsDlgWaitExReg;
interface
uses Classes, Dialogs, Forms, dsDlgWaitEx, DesignIntf, DesignEditors ;
type
TdsAVIFileNameProperty = class(TStringProperty) //属性编辑器要用到DesignEditors文件
public
function GetAttributes:TPropertyAttributes;override; //方法覆盖
procedure Edit;override; //方法覆盖
end;
procedure Register;
implementation
procedure Register;
begin
//注册此组件到 Delisoft 组件页面
RegisterComponents('Delisoft', [TdsWaitDialogEx]);
//注册此属性编辑器
RegisterPropertyEditor(TypeInfo(string), TdsAVISource, 'FileName', TdsAVIFileNameProperty);
end;
{ TdsAVIFileNameProperty }
function TdsAVIFileNameProperty.GetAttributes:TPropertyAttributes;
begin
result:=[paDialog];
end;
procedure TdsAVIFileNameProperty.Edit;
begin
with TOpenDialog.Create(application) do
try
Filter:='AVI Files(*.avi)|*.avi|All Files(*.*)|*.*';
if Execute then SetStrValue(FileName);
finally
free;
end;
end;
end.
(四)组件文件dsDlgWaitEx.pas
unit dsDlgWaitEx;
{定义本组件所有属性、方法;其中窗体TDlgWaitEx的属性BorderStyle为bsDialog，本例组件TdsDlgWaitEx用到窗体TDlgWaitEx；属性对象AVISource用到TdsAVISource，它是直接从TPersistent继承下来，另外用到枚举属性(DialogStyle、AVIPosition)和记录属性(Options)等。
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Gauges, ComCtrls;
type
TDialogStyle = (dlgNormal, dlgStayOnTop);
TAVIPosition = (aviLeft, aviTop, aviBottom);
TDlgOptions = set of (showAVI,showCaption,showMessage1,showMessage2,showProgress,ShowProgressText);
TDlgWaitEx = class(TForm)
Animate1: TAnimate;
Gauge1: TGauge;
Label1: TLabel;
Label2: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FCloseAfter: DWord;
FUserFormClose: TCloseEvent;
public
property UserFormClose: TCloseEvent read FUserFormClose write FUserFormClose;
property CloseAfter: DWORD read FCloseAfter write FCloseAfter;
end;
TdsAVISource = class(TPersistent)
private
FCommonAVI: TCommonAVI;
FFileName: string;
procedure SetCommonAVI(const Value: TCommonAVI);
procedure SetFileName(const Value: string);
protected
public
published
property CommonAVI: TCommonAVI read FCommonAVI write SetCommonAVI default aviNone;
property FileName: string read FfileName write SetFileName ;
end;
TdsWaitDialogEx=class(TComponent)
private
//Form
FDlgForm:TDlgWaitEx;
FMessage1: string;
FMessage2: string;
FMessage1Font: TFont;
FMessage2Font: TFont;
FCaption: string;
FDislogStyle:TDialogStyle ;
FwordWrap:boolean;
FOptions:TDlgOptions;
FShowMessage1,FShowMessage2:boolean;
//AVI
FaviPosition: TAVIPosition ;
FAviActive:boolean;
FshowAVI:boolean;
FAVISource : TdsAVISource;
//progress
FProgressMax:integer;
FProgressMin:integer;
FProgressPos:integer;
FProgressStep:integer;
FShowProgress: Boolean;
FShowProgressText: Boolean;
//Event
FOnPosChange: TNotifyEvent;
FOnShow: TNotifyEvent;
FOnFormHide: TCloseEvent;
procedure SetProgressMax(const Value: integer);
procedure SetProgressMin(const Value: integer);
procedure SetProgressPos(const Value: integer);
procedure SetProgressStep(const Value: integer);
procedure DrawForm;
function setLableHeight(sCaption:string):integer;
procedure setOptions(const value:TDlgOptions);
procedure setMessage1(const value:string);
procedure setMessage2(const value:string);
procedure setCaption(const value:string);
procedure SetMessage1Font(const value:TFont);
procedure SetMessage2Font(const value:TFont);
function IsMessage1FontStored: Boolean;
function IsMessage2FontStored: Boolean;
procedure setAVIPosition(const Value: TAVIPosition);
procedure SetAVISource(const Value: TdsAVISource);
procedure SetOnFormHide(const Value: TCloseEvent);
protected
procedure DoPosChange; virtual;
procedure DoShow; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure FormShow;
procedure FormHide;
procedure FormUpdate;
procedure ProgressStepIt;
published
//Form
property Message1: string read FMessage1 write setMessage1 ;
property Message2: string read FMessage2 write setMessage2 ;
property Message1Font: TFont read FMessage1Font write SetMessage1Font stored IsMessage1FontStored;
property Message2Font: TFont read FMessage2Font write SetMessage2Font stored IsMessage2FontStored;
property Caption: string read FCaption write setCaption ;
property DislogStyle:TDialogStyle read FDislogStyle write FDislogStyle;
property wordWrap :boolean read FwordWrap write FwordWrap;
property Options:TDlgOptions read FOptions write setOptions;
//AVI
property AviActive: boolean read FAviActive write FAviActive ;
property AviPosition: TAVIPosition read FaviPosition write setAVIPosition ;
property AviSource: TdsAVISource read FAVISource write SetAVISource ;
//Progress
property ProgressMax: integer read FProgressMax write SetProgressMax ;
property ProgressMin: integer read FProgressMin write SetProgressMin ;
property ProgressPos: integer read FProgressPos write SetProgressPos ;
property ProgressStep:integer read FProgressStep write SetProgressStep;
//Event
property OnPosChange: TNotifyEvent read FOnPosChange write FOnPosChange;
property OnShow: TNotifyEvent read FOnShow write FOnShow;
property OnHide: TCloseEvent read FOnFormHide write SetOnFormHide;
end;
implementation
{$R *.DFM}
{ TdsAVISource }
procedure TdsAVISource.SetCommonAVI(const Value: TCommonAVI);
begin
if Value = FCommonAVI then exit;
FCommonAVI := Value;
FfileName:='';
end;
procedure TdsAVISource.SetFileName(const Value: string);
begin
if Value = FfileName then exit;
FfileName:=value;
FCommonAVI:=aviNone;
end;
{ TdsWaitDialogEx }
procedure TdsWaitDialogEx.DoShow;
begin
if Assigned(FOnShow) then FOnShow(Self);
end;
procedure TdsWaitDialogEx.DoPosChange;
begin
if Assigned(FOnPosChange) then FOnPosChange(Self);
end;
procedure TdsWaitDialogEx.SetAVISource(const Value: TdsAVISource);
begin
if FAVISource=value then exit;
FAVISource.Assign(Value);
if (FAVISource.FFileName='')and(FAVISource.FCommonAVI=aviNone) then FshowAVI:=false;
if assigned(FDlgForm) then
begin
FDlgForm.Animate1.Active:=false;
FDlgForm.Animate1.FileName := '';
FDlgForm.Animate1.CommonAVI := aviNone;
if FshowAVI then
begin
if FAVISource.FfileName='' then
FDlgForm.Animate1.CommonAVI := FAVISource.FCommonAVI
else
FDlgForm.Animate1.FileName := FAVISource.FfileName;
FDlgForm.Animate1.Active:=true;
end;
DrawForm; //Animate1- >AVI改变后，可能引起的Animate1大小改变 == > DrawForm
FDlgForm.Update;
end;
end;
function TdsWaitDialogEx.IsMessage1FontStored: Boolean;
begin
with FMessage1Font do
Result :=
(Name < > 'MS Sans Serif') or
(Style < > []) or
(Size < > 8) or
(Color < > clWindowText) or
(Charset < > DEFAULT_CHARSET) or
(Pitch < > fpDefault);
end;
function TdsWaitDialogEx.IsMessage2FontStored: Boolean;
begin
with FMessage2Font do
Result :=
(Name < > 'MS Sans Serif') or
(Style < > []) or
(Size < > 8) or
(Color < > clWindowText) or
(Charset < > DEFAULT_CHARSET) or
(Pitch < > fpDefault);
end;
procedure TdsWaitDialogEx.SetMessage1Font(const Value: TFont);
begin
FMessage1Font.Assign(Value);
if assigned(FDlgForm) then
begin
FDlgForm.Label1.Font.Assign(Value);
FDlgForm.Update;
end;
end;
procedure TdsWaitDialogEx.SetMessage2Font(const Value: TFont);
begin
FMessage2Font.Assign(Value);
if assigned(FDlgForm) then
begin
FDlgForm.Label2.Font.Assign(Value);
FDlgForm.Update ;
end;
end;
procedure TdsWaitDialogEx.setCaption(const value:string);
begin
if value=FCaption then exit ;
FCaption:=value;
if not (showCaption in FOptions) then
begin
FCaption:='';
exit;
end;
if assigned(FDlgForm) then
begin
FDlgForm.Caption := value;
FDlgForm.update;
end;
end;
procedure TdsWaitDialogEx.setMessage1(const value:string);
var i:integer;
begin
if value=FMessage1 then exit ;
FMessage1:=value;
if assigned(FDlgForm) then
begin
if not (showMessage1 in FOptions) then exit;
FDlgForm.Label1.Caption := value;
i:=setLableHeight(FMessage1)+13;
if i< >FDlgForm.Label1.Height then DrawForm;
FDlgForm.update;
end;
end;
procedure TdsWaitDialogEx.setMessage2(const value:string);
var i:integer;
begin
if value=FMessage2 then exit ;
FMessage2:=value;
if assigned(FDlgForm) then
begin
if not (showMessage2 in FOptions) then exit;
FDlgForm.Label2.Caption := value;
i:=setLableHeight(FMessage2)+13;
if i< >FDlgForm.Label2.Height then DrawForm;
FDlgForm.update;
end;
end;