CSDN博客

img LuckyJan

Delphi组件与属性编辑器

发表于2003/6/25 15:23:00  6818人阅读

分类: Delphi组件

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;

??? procedure TdsWaitDialogEx.setOptions(const value:TDlgOptions);
??? var doDrawForm:boolean;
??? begin
????? if FOptions=value then exit;
????? doDrawForm:=false;
????? if not((showAVI in value)and(showAVI in FOptions)) then doDrawForm:=true;
????? if not doDrawForm then
????? if not((showProgress in value)and(showProgress in FOptions)) then doDrawForm:=true;
????? if not doDrawForm then
????? if not((showMessage1 in value)and(showMessage1 in FOptions)) then doDrawForm:=true;
????? if not doDrawForm then
????? if not((showMessage2 in value)and(showMessage2 in FOptions)) then doDrawForm:=true;
????? FOptions:=value;

??????? if not (showCaption in FOptions) then FCaption:='';
??????? if showAVI in FOptions then FshowAVI:=true else FshowAVI:=false;
??????? if showMessage1 in FOptions then FShowMessage1:=true else FShowMessage1:=false;
??????? if showMessage2 in FOptions then FShowMessage2:=true else FShowMessage2:=false;
??????? if showProgress in FOptions then FShowProgress:=true else FShowProgress:=false;
??????? if ShowProgressText in FOptions then FShowProgressText:=true else FShowProgressText:=false;

????? if assigned(FDlgForm) then
????? begin
??????? if doDrawForm then? DrawForm;
??????? if showCaption in FOptions then FDlgForm.Caption:=FCaption else FDlgForm.Caption:='';
??????? if ShowProgressText in FOptions then FDlgForm.Gauge1.ShowText:=true else FDlgForm.Gauge1.ShowText:=false;
??????? FDlgForm.update;
????? end;
??? end;

??? procedure TdsWaitDialogEx.setAVIPosition(const Value: TAVIPosition);
??? begin
????? if FaviPosition=value then exit;
????? FaviPosition:=value;
????? if assigned(FDlgForm) then
????? begin
??????? DrawForm;
??????? FDlgForm.Update ;
????? end;
??? end;

??? procedure TdsWaitDialogEx.FormHide;
??? begin
????? if not assigned(FDlgForm) then exit;
????? FDlgForm.close;
????? FDlgForm.Position := poDesktopCenter;
??? end;

??? constructor TdsWaitDialogEx.Create(AOwner: TComponent);
??? begin
????? inherited create(AOwner);
????? //Form
??????? FCaption:= '正在处理中... ...';
??????? FMessage1 :='处理信息1' ;
??????? FMessage2 :='处理信息2' ;
??????? FDislogStyle:= dlgStayOnTop;
??????? FwordWrap:=true;
??????? FShowMessage1:=true;FShowMessage2:=true;
??????? FOptions:=[showAVI,showCaption,showMessage1,showMessage2,showProgress,ShowProgressText];
??????? FMessage1Font := TFont.Create;
??????? with FMessage1Font do
??????? begin
????????? FMessage1Font.Charset := GB2312_CHARSET ;
????????? Name := '宋体';
????????? Size := 9;
??????? end;
??????? FMessage2Font := TFont.Create;
??????? with FMessage2Font do
??????? begin
????????? FMessage2Font.Charset := GB2312_CHARSET ;
????????? Name := '宋体';
????????? Size := 9;
??????? end;
????? //Progress
??????? FShowProgress:=True;
??????? FShowProgressText:=True;
??????? FProgressMax:=100;
??????? FProgressMin:=0;
??????? FProgressPos:=0;
??????? FProgressStep:=10;
????? //AVI
??????? FAviActive:=True;
??????? FshowAVI:=true;
??????? FaviPosition:=aviTop;
??????? FAVISource := TdsAVISource.Create;
??????? FAVISource.FCommonAVI :=aviCopyFile ;
??????? FAVISource.FfileName:='';
??? end;

