olecontainer.pas

是一个delphi的流程制作软件

//---------------------------- OleContainer ------------------------------------
//
// Replacement unit for Borland's OleContainer unit
//
// Based on:
// Borland Delphi Visual Component Library
// Copyright (c) 1995,98 Inprise Corporation
//
// Grahame Marsh
// Freeware for UNDU - you get it for free I make no promises
// [e-mail]
//------------------------------------------------------------------------------


unit OleContainer;

{$I OLE.INC}

interface

uses
  Windows, Messages, CommCtrl, ActiveX, OleDlg, SysUtils, Classes, Controls,
  Forms, Menus, Graphics, ComObj, Dialogs, OleConst,

  OleConsts, OleInterface, OleForm, OleStd, OleDlgs, OleFormatEtc, OleLinks,
  OleErrors, OleHelpers, OleXForm, OleDataObject, OleDnD;

type
  TAutoActivate = (aaManual, aaGetFocus, aaDoubleClick);
  TSizeMode     = (smClip, smCenter, smScale, smStretch, smAutoSize);

  TOle2Container = class;
  TObjectMoveEvent = procedure (OleContainer: TOle2Container; const Bounds: TRect) of object;

  TOle2Container = class (TCustomControl, IUnknown, IOleClientSite, IOleInPlaceSite, IAdviseSink, IOleDocumentSite, IVCLContainer)
  private
    FRefCount: Longint;
    FLockBytes: ILockBytes;
    FStorage: IStorage;
    FOleObject: IOleObject;
    FDrawAspect: Longint;
    FOrgSize,
    FViewSize: TPoint;
    FObjectVerbs: TStringList;
    FDataConnection: Longint;
    FDocForm: IVCLFrameForm;
    FFrameForm: IVCLFrameForm;
    FOleInPlaceObject: IOleInPlaceObject;
    FOleInPlaceActiveObject: IOleInPlaceActiveObject;
    FAccelTable: HAccel;
    FAccelCount: Integer;
    FPopupVerbMenu: TPopupMenu;
    FAllowInPlace: Boolean;
    FAllowActiveDoc: Boolean;
    FAutoActivate: TAutoActivate;
    FAutoVerbMenu: Boolean;
    FBorderStyle: TBorderStyle;
    FCopyOnSave: Boolean;
    FSizeMode: TSizeMode;
    FObjectOpen: Boolean;
    FCurrentScale : integer;
    FScaleRelative : boolean;

    FOleChangeIconDialog : TOleChangeIconDialog;
    FOleInsertObjectDialog : TOleInsertObjectDialog;
    FOleObjectPropsDialog : TOleObjectPropsDialog;
    FOlePromptUserDialog : TOlePromptUserDialog;
    FOleEditLinksDialog : TOleEditLinksDialog;
    FOlePasteSpecialDialog : TOlePasteSpecialDialog;
    FOleUpdateLinksDialog : TOleUpdateLinksDialog;
    FOleConvertDialog : TOleConvertDialog;
    FOleChangeSourceDialog : TOleChangeSourceDialog;

    FUIActive: Boolean;
    FModified: Boolean;
    FModSinceSave: Boolean;
    FFocused: Boolean;
    FNewInserted: Boolean;
    FOnActivate: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnObjectMove: TObjectMoveEvent;
    FOnResize: TNotifyEvent;
    FDocView: IOleDocumentView;
    FDocObj: Boolean;
// IUnknown
    function QueryInterface(const IID: TGUID; out Obj): HResult; reintroduce; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
// IOleClientSite
    function SaveObject: HResult; stdcall;
    function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint; out mk: IMoniker): HResult; stdcall;
    function GetContainer(out container: IOleContainer): HResult; stdcall;
    function ShowObject: HResult; stdcall;
    function OnShowWindow(fShow: BOOL): HResult; stdcall;
    function RequestNewObjectLayout: HResult; stdcall;
