oledlgs.pas

是一个delphi的流程制作软件

//----------------------------- Ole UI Dialogs ---------------------------------
//
// This unit provides Delphi dialog components for all of the OLE UI dialogs.
// See OleRegisterXX series of units for component editors.
//
// Grahame Marsh
// Freeware for UNDU - you get it for free I make no promises
// [e-mail]
//------------------------------------------------------------------------------

unit OleDlgs;

{$INCLUDE OLE.INC}

interface

uses
  Windows, SysUtils, Classes, Forms, Messages, ActiveX, Dialogs,
  Graphics, OleDlg, CommCtrl, CommDlg,
  OleConsts, OleHelpers, OleErrors, OleStd;

//=== Ole UI Base Dialog =======================================================
// Most Ole UI dialogs have a common initial structure.  This
// part of the dialog component satisfies the common features.
// All descendants must override the abstract Execute function.

type
  TOnDialogCreateEvent = procedure (Sender : TObject; Wnd : hWnd) of object;
  TOleBaseDialog = class (TComponent)
  private
    FOnCreate : TOnDialogCreateEvent;
    FResource,
    FCaption : string;
    FReturned,
    FData    : integer;
    FHook    : TFNOleUIHook;
    FExplorerDlg,
    FAutoCentre : boolean;
  protected
    procedure InitExecute (var Dialog; Size : integer); virtual;
    property ExplorerDlg : boolean read FExplorerDlg write FExplorerDlg;
  public
    constructor Create (AOwner : TComponent); override;
    function Execute : boolean; virtual; abstract;
    property Data : integer read FData write FData;
    property Hook : TFNOleUIHook read FHook write FHook;
    property Returned : integer read FReturned;
  published
    property AutoCentre : boolean read FAutoCentre write FAutoCentre default true;
    property Resource : string read FResource write FResource;
    property Caption : string read FCaption write FCaption;
    property OnCreate : TOnDialogCreateEvent read FOnCreate write FOnCreate;
  end;

// Some Ole Dialogs contain format and medium information, this is a convienent
// place holder for such data
  TCustomFormat = class (TPersistent)
  private
    FFormat : TClipFormat;
    FName : TClipName;
    FAspect : TClipAspect;
    FMedium : TClipMediums;
    procedure SetName (const Value : TClipName); virtual;
    procedure SetFormat (const Value : TClipFormat); virtual;
    procedure SetMedium (const Value : TClipMediums); virtual;
    procedure SetAspect  (const Value : TClipAspect); virtual;
  protected
  public
    procedure Assign (Source: TPersistent); override;
    property Aspect : TClipAspect read FAspect write SetAspect default caContent;
    property Format : TClipFormat read FFormat write SetFormat stored false;
    property Medium : TClipMediums read FMedium write SetMedium default [cmGlobal];
    property Name : TClipName read FName write SetName;
  end;


//=== Ole UI Busy Dialog =======================================================

  TOleBusyOption  = (oboDisableCancel, oboDisableRetry, oboNotResponding);
  TOleBusyOptions = set of TOleBusyOption;
  TOleBusyDialog = class (TOleBaseDialog)
  private
    FInitial,
    FRetry,
    FRepeat  : integer;
    FTask    : hTask;
    FOptions : TOleBusyOptions;
  protected
  public
    constructor Create (AOwner : TComponent); override;
    function Execute : boolean; override;
    function RetryRejectedCall (Task: HTASK; TickCount: integer) : integer;
    property Task : hTask read FTask write FTask;
  published
    property InitialDelay : integer read FInitial write FInitial default 5000;
    property Options : TOleBusyOptions read FOptions write FOptions default [];
    property RepeatDelay : integer read FRepeat write FRepeat default 1000;
    property RetryDelay : integer read FRetry write FRetry default 250;
  end;

// Extended version allows the icon, main text and button text to be changed
  TOleBusyDialogEx = class (TOleBusyDialog)
  private
    FText,
    FCancel,
    FRetryText : string;
    FIcon : TIcon;
    procedure SetIcon (Value : TIcon);
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property Cancel : string read FCancel write FCancel;
    property Retry : string read FRetryText write FRetryText;
    property Text : string read FText write FText;
    property Icon : TIcon read FIcon write SetIcon;
  end;

//=== Ole UI Paste Special Dialog ==============================================