??? destructor TdsWaitDialogEx.Destroy;
??? begin
????? try
??????? FMessage1Font.Free;
??????? FMessage2Font.Free;
??????? FAVISource.Free;
??????? if assigned(FDlgForm) then
??????? begin
????????? FDlgForm.close;
????????? freeandnil(FDlgForm);
??????? end;
????? except
????? end;
????? inherited Destroy;
??? end;

??? procedure TdsWaitDialogEx.FormShow;
??? begin
????? FormUpdate;
????? if assigned(FDlgForm) then DoShow;
??? end;

??? function TdsWaitDialogEx.setLableHeight(sCaption:string):integer;
??? var i,iMax:integer;
??? begin
????? result:=0;
????? if FaviPosition = aviLeft then iMax:=48 else iMax:=56;
????? i:=length(sCaption)-iMax; //56;? // > 1 行??? 48
????? if i<=0 then exit;
????? if (i mod 56)>0 then
??????? result:=(i div 56 +1) * 13
????? else
??????? result:=(i div 56) * 13;
??? end;

??? procedure TdsWaitDialogEx.DrawForm;
??? var H,aH:integer;
??? begin
????? if not assigned(FDlgForm) then exit;
????? case FaviPosition of
????? aviTop:
??????? begin
????????? FDlgForm.Label1.Height:=13+setLableHeight(FDlgForm.Label1.Caption);
????????? FDlgForm.Label2.Height:=13+setLableHeight(FDlgForm.Label2.Caption);?????????????????????
????????? FDlgForm.Width := 356 ;?????? FDlgForm.Animate1.Top := 3;????
????????? FDlgForm.Gauge1.Left? :=14;?? FDlgForm.Gauge1.Width :=320;
????????? FDlgForm.Label1.Left? := 9;?? FDlgForm.Label1.Width :=340;
????????? FDlgForm.Label2.Left? := 9;?? FDlgForm.Label2.Width :=340;
????????? FDlgForm.Animate1.Left:=(FDlgForm.Width div 2)-(FDlgForm.Animate1.Width div 2); // Animate1 居中
????????? FDlgForm.Label1.Top?? := 3 + FDlgForm.Animate1.Height + 8 ;
????????? FDlgForm.Label2.Top?? := FDlgForm.Label1.Top + FDlgForm.Label1.Height + 4;
????????? FDlgForm.Gauge1.Top?? := FDlgForm.Label2.Top + FDlgForm.Label2.Height + 6;
????????? FDlgForm.Height:= 27 + 3 + FDlgForm.Animate1.Height
????????????????????????? + 8 + FDlgForm.Label1.Height
????????????????????????? + 4 + FDlgForm.Label2.Height
????????????????????????? + 6 + FDlgForm.Gauge1.Height + 6;
????????? if not FshowAVI then
????????? begin
??????????? FDlgForm.Label1.Top := FDlgForm.Label1.Top - FDlgForm.Animate1.Height ;
??????????? FDlgForm.Label2.Top := FDlgForm.Label2.Top - FDlgForm.Animate1.Height ;
??????????? FDlgForm.Gauge1.Top := FDlgForm.Gauge1.Top - FDlgForm.Animate1.Height;
??????????? FDlgForm.Height := FDlgForm.Height -? FDlgForm.Animate1.Height;
????????? end;
????????? if not FShowMessage1 then
????????? begin
??????????? FDlgForm.Label2.Top := FDlgForm.Label2.Top - FDlgForm.Label1.Height - 4;
??????????? FDlgForm.Gauge1.Top := FDlgForm.Gauge1.Top - FDlgForm.Label1.Height - 4;
??????????? FDlgForm.Height := FDlgForm.Height - FDlgForm.Label1.Height - 4;
????????? end;
????????? if not FShowMessage2 then
????????? begin
??????????? FDlgForm.Gauge1.Top := FDlgForm.Gauge1.Top - FDlgForm.Label2.Height - 4;
??????????? FDlgForm.Height := FDlgForm.Height - FDlgForm.Label2.Height - 4;
????????? end;
????????? if not FShowProgress then
????????? begin
??????????? FDlgForm.Height := FDlgForm.Height -? FDlgForm.Gauge1.Height-6;
????????? end;
??????? end;