// IOleInPlaceSite
    function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
    function GetWindow(out wnd: HWnd): HResult; stdcall;
    function CanInPlaceActivate: HResult; stdcall;
    function OnInPlaceActivate: HResult; stdcall;
    function OnUIActivate: HResult; stdcall;
    function GetWindowContext(out frame: IOleInPlaceFrame; out doc: IOleInPlaceUIWindow; out rcPosRect: TRect;
      out rcClipRect: TRect; out frameInfo: TOleInPlaceFrameInfo): HResult; stdcall;
    function Scroll(scrollExtent: TPoint): HResult; stdcall;
    function OnUIDeactivate(fUndoable: BOOL): HResult; stdcall;
    function OnInPlaceDeactivate: HResult; stdcall;
    function DiscardUndoState: HResult; stdcall;
    function DeactivateAndUndo: HResult; stdcall;
    function OnPosRectChange(const rcPosRect: TRect): HResult; stdcall;
// IAdviseSink
    procedure OnDataChange(const formatetc: TFormatEtc; const stgmed: TStgMedium); stdcall;
    procedure OnViewChange(dwAspect: Longint; lindex: Longint); stdcall;
    procedure OnRename(const mk: IMoniker); stdcall;
    procedure OnSave; stdcall;
    procedure OnClose; stdcall;
// IOleDocumentSite
    function ActivateMe(View: IOleDocumentView): HRESULT; stdcall;
