Delphi component and property editor
(1) Preface
This article will use an example to describe component development and property editor.
The example (TdsWaitDialogEx) is a visual component that displays a Dialog after calling its show method.
It contains a TAnimate, two prompt messages (ie TLabel), and a progress bar (TGauge).
Enumeration properties: DialogStyle, AViposition
Record properties: Options
The property collection object inherits from TPersistent. In this example, the AVISource property collection contains TAnimate
Animation properties CommonAVI, FileName
The property editor is applied with the FileName property of AVISource, that is, a String FileName pops up when editing.
TOpenDialog, its filtering Filter is *.avi
(2) Component package dsDlgPack.dpk
In order to facilitate publishing, installation, etc., the component package .dpk must be used.
In versions after Delphi6 (I don't know about versions before D5), there are several files that Delphi has not released, such as PRoxies.
If these files are used when installing a component, you can bypass these files and use the package that contains them.
In this example, the property editor uses the DesignEditors file, and the Proxies file is required in DesignEditors, so this component is published
The package (.dpk) contains designide, which solves the problem that Proxies does not exist, so that the component installation will be successful.
package dsDlgPack;
...
requires
rtl,
vcl,
VclSmp,
designide;
contains
dsDlgWaitEx in 'dsDlgWaitEx.pas' {DlgWaitEx},
dsDlgWaitExReg in 'dsDlgWaitExReg.pas';
end.
(3) Component registration file dsDlgWaitExReg.pas
Question: Why do we need to use such a file more often? Because:
If the code in dsDlgWaitExReg.pas is merged into dsDlgWaitEx.pas, although designide is included in dsDlgPack.dpk
Solved the problem of Proxies not existing when installing the component, but the problem of Proxies not existing still occurs when the application calls this component.
Because Proxies files are needed in DesignEditors; therefore, the following code is formed into a separate file, and the application calls this group
The file does not need to use dsDlgWaitExReg.pas and can bypass Proxies without any problem.
unit dsDlgWaitExReg;
interface
uses Classes, Dialogs, Forms, dsDlgWaitEx, DesignIntf, DesignEditors;
type
TdsAVIFileNameProperty = class(TStringProperty) //The property editor uses the DesignEditors file
public
function GetAttributes:TPropertyAttributes;override; //Method override
procedure Edit;override; //method override
end;
procedure Register;
implementation
procedure Register;
begin
//Register this component to the Delisoft component page
RegisterComponents('Delisoft', [TdsWaitDialogEx]);
//Register this property editor
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.
(4) Component file dsDlgWaitEx.pas
unit dsDlgWaitEx;
{Define all properties and methods of this component; the property BorderStyle of the form TDlgWaitEx is bsDialog. In this example, the component TdsDlgWaitEx uses the form TDlgWaitEx; the property object AVISource uses TdsAVISource, which is directly inherited from TPersistent, and the enumeration properties are used (DialogStyle, AVIPosition) and record properties (Options), etc.
}
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->After the AVI changes, the size of Animate1 may change ==> 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;