????? aviLeft:
??????? begin
????????? FDlgForm.Label1.Height:=13+setLableHeight(FDlgForm.Label1.Caption);
????????? FDlgForm.Label2.Height:=13+setLableHeight(FDlgForm.Label2.Caption);
????????? FDlgForm.Label1.Width :=288; FDlgForm.Label2.Width :=288;
????????? FDlgForm.Label1.Left? := 12+FDlgForm.Animate1.Width;
????????? FDlgForm.Label2.Left? := FDlgForm.Label1.Left;
????????? FDlgForm.Label1.Top?? :=11;
????????? FDlgForm.Label2.Top?? :=11+FDlgForm.Label1.Height+4;
????????? FDlgForm.Gauge1.Left? :=16;
????????? FDlgForm.Animate1.Left :=6;
????????? FDlgForm.Animate1.Top :=11 ;
????????? FDlgForm.Width := FDlgForm.Animate1.Width+306;

????????? aH:=FDlgForm.Animate1.Height;
????????? if not FshowAVI then
????????? begin
??????????? FDlgForm.Gauge1.Width :=291;?? FDlgForm.Width :=329;
??????????? FDlgForm.Label1.Left? := 16;
??????????? FDlgForm.Label2.Left? := 16;
??????????? aH:=0;
????????? end;
????????? if not FShowProgress then
????????? begin
??????????? FDlgForm.Height := FDlgForm.Height-26;
????????? end;
????????? H:=FDlgForm.Label1.Height+4+FDlgForm.Label1.Height;
????????? if not FShowMessage1 then
????????? begin
??????????? H:=H-FDlgForm.Label1.Height;
??????????? FDlgForm.Label2.Top := 11 ;
????????? end;
????????? if not FShowMessage2 then
????????? begin
??????????? H:=H-FDlgForm.Label2.Height;
????????? end;

????????? if H????????? FDlgForm.Gauge1.Top?? :=11+H+12;
????????? FDlgForm.Gauge1.Width :=FDlgForm.Width-33;
????????? FDlgForm.Height:=FDlgForm.Gauge1.Top+53;
??????? end;