// TOle2Container
    procedure AdjustBounds;
    procedure CheckObject;
    procedure ConvertInfo (Wanted : TConvertInfos; var CLSID : TCLSID; var Format : TClipFormat; var TypeStr, LabelStr : string; var Metafile : hGlobal);
    procedure CreateAccelTable;
    procedure CreateStorage;
    procedure DesignModified;
    procedure DestroyAccelTable;
    procedure DestroyVerbs;
    function GetBorderWidth: Integer;
    function GetCanConvert : boolean;
    function GetCanPaste: Boolean;
    function GetIconic: Boolean;
    function GetLinked: Boolean;
    function GetObjectDataSize: Integer;
    function GetObjectVerbs: TStrings;
    function GetOleClassName: string;
    function GetOleObject: Variant;
    function GetPrimaryVerb: Integer;
    function GetSourceDoc: string;
    function GetState: TObjectState;
    procedure InitObject;
    procedure ObjectMoved(const ObjectRect: TRect);
    procedure PopupVerbMenuClick(Sender: TObject);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetFocused(Value: Boolean);
    procedure SetIconic(Value: Boolean);
    procedure SetScale (Value : integer);
    procedure SetSizeMode(Value: TSizeMode);
    procedure SetUIActive(Active: Boolean);
    procedure SetViewAdviseSink(Enable: Boolean);
    procedure UpdateObjectRect;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMDocWindowActivate(var Message: TMessage); message CM_DOCWINDOWACTIVATE;
    procedure CMUIDeactivate(var Message: TMessage); message CM_UIDEACTIVATE;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
  protected
    procedure Changed; dynamic;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DblClick; override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure DoEnter; override;
    function GetPopupMenu: TPopupMenu; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign (Source : TPersistent); override;
    function ChangeIconDialog: Boolean;
    function ChangeSourceDialog : boolean;
    procedure ClearDrawAspect;
    procedure Close;
    function ConvertObjectDialog : boolean;
    procedure Copy;
    procedure CreateLinkToFile(const FileName: string; Iconic: Boolean);
    procedure CreateObject(const OleClassName: string; Iconic: Boolean);
    procedure CreateObjectFromFile(const FileName: string; Iconic: Boolean);
    procedure CreateObjectFromInfo(const CreateInfo: TCreateInfo);
    procedure DestroyObject;
    procedure DoVerb(Verb: Integer);
    function EditLinksDialog : boolean;
    function GetEmpty : boolean;
    function GetIconMetaPict: HGlobal;
    function InsertObjectDialog: Boolean;
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    function ObjectPropertiesDialog : boolean;
    procedure Paste;
    procedure PasteThis (DataObject : IDataObject; Link : boolean = false);
    function PasteSpecialDialog: Boolean;
    procedure Run;
    procedure SaveAsDocument(const FileName: string);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    procedure SetDrawAspect(Iconic: Boolean; IconMetaPict: HGlobal);
    procedure UpdateLink;
    procedure UpdateObject;
    procedure UpdateVerbs;
    procedure UpdateView;

    property CanConvertOrActivateAs : boolean read GetCanConvert;
    property CanPaste: Boolean read GetCanPaste;
    property Empty : boolean read GetEmpty;
    property Linked: Boolean read GetLinked;
    property Modified: Boolean read FModified write FModified;
    property NewInserted: Boolean read FNewInserted;
    property ObjectVerbs: TStrings read GetObjectVerbs;
    property OleClassName: string read GetOleClassName;
    property OleObject: Variant read GetOleObject;
    property OleObjectInterface: IOleObject read FOleObject;
    property PrimaryVerb: Integer read GetPrimaryVerb;
    property SourceDoc: string read GetSourceDoc;
    property State: TObjectState read GetState;
    property StorageInterface: IStorage read FStorage;
  published
    property AllowInPlace: Boolean read FAllowInPlace write FAllowInPlace default True;
    property AllowActiveDoc: Boolean read FAllowActiveDoc write FAllowActiveDoc default True;
    property AutoActivate: TAutoActivate read FAutoActivate write FAutoActivate default aaDoubleClick;
    property AutoVerbMenu: Boolean read FAutoVerbMenu write FAutoVerbMenu default True;
    property Align;
    property Anchors;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Caption;
    property Color;
    property Constraints;
    property CopyOnSave: Boolean read FCopyOnSave write FCopyOnSave default True;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Iconic: Boolean read GetIconic write SetIconic stored False;

    property OleChangeIconDialog : TOleChangeIconDialog read FOleChangeIconDialog write FOleChangeIconDialog;
    property OleInsertObjectDialog : TOleInsertObjectDialog read FOleInsertObjectDialog write FOleInsertObjectDialog;
    property OleObjectPropsDialog : TOleObjectPropsDialog read FOleObjectPropsDialog write FOleObjectPropsDialog;
    property OlePromptUserDialog : TOlePromptUserDialog read FOlePromptUserDialog write FOlePromptUserDialog;
    property OleEditLinksDialog : TOleEditLinksDialog read FOleEditLinksDialog write FOleEditLinksDialog;
    property OlePasteSpecialDialog : TOlePasteSpecialDialog read FOlePasteSpecialDialog write FOlePasteSpecialDialog;
    property OleUpdateLinksDialog : TOleUpdateLinksDialog read FOleUpdateLinksDialog write FOleUpdateLinksDialog;
    property OleConvertDialog : TOleConvertDialog read FOleConvertDialog write FOleConvertDialog;
    property OleChangeSourceDialog : TOleChangeSourceDialog read FOleChangeSourceDialog write FOleChangeSourceDialog;

    property ParentColor default False;
    property ParentCtl3D;
    property ParentShowHint;
    property PopupMenu;
    property Scale : integer read FCurrentScale write SetScale default 100;
    property ScaleRelative : boolean read FScaleRelative write FScaleRelative default true;
    property ShowHint;
    property SizeMode: TSizeMode read FSizeMode write SetSizeMode default smClip;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnObjectMove: TObjectMoveEvent read FOnObjectMove write FOnObjectMove;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
    property OnStartDrag;
  end;

// This implements a data source for the purposes of drag operations, it is
// derived from a TDelphiDataSource (in OleDataSource.pas) but only needs to
// override the GetDataObject method.  The other methods are left abstract.
  TOle2ContainerDataSource = class (TDelphiDataSource)
  private
    FContainer : TOle2Container;
  protected
    function GetDataObject : IDataObject; override;
  public
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
  published
    property Container : TOle2Container read FContainer write FContainer;
  end;

function CanPasteThis (DataObject : IDataObject) : boolean;

//==============================================================================

implementation

//--- Miscellaneous internal bits ----------------------------------------------

var
  FDataFormats : TFormatEtcList;

const
  StreamSignature = $32434442; {'BDC2'}

type
  TStreamHeader = record
    Signature,
    DrawAspect,
    DataSize   : integer;
    OrgSize    : TPoint
  end;