type
  TOlePasteFormatOption = (pfLinkType1, pfLinkType2, pfLinkType3, pfLinkType4,
    pfLinkType5, pfLinkType6, pfLinkType7, pfLinkType8, pfPaste, pfLinkAnyType,
    pfEnableIcon);
  TOlePasteFormatOptions = set of TOlePasteFormatOption;

// An allowable paste entry into a paste special dialog
  TPasteEntryItem = class (TCollectionItem)
  private
    FFormat : TClipFormat;
    FName : TClipName;
    FAspect : TClipAspect;
    FMedium : TClipMediums;
    FResult,
    FText : string;
    FOptions : TOlePasteFormatOptions;
    procedure SetName (const Value : TClipName);
    procedure SetFormat (const Value : TClipFormat);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create (Collection: TCollection); override;
    procedure Assign (Source: TPersistent); override;
  published
    property Aspect : TClipAspect read FAspect write FAspect default caContent;
    property Format : TClipFormat read FFormat write SetFormat stored false;
    property Medium : TClipMediums read FMedium write FMedium default [cmGlobal];
    property Name : TClipName read FName write SetName;
    property Options : TOlePasteFormatOptions read FOptions write FOptions default [];
    property Result : string read FResult write FResult;
    property Text : string read FText write FText;
  end;

