⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 psreg.pas

📁 免费控件PicShow的最新版本
💻 PAS
字号:
{------------------------------------------------------------------------------}
{                                                                              }
{  PicShow v4.04                                                               }
{  by Kambiz R. Khojasteh                                                      }
{                                                                              }
{  kambiz@delphiarea.com                                                       }
{  http://www.delphiarea.com                                                   }
{                                                                              }
{  Special thanks to:                                                          }
{    :: <k3nx@hotmail.com> for help on D5 support.                             }
{    :: Douglass Titjan <support@delphipages.com> for help on D5 support.      }
{    :: Jerry McLain <jkmclain@srcaccess.net> for manual control idea.         }
{    :: M. R. Zamani <M_R_Zamani@yahoo.com> for adding 8 effects (110..117).   }
{    :: Elliott Shevin <ShevinE@aol.com> for adding 4 effects (123..126).      }
{    :: Ken Otto <ken.otto@enviros.com> for adding native JPG support to       }
{       TDBPicShow and fixing a memory leak bug.                               }
{    :: Gary Bond <gary.bond@tesco.net> for name of the transitions.           }
{    :: Viatcheslav V. Vassiliev <vvv@spacenet.ru> for optimizing the          }
{       thread's termination.                                                  }
{    :: Miguel Gastelumendi Dargent <mgd@satelier.com.br> for fixing the       }
{       possible off-screen problem on the first time transition.              }
{    :: Terry Bogard <voyage_technologies@yahoo.com> for fixing the bug in     }
{       choosing transition style by name.                                     }
{    :: Hertwig van Zwietering <hertwig@vanzwietering.com> for the exact       }
{       timing code.                                                           }
{    :: Nest King <kingnest@gmail.com> for Exif JPEG signature.                }
{                                                                              }
{------------------------------------------------------------------------------}

{$I DELPHIAREA.INC}
{$R-,Q-,O+}

unit PSReg;

interface

uses
  Windows, Classes, {$IFDEF DELPHI6_UP} DesignIntf, DesignEditors {$ELSE} DsgnIntf {$ENDIF};

type

  {$IFDEF DELPHI6_UP}
  TGetPropEditProc = procedure(const Prop: IProperty) of object;
  {$ENDIF}

{ TPicShowComponentEditor }

  TPicShowComponentEditor = class(TComponentEditor)
  protected
    procedure CallPropertyEditor(Proc: TGetPropEditProc);
    {$IFDEF DELPHI6_UP}
    procedure PictureEditor(const Prop: IProperty);
    procedure BackgroundEditor(const Prop: IProperty);
    {$ELSE}
    procedure PictureEditor(Prop: TPropertyEditor);
    procedure BackgroundEditor(Prop: TPropertyEditor);
    {$ENDIF}
  public
    function GetVerbCount: Integer; override;
    function GetVerb(Index: Integer): string; override;
    procedure ExecuteVerb(Index: Integer); override;
    procedure Edit; override;
  end;

{ TStyleNamePropertyEditor }

  TStyleNamePropertyEditor = class(TEnumProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

{ TAboutPropertyEditor }

  TAboutPropertyEditor = class(TStringProperty)
  public
    procedure Edit; override;
    function GetValue: string; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

procedure Register;

implementation

uses
  PicShow, PSEffect, TypInfo, Dialogs;

procedure ShowAboutBox(const ClassName: String);
const
  AboutStr = ' v4.04'                                      + #13#10
           + 'Copyright(C) 1999-2006 Kambiz R. Khojasteh'  + #13#10
           + 'All rights reserved.'                        + #13#10
           +                                                 #13#10
           + 'kambiz@delphiarea.com'                       + #13#10
           + 'http://www.delphiarea.com';
begin
  MessageDlg(ClassName + AboutStr, mtInformation, [mbOK], 0);
end;

{ TPicShowComponentEditor }

function TPicShowComponentEditor.GetVerbCount: Integer;
begin
  Result := 7;
end;

function TPicShowComponentEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'About ' + Component.ClassName + '...';
    1: Result := '-';
    2: Result := 'Picture Editor...';
    3: Result := 'Background Editor...';
    4: Result := '-';
    5: if TCustomPicShow(Component).Busy then
         Result := 'Stop Transition'
       else
         Result := 'Start Transition';
    6: if TCustomPicShow(Component).Busy then
         Result := 'Can''t Clear Screen'
       else
         Result := 'Clear Screen';
  else
    Result := '';
  end;
end;

procedure TPicShowComponentEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: ShowAboutBox(Component.ClassName);
    1: {Nothing to do};
    2: CallPropertyEditor(PictureEditor);
    3: CallPropertyEditor(BackgroundEditor);
    4: {Nothing to do};
    5: if TCustomPicShow(Component).Busy then
         TCustomPicShow(Component).Stop
       else
         TCustomPicShow(Component).Execute;
    6: if not TCustomPicShow(Component).Busy then
         TCustomPicShow(Component).Clear;
  else
    inherited ExecuteVerb(Index);
  end;
end;

procedure TPicShowComponentEditor.Edit;
begin
  ExecuteVerb(2);
end;

procedure TPicShowComponentEditor.CallPropertyEditor(Proc: TGetPropEditProc);
var
  {$IFDEF DELPHI6_UP}
  List: IDesignerSelections;
  {$ELSE}
  {$IFDEF DELPHI5_UP}
  List: TDesignerSelectionList;
  {$ELSE}
  List: TComponentList;
  {$ENDIF}
  {$ENDIF}
begin
  {$IFDEF DELPHI6_UP}
  List := TDesignerSelections.Create;
  {$ELSE}
  {$IFDEF DELPHI5_UP}
  List := TDesignerSelectionList.Create;
  {$ELSE}
  List := TComponentList.Create;
  {$ENDIF}
  {$ENDIF}
  try
    List.Add(Component);
    GetComponentProperties(List, [tkClass], Designer, Proc);
  finally
    {$IFNDEF DELPHI6_UP}
    List.Free;
    {$ENDIF}
  end;
end;

{$IFDEF DELPHI6_UP}
procedure TPicShowComponentEditor.PictureEditor(const Prop: IProperty);
{$ELSE}
procedure TPicShowComponentEditor.PictureEditor(Prop: TPropertyEditor);
{$ENDIF}
begin
  if Prop.GetName = 'Picture' then
    Prop.Edit;
end;

{$IFDEF DELPHI6_UP}
procedure TPicShowComponentEditor.BackgroundEditor(const Prop: IProperty);
{$ELSE}
procedure TPicShowComponentEditor.BackgroundEditor(Prop: TPropertyEditor);
{$ENDIF}
begin
  if Prop.GetName = 'BgPicture' then
    Prop.Edit;
end;

{ TStyleNamePropertyEditor }

function TStyleNamePropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList, paRevertable];
end;

procedure TStyleNamePropertyEditor.GetValues(Proc: TGetStrProc);
var
  Style: TShowStyle;
begin
  Proc(CustomEffectName);
  for Style := Low(PSEffects) to High(PSEffects) do
    Proc(PSEffects[Style].Name);
end;

function TStyleNamePropertyEditor.GetValue: string;
begin
  Result := GetStrValue;
end;

procedure TStyleNamePropertyEditor.SetValue(const Value: string);
begin
  SetStrValue(Value);
end;

{ TAboutPropertyEditor }

function TAboutPropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly, paMultiSelect];
end;

function TAboutPropertyEditor.GetValue: string;
begin
  Result := '(About)'
end;

procedure TAboutPropertyEditor.Edit;
begin
  ShowAboutBox(GetComponent(0).ClassName);
end;

procedure Register;
begin
  RegisterComponents('Delphi Area', [TPicShow, TDBPicShow]);
  RegisterComponentEditor(TPicShow, TPicShowComponentEditor);
  RegisterPropertyEditor(TypeInfo(String), TCustomPicShow, 'StyleName', TStyleNamePropertyEditor);
  RegisterPropertyEditor(TypeInfo(TAbout), TCustomPicShow, 'About', TAboutPropertyEditor);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -