Delphi组件与属性编辑器

(二)组件包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.

　  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;