Delphi组件与属性编辑器

类别:Delphi 点击:0 评论:0 推荐:

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<aH then H:=aH;
          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<FProgressPos then FProgressPos:=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<FProgressPos then FProgressPos:=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.

本文地址:http://com.8s8s.com/it/it5340.htm