????? aviBottom:
??????? begin
????????? FDlgForm.Label1.Height:=13+setLableHeight(FDlgForm.Label1.Caption);
????????? FDlgForm.Label2.Height:=13+setLableHeight(FDlgForm.Label2.Caption);???
????????? FDlgForm.Width := 356 ;?? FDlgForm.Label1.Top?? := 8 ;
????????? FDlgForm.Label2.Top?? := FDlgForm.Label1.Top + FDlgForm.Label1.Height + 4;
????????? FDlgForm.Animate1.Top := FDlgForm.Label2.Top + FDlgForm.Label2.Height + 6;????????????????
????????? FDlgForm.Gauge1.Top?? := FDlgForm.Animate1.Top + FDlgForm.Animate1.Height + 6;
????????? FDlgForm.Gauge1.Left? :=14;?? FDlgForm.Gauge1.Width :=320;?
????????? FDlgForm.Label1.Left? := 9;?? FDlgForm.Label1.Width :=340;
????????? FDlgForm.Label2.Left? := 9;?? FDlgForm.Label2.Width :=340;
????????? FDlgForm.Animate1.Left:=(FDlgForm.Width div 2)-(FDlgForm.Animate1.Width div 2); // Animate1 居中
?????
????????? FDlgForm.Height:= 27 + + 8 + FDlgForm.Label1.Height
????????????????????????? + 4 + FDlgForm.Label2.Height
????????????????????????? + 6 + FDlgForm.Animate1.Height
????????????????????????? + 6 + FDlgForm.Gauge1.Height + 6;
?????????????????????
????????? if not FShowMessage1 then
????????? begin
??????????? FDlgForm.Label2.Top? := FDlgForm.Label2.Top - FDlgForm.Label1.Height-4;
??????????? FDlgForm.Animate1.Top:= FDlgForm.Animate1.Top - FDlgForm.Label1.Height-4;
??????????? FDlgForm.Gauge1.Top? := FDlgForm.Gauge1.Top - FDlgForm.Label1.Height-4;
??????????? FDlgForm.Height????? := FDlgForm.Height - FDlgForm.Label1.Height-4;
????????? end;
????????? if not FShowMessage2 then
????????? begin
??????????? FDlgForm.Animate1.Top:= FDlgForm.Animate1.Top - FDlgForm.Label2.Height-6;
??????????? FDlgForm.Gauge1.Top? := FDlgForm.Gauge1.Top - FDlgForm.Label2.Height-6;
??????????? FDlgForm.Height????? := FDlgForm.Height - FDlgForm.Label2.Height-6;
????????? end;
????????? if not FshowAVI then
????????? begin
??????????? FDlgForm.Gauge1.Top? := FDlgForm.Gauge1.Top - FDlgForm.Animate1.Height-6;
??????????? FDlgForm.Height????? := FDlgForm.Height - FDlgForm.Animate1.Height-6;
????????? end;
????????? if not FShowProgress then
????????? begin
??????????? FDlgForm.Height := FDlgForm.Height -? FDlgForm.Gauge1.Height-6;
????????? end;
??????? end;
????? end;
????? FDlgForm.Label1.Visible := FShowMessage1;
????? FDlgForm.Label2.Visible := FShowMessage2;
????? FDlgForm.Gauge1.Visible := FShowProgress;
????? FDlgForm.Animate1.Visible := FshowAVI;
??? end;

??? procedure TdsWaitDialogEx.FormUpdate;
??? begin
????? if FAVISource.FfileName<>'' then FAVISource.FCommonAVI:=aviNone;
????? if FAVISource.FCommonAVI<>aviNone then FAVISource.FfileName:='';
????? if (FAVISource.FfileName='')and(FAVISource.FCommonAVI=aviNone) then FOptions:=FOptions-[showAVI];
????? if not assigned(FDlgForm)? then
????? begin
??????? FDlgForm:=TDlgWaitEx.Create(self);
??????? FDlgForm.Position := poDesktopCenter;
????? end;
?
??????? if not (showCaption in FOptions) then FCaption:='';
??????? if showAVI in FOptions then FshowAVI:=true else FshowAVI:=false;
??????? if showMessage1 in FOptions then FShowMessage1:=true else FShowMessage1:=false;
??????? if showMessage2 in FOptions then FShowMessage2:=true else FShowMessage2:=false;
??????? if showProgress in FOptions then FShowProgress:=true else FShowProgress:=false;
??????? if ShowProgressText in FOptions then FShowProgressText:=true else FShowProgressText:=false;

??????? FDlgForm.Caption:=FCaption;
??????? FDlgForm.Label1.Caption:=FMessage1;
??????? FDlgForm.Label1.WordWrap := FwordWrap;
??????? FDlgForm.Label2.Caption:=FMessage2;
??????? FDlgForm.Label2.WordWrap := FwordWrap;
??????? if FDislogStyle=dlgStayOnTop then
????????? FDlgForm.FormStyle := fsStayOnTop
??????? else
????????? FDlgForm.FormStyle := fsNormal;
??????? FDlgForm.Label1.Font.Assign(FMessage1Font);
??????? FDlgForm.Label2.Font.Assign(FMessage2Font);

????? //AVI
??????? FDlgForm.Animate1.Active:=false;
??????? FDlgForm.Animate1.FileName :=? '';
??????? FDlgForm.Animate1.CommonAVI:= aviNone;
??????? FDlgForm.Animate1.Height := 60;
??????? if FshowAVI then
??????? begin
????????? if FAVISource.FfileName<>'' then
??????????? FDlgForm.Animate1.FileName := FAVISource.FfileName
????????? else
??????????? FDlgForm.Animate1.CommonAVI:= FAVISource.FCommonAVI;
????????? FDlgForm.Animate1.Active:=FAviActive;
??????? end;

????? //Progress
??????? FDlgForm.Gauge1.ShowText:=FShowProgressText;
??????? FDlgForm.Gauge1.MinValue:=FProgressMin;
??????? FDlgForm.Gauge1.MaxValue:=FProgressMax;
??????? FDlgForm.Gauge1.Progress:=FProgressPos;

????? //Refresh the form
??????? DrawForm;
??????? FDlgForm.show;
??????? FDlgForm.update;
??????? FDlgForm.UserFormClose := FOnFormHide;???
??? end;

??? procedure TdsWaitDialogEx.SetProgressMax(const Value: integer);
??? begin
????? if FProgressMax=value then exit;
????? FProgressMax := Value;
????? if not (showProgress in FOptions) then exit;
????? if assigned(FDlgForm) then
????? begin
??????? FDlgForm.Gauge1.MaxValue := FProgressMax;
??????? if FDlgForm.Gauge1.Progress < FProgressMax then
??????? begin
????????? FDlgForm.Gauge1.Progress := FProgressMax;
????????? FDlgForm.Update ;
??????? end;
????? end;
??? end;

??? procedure TdsWaitDialogEx.SetProgressMin(const Value: integer);
??? begin
????? if FProgressMin=value then exit;
????? FProgressMin := Value;
????? if not (showProgress in FOptions) then exit;
????? if assigned(FDlgForm) then
????? begin
??????? FDlgForm.Gauge1.MinValue := FProgressMin;
??????? if FDlgForm.Gauge1.Progress < FProgressMin then
??????? begin
????????? FDlgForm.Gauge1.Progress := FProgressMin;
????????? FDlgForm.Update ;
??????? end;
????? end;
??? end;

??? procedure TdsWaitDialogEx.SetProgressStep(const Value: integer);
??? begin
????? if FProgressStep=value then exit;
????? FProgressStep := Value;
??? end;

??? procedure TdsWaitDialogEx.SetProgressPos(const Value: integer);
??? begin
????? if FProgressPos=value then exit;
????? FProgressPos := Value;
????? if FProgressMin>FProgressPos then FProgressPos:=FProgressMin;
????? if FProgressMax????? if not (showProgress in FOptions) then exit;
????? if assigned(FDlgForm) then
????? begin
??????? FDlgForm.Gauge1.Progress:=FProgressPos;
??????? FDlgForm.Update ;
??????? DoPosChange;
????? end;
??? end;

??? procedure? TdsWaitDialogEx.ProgressStepIt;
??? begin
????? if FProgressPos + FProgressStep>FProgressMax then
??????? FProgressPos:=0
????? else
??????? FProgressPos := FProgressPos + FProgressStep;
????? if FProgressMin>FProgressPos then FProgressPos:=FProgressMin;
????? if FProgressMax????? if not (showProgress in FOptions) then exit;
????? if assigned(FDlgForm) then
????? begin
??????? FDlgForm.Gauge1.Progress:=FProgressPos;
??????? FDlgForm.Update ;
??????? DoPosChange;
????? end;
??? end;

??? procedure TdsWaitDialogEx.SetOnFormHide(const Value: TCloseEvent);
??? begin
????? FOnFormHide := Value;
????? if FDlgForm <> nil then
??????? FDlgForm.UserFormClose := Value;
??? end;

??? procedure TDlgWaitEx.FormClose(Sender: TObject; var Action: TCloseAction);
??? begin
????? while GetTickCount < FCloseAfter do
??????? Application.ProcessMessages;
????? if Assigned(FUserFormClose) and (Action=caHide) then
??????? FUserFormClose(Self, Action);
??? end;

??? end.

0 0

相关博文

我的热门文章

img
取 消
img