(二)組件包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;