// Collection of allowable paste entries
  TPasteEntryList = class (TCollection)
  private
    FOwner: TComponent;
    function GetItem (Index: Integer): TPasteEntryItem;
    procedure SetItem (Index: Integer; Value: TPasteEntryItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create (AOwner: TComponent);
    function Add: TPasteEntryItem;
    property Owner: TComponent read FOwner;
    property Items [Index: Integer]: TPasteEntryItem read GetItem write SetItem; default;
  end;

// Standard Paste Special Dialog
  TOlePasteSpecialDialog = class (TOleBaseDialog)
  private
    FDataObject : IDataObject;
    FFormats : TPasteEntryList;
    FLinkTypes,
    FExclude : TStrings;
    FShowHelp,
    FSelectPaste,
    FSelectPasteLink,
    FCheckDisplayAsIcon,
    FDisableDisplayAsIcon,
    FHideChangeIcon,
    FStayOnClipboardChange,
    FNoRefreshDataObject,
    FLink : boolean;
    FSelIndex : integer;
    FMetafile : TUIMetafile;
    FSize : TPoint;
    function GetSelected : TPasteEntryItem;
    procedure SetExclude (Value : TStrings);
    procedure SetLinkTypes (Value : TStrings);
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
    function Execute : boolean; override;
// IN/OUT
    property DataObject : IDataObject read FDataObject write FDataObject;
// OUT
    property CheckDisplayAsIcon : boolean read FCheckDisplayAsIcon;
    property Link : boolean read FLink;
    property SelIndex : integer read FSelIndex;
    property Selected : TPasteEntryItem read GetSelected;
    property Metafile : TUIMetafile read FMetafile;
    property Size : TPoint read FSize;
  published
// IN
    property Exclude : TStrings read FExclude write SetExclude;
    property LinkTypes : TStrings read FLinkTypes write SetLinkTypes;
    property Formats : TPasteEntryList read FFormats write FFormats;
    property ShowHelp : boolean read FShowHelp write FShowHelp default false;
    property DisableDisplayAsIcon : boolean read FDisableDisplayAsIcon write FDisableDisplayAsIcon default false;
    property HideChangeIcon : boolean read FHideChangeIcon write FHideChangeIcon default false;
    property StayOnClipboardChange : boolean read FStayOnClipboardChange write FStayOnClipboardChange default false;
    property NoRefreshDataObject : boolean read FNoRefreshDataObject write FNoRefreshDataObject default false;
// IN/OUT
    property SelectPaste : boolean read FSelectPaste write FSelectPaste default false;
    property SelectPasteLink : boolean read FSelectPasteLink write FSelectPasteLink default false;
  end;

// Paste Special dialog with the "Source:" and "Result" text accessible
  TOlePasteSpecialDialogEx = class (TOlePasteSpecialDialog)
  private
    FSource,
    FResult : string;
  public
    constructor Create (AOwner : TComponent); override;
  published
    property Result : string read FResult write FResult;
    property Source : string read FSource write FSource;
  end;

//=== Ole UI Change Icon Dialog ================================================
// Used to display the standard ole ui change icon dialog box

  TChangeIconSelect = (ciCurrent, ciDefault, ciFromFile);
  TOleChangeIconDialog = class (TOleBaseDialog)
  private
    FMetafile : TUIMetafile;
    FFilename : string;
    FUseExe,
    FShowHelp :  boolean;
    FSelect : TChangeIconSelect;
    FCLSID : TCLSIDStr;
    procedure SetMetafile (Value : TUIMetafile);
    function StoreMetafile : boolean;
    function GetAsCLSID : TCLSID;
    procedure SetAsCLSID (Value : TCLSID);
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
    function Execute : boolean; override;
    property AsCLSID : TCLSID read GetAsCLSID write SetAsCLSID;
  published
// in only
    property CLSID : TCLSIDStr read FCLSID write FCLSID;
    property Filename : string read FFilename write FFilename;
    property ShowHelp : boolean read FShowHelp write FShowHelp default false;
    property UseExe : boolean read FUseExe write FUseExe default false;
// in/out
    property Metafile : TUIMetafile read FMetafile write SetMetafile stored StoreMetafile;
    property Select : TChangeIconSelect read FSelect write FSelect default ciCurrent;
  end;

//=== Ole UI Insert Object Dialog ==============================================

  TOleRender = (orNone, orDraw, orFormat, orAsIs);
  TInsertObjectFormat = class (TCustomFormat)
  published
    property Aspect;
    property Format;
    property Medium;
    property Name;
  end;

  TOleInsertObjectDialog = class (TOleBaseDialog)
  private
    FMetafile : TUIMetafile;
    FFilename : string;
    FCLSID : TCLSID;
    FExclude : TStrings;
    FIID : string;
    FSelectCreateNew,
    FSelectCreateFromFile,
    FCheckLink,
    FCheckDisplayAsIcon,
    FCreateNewObject,
    FCreateFileObject,
    FCreateLinkObject,
    FDisableLink,
    FVerifyServersExist,
    FDisableDisplayAsIcon,
    FHideChangeIcon,
    FShowInsertControl,
    FSelectCreateControl,
    FShowHelp :  boolean;
    FRender : TOleRender;
    FSCode : integer;
    FFormatEtc : TInsertObjectFormat;

    FStorage : IStorage;
    FRetObject : pointer;
    FClientSite : IOleClientSite;
    procedure SetExclude (Value : TStrings);
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
    function Execute : boolean; override;
// in only and can't be published
    property Storage : IStorage read FStorage write FStorage;
    property RetObject : pointer read FRetObject write FRetObject;
    property ClientSite : IOleClientSite read FClientSite write FClientSite;
// out only
    property Filename : string read FFilename;
    property CLSID : TCLSID read FCLSID;
    property Metafile : TUIMetafile read FMetafile;
    property SCode : integer read FSCode;
  published
// in only
    property ShowHelp : boolean read FShowHelp write FShowHelp default false;
    property HideChangeIcon : boolean read FHideChangeIcon write FHideChangeIcon default false;
    property ShowInsertControl : boolean read FShowInsertControl write FShowInsertControl default false;
    property DisableLink : boolean read FDisableLink write FDisableLink default false;
    property CreateNewObject : boolean read FCreateNewObject write FCreateNewObject default true;
    property CreateFileObject : boolean read FCreateFileObject write FCreateFileObject default true;
    property CreateLinkObject : boolean read FCreateLinkObject write FCreateLinkObject default true;
    property VerifyServersExist : boolean read FVerifyServersExist write FVerifyServersExist default true;
    property DisableDisplayAsIcon : boolean read FDisableDisplayAsIcon write FDisableDisplayAsIcon default false;
    property SelectCreateControl : boolean read FSelectCreateControl write FSelectCreateControl default false;
    property Render : TOleRender read FRender write FRender default orDraw;
    property Exclude : TStrings read FExclude write SetExclude;
    property IID : string read FIID write FIID;
    property FormatEtc : TInsertObjectFormat read FFormatEtc write FFormatEtc;
// in/out
    property CheckLink : boolean read FCheckLink write FCheckLink default false;
    property CheckDisplayAsIcon : boolean read FCheckDisplayAsIcon write FCheckDisplayAsIcon default false;
    property SelectCreateNew : boolean read FSelectCreateNew write FSelectCreateNew default true;
    property SelectCreateFromFile : boolean read FSelectCreateFromFile write FSelectCreateFromFile default false;
  end;

//=== Ole UI Object Properties Dialog ================================================
// Used to display the standard ole ui object properties dialog box

// Helper class for View Properties Page
  TOleViewProps = class (TPersistent)
  private
    FSelectRelative,
    FDisableRelative,
    FDisableScale : boolean;
    FScaleMin,
    FScaleMax : integer;
    procedure SetFlags (Value : integer);
    function GetFlags : integer;
  protected
  public
    constructor Create;
    property Flags : integer read GetFlags write SetFlags;
  published
    property SelectRelative : boolean read FSelectRelative write FSelectRelative default false;
    property DisableRelative : boolean read FDisableRelative write FDisableRelative default false;
    property DisableScale : boolean read FDisableScale write FDisableScale default false;
    property ScaleMin : integer read FScaleMin write FScaleMin default 0;
    property ScaleMax : integer read FScaleMax write FScaleMax default 0;
  end;

// Helper class for link properties page
  TOleLinkProps = class (TPersistent)
  private
    FShowHelp,
    FDisableChangeSource,
    FDisableOpenSource,
    FDisableUpdateNow,
    FDisableBreakLink : boolean;
    function GetFlags : integer;
  protected
  public
    property Flags : integer read GetFlags;
  published
    property ShowHelp : boolean read FShowHelp write FShowHelp default false;
    property DisableChangeSource : boolean read FDisableChangeSource write FDisableChangeSource default false;
    property DisableOpenSource : boolean read FDisableOpenSource write FDisableOpenSource default false;
    property DisableUpdateNow : boolean read FDisableUpdateNow write FDisableUpdateNow default false;
    property DisableBreakLink : boolean read FDisableBreakLink write FDisableBreakLink default false;
  end;

  TOleObjectPropsDialog = class (TOleBaseDialog)
  private
    FObjectIsLink,
    FNoFillDefault,
    FDisableConvert,
    FShowHelp :  boolean;
    FViewProps : TOleViewProps;
    FLinkProps : TOleLinkProps;
    FObjectId,
    FLinkId : integer;
    FObjectInfo : IOleUIObjInfo;
    FLinkInfo : IOleUILinkInfo;
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
    function Execute : boolean; override;
    property LinkInfo : IOleUiLinkInfo read FLinkInfo write FLinkInfo;
    property LinkId : integer read FLinkId write FLinkId;
    property ObjectInfo : IOleUiObjInfo read FObjectInfo write FObjectInfo;
    property ObjectId : integer read FObjectId write FObjectId;

  published
// in only
    property ObjectIsLink : boolean read FObjectIsLink write FObjectIsLink default false;
    property NoFillDefault : boolean read FNoFillDefault write FNoFillDefault default false;
    property DisableConvert : boolean read FDisableConvert write FDisableConvert default false;
    property ShowHelp : boolean read FShowHelp write FShowHelp default false;
    property ViewProps : TOleViewProps read FViewProps write FViewProps;
    property LinkProps : TOleLinkProps read FLinkProps write FLinkProps;
  end;

//=== Ole UI Edit Links Dialog =================================================

  TOleEditLinksDialog = class (TOleBaseDialog)
  private
    FDisableUpdateNow,
    FDisableOpenSource,
    FDisableChangeSource,
    FDisableBreakLink,
    FShowHelp :  boolean;
    FEditLink : IOleUILinkContainer;
  public
    function Execute : boolean; override;
    property EditLink : IOleUiLinkContainer read FEditLink write FEditLink;
  published
// in only
    property DisableUpdateNow : boolean read FDisableUpdateNow write FDisableUpdateNow default false;
    property DisableOpenSource : boolean read FDisableOpenSource write FDisableOpenSource default false;
    property DisableChangeSource : boolean read FDisableChangeSource write FDisableChangeSource default false;
    property DisableBreakLink : boolean read FDisableBreakLink write FDisableBreakLink default false;
    property ShowHelp : boolean read FShowHelp write FShowHelp default false;
  end;

//=== Ole UI Convert Dialog ====================================================

  TDefaultCLSID = class (TPersistent)
  private
    FCLSID : TCLSIDStr;
    FActive : boolean;
    function GetCLSID : TCLSID;
    procedure SetCLSID (Value : TCLSID);
  public
    property AsCLSID : TCLSID read GetCLSID write SetCLSID;
  published
    property Active : boolean read FActive write FActive default false;
    property CLSID : TCLSIDStr read FCLSID write FCLSID;