Delphi組件與屬性編輯器

2019-11-18 18:34:42

字體：大中小

來源：轉載

供稿：網友

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;