//=== Ole UI Link Information Interface ========================================
// Used by object properties dialog

procedure LinkError(const Ident: string);
begin
  Application.MessageBox(PChar(Ident), PChar('Link Properties'), MB_OK or MB_ICONSTOP)
end;

//=== OLE UI Link Container ====================================================
// used by Ole UI ChangeSource, EditLinks, UpdateLinks dialogs

type
  TOleUILinkContainer = class (TStdOleLinkContainer)
    procedure GetNextLink (LinkId: integer; var Result : integer); override;
    procedure OpenLinkSource (LinkId: integer; var Result : integer); override;
    procedure CancelLink (LinkId: integer; var Result : integer); override;
    procedure SetLinkSource (LinkId: integer; DisplayName: string; var NameLen : integer; var Eaten: integer; ValidateSource: boolean; var Result : integer); override;
  private
    FContainer : TOle2Container;
    FLink : integer;
  public
    constructor Create (Container : TOle2Container);
  end;

constructor TOleUILinkContainer.Create (Container : TOle2Container);
var
  OleLink : IOleLink;
begin
  inherited Create;
  FContainer := Container;
  FContainer.FOleObject.QueryInterface (IOleLink, OleLink);
  FLink := integer (OleLink)
end;

procedure TOleUILinkContainer.GetNextLink (LinkId: integer; var Result : integer);
begin
  if LinkId = 0 then
    Result := FLink
  else
    Result := 0
end;

procedure TOleUILinkContainer.OpenLinkSource (LinkId: integer; var Result : integer);
begin
  try
    FContainer.DoVerb (ovShow)
  except
    Application.HandleException (FContainer)
  end;
  Result := ddOk
end;

procedure TOleUILinkContainer.SetLinkSource (LinkId: integer; DisplayName: string; var NameLen : integer; var Eaten: integer; ValidateSource: boolean; var Result : integer);
begin
  inherited SetLinkSource (LinkId, DisplayName, NameLen, Eaten, ValidateSource, Result);

  if Result = ddOk then
  begin
// force image update
    FContainer.ClearDrawAspect;
    FContainer.SetDrawAspect(FContainer.Iconic, FContainer.GetIconMetaPict);
    FContainer.UpdateView
  end
end;

procedure TOleUILinkContainer.CancelLink (LinkId: integer; var Result : integer);
begin
  LinkError ('Cannot break link')
end;

//--- Ole UI Link Info Helper Interface ----------------------------------------

type
  TOleUILinkInfo = class (TStdOleLinkInfo)
    procedure GetNextLink (LinkId: integer; var Result : integer); override;
    procedure OpenLinkSource (LinkId: integer; var Result : integer); override;
    procedure CancelLink (LinkId: integer; var Result : integer); override;
    procedure UpdateLink (LinkId: integer; ErrorMessage, ErrorAction: boolean; var Result : integer); override;
    procedure GetLastUpdate (LinkId : integer; var LastUpdate: TFileTime; var Result : integer); override;
    procedure SetLinkUpdateOptions (LinkId, UpdateOpt: integer; var Result : integer); override;
    procedure SetLinkSource (LinkId: integer; DisplayName: string; var NameLen : integer; var Eaten: integer; ValidateSource: boolean; var Result : integer); override;
  private
    FContainer : TOle2Container;
    FLink : integer;
  public
    constructor Create(Container : TOle2Container);
  end;

constructor TOleUILinkInfo.Create(Container : TOle2Container);
var
  OleLink : IOleLink;
begin
  inherited Create;
  FContainer := Container;
  FContainer.FOleObject.QueryInterface (IOleLink, OleLink);
  FLink := integer (OleLink)
end;

procedure TOleUILinkInfo.GetNextLink (LinkId: integer; var Result : integer);
begin
  if LinkId = 0 then
    Result := FLink
  else
    Result := 0
end;

procedure TOleUILinkInfo.OpenLinkSource (LinkId: integer; var Result : integer);
begin
  try
    FContainer.DoVerb(ovShow)
  except
    Application.HandleException (FContainer)
  end;
  Result := ddOk
end;