Delphi元件與屬性編輯器 (轉)
與屬性編輯器
(一)前言
本文將用一個例子描述元件開發與屬性編輯器。
例子(TdsWaitDialogEx)是一個可視元件，其show方法後顯示一個Dialog,
其中包含一個TAnimate,兩個提示資訊(即TLabel),一個進度條(TGauge)。
列舉屬性：DialogStyle，AVIPosition
記錄屬性：Options
屬性集合從TPersistent繼承，本文例中AVI屬性集合包含TAnimate
的動畫屬性CommonAVI、FileName
屬性編輯器應用與AVISource的FileName屬性,即String型FileName編輯時彈出一個
TOpenDialog,其過濾Filter為*.avi
(二)元件包dsDlgPack.dpk
為了便於釋出、等，要用到要元件包.dpk。
在Delphi6以後的版本中(我不知D5以前的版本怎樣)，有若干Delphi沒有釋出,如Proxies。
安裝元件時若用到這些檔案，可繞過這些檔案而用包含這些檔案的包。
本例屬性編輯器用到DesignEditors檔案，而DesignEditors中需要Proxies檔案，因此在釋出此元件
的包(.dpk)中包含design，解決了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為ialog，本例元件TdsDlgWaitEx用到窗體TDlgWaitEx；屬性物件AVISource用到TdsAVISource，它是直接從TPersistent繼承下來，另外用到列舉屬性(DialogStyle、AVIPosition)和記錄屬性(Options)等。
}
interface
uses
, 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: T; var Action: TCloseAction);
private
FCloseAfter: D;
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 SetProgressP;
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 doDrawFothen
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.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 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 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.
來自 “ ITPUB部落格 ” ，連結：http://blog.itpub.net/10752043/viewspace-956700/，如需轉載，請註明出處，否則將追究法律責任。
相關文章
- Delphi 6.0中屬性編輯器的解決方案 (轉)
- XAF 屬性編輯器（PropertyEditor）- 原理篇
- Delphi 類的靜態屬性 (轉)
- CAD屬性編輯操作——物件屬性教程物件
- WPF一個簡單的屬性編輯控制元件控制元件
- Delphi編碼標準——元件命名 (轉)元件
- delphi 常用控制元件屬性設定說明控制元件
- Vivado使用技巧（5）：屬性編輯器的使用
- Qt編寫自定義控制元件屬性設計器QT控制元件
- Emacs 編輯器(轉)Mac
- 在Spring2.5中定製自己的屬性編輯器Spring
- 織夢kindeditor編輯器圖片上傳增加圖片alt屬性和title屬性的方法
- 在Delphi中編寫控制元件的基本方法 (轉)控制元件
- 屬性動畫與差值器動畫
- 編輯器與IDEIDE
- DELPHI下調節器用EXCEL為其編輯和列印 (轉)Excel
- Delphi系列談之:Delphi中的靜態屬性及靜態方法的實現 (轉)
- React 元件屬性React元件
- 在Delphi中編寫控制元件的基本方法(1) (轉)控制元件
- 遊戲編輯器框架教程 (轉)遊戲框架
- 遊戲地圖編輯器 (轉)遊戲地圖
- 網頁編輯器 DIY (轉)網頁
- JavaScript物件的資料屬性與訪問器屬性JavaScript物件
- Delphi(BCB)中編譯器版本宏定義 (轉)編譯
- Delphi與Excel (轉)Excel
- react 元件的屬性React元件
- 在Delphi中使用Queued 元件 (轉)元件
- Python的tkinter獲取元件屬性和設定元件屬性Python元件
- 目錄與檔案屬性：編寫ls
- 王垠：編輯器與IDEIDE
- 第三方編輯器控制元件控制元件
- Delphi使用VB編寫的ActiveX控制元件全攻略 (轉)控制元件
- 深入理解物件的資料屬性與訪問器屬性物件
- 用Delphi編寫DelTree程式 (轉)
- 各網頁編輯器對照 (轉)網頁
- FastReport VCL報表控制元件教程：元件編輯器寫作AST控制元件
- Flutter 圖片裁剪旋轉翻轉編輯器Flutter
- Delphi編碼標準——窗體與資料模組命名 (轉)