oledataobject.pas

是一个delphi的流程制作软件

//------------------------- Ole Data Objects -----------------------------------
//
// Provide a series of components that can be lined at design time to controls
// that are drag sources.  These components extract relevant data.
//
// Grahame Marsh
// Freeware for UNDU - you get it for free I make no promises
// [e-mail]
//------------------------------------------------------------------------------

{$INCLUDE OLE.INC}

unit OleDataObject;

interface

uses
  Windows, SysUtils, ActiveX, Classes, Graphics, ExtCtrls, Controls, TypInfo,
  Forms, ComCtrls, StdCtrls, CheckLst,
{$IFDEF GIF}
  GifImage,
{$ENDIF}
{$IFDEF JPEG}
  JPEG,
{$ENDIF}
  OleConsts, OleInterface, OleHelpers, OleFormatEtc, OleErrors, OleStd, OleDnD;

//=== CLONE DATAOBJECT =========================================================
// When you copy (or cut) to the clipboard you must create a copy of the data and
// pass this to the clipboard.  If you don't do this the data can change between
// the copy operation and the user's paste operation. Not Good (tm). The user expects
// the data copied to be the same as the data pasted.  This object can provide
// this service of global memory objects.
// It receives a list of formats and a corresponding list of data handles.  The
// format list and the data handles are accepted without copying and are
// automatically freed on release.
type
  THandles = array of THandle;
  TCloneDataObject = class (TObjectBaseDataObject)
  private
    FHandles : THandles;          // local data copy goes here
    FFormats : TFormatEtcList;    // local format copy goes here
  protected
    procedure GetData (const FormatEtc : TFormatEtc; var Medium : TStgMedium; var Result : integer); override;
    procedure GetDataHere (const FormatEtc: TFormatEtc; var Medium: TStgMedium; var Result : integer); override;
    procedure QueryGetData (const FormatEtc: TFormatEtc; var Result : integer); override;
    procedure GetCanonicalFormatEtc (const FormatEtcIn: TFormatEtc; var FormatEtcOut: TFormatEtc; var Result : integer); override;
    procedure SetData (const formatetc: TFormatEtc; var Medium: TStgMedium; Release: boolean; var Result : integer); override;
    procedure EnumFormatEtc (Direction: integer; var EnumFormatEtc: IEnumFormatEtc; var Result : integer); override;
    procedure DAdvise (const FormatEtc: TFormatEtc; Advf: integer; const AdvSink: IAdviseSink; var Connection: integer; var Result : integer); override;
    procedure DUnadvise (Connection: integer; var Result : integer); override;
    procedure EnumDAdvise (var EnumAdvise: IEnumStatData; var Result : integer); override;
  public
    constructor Create (Formats : TFormatEtcList; Handles : THandles);
    destructor Destroy; override;
  end;

// A request for the data has occurred - you supply an event handler to return
// a handle to the data in the requested format, aspect, medium and pageindex.  If necessary
// (not done: you can also provide a Release function so that the receiver of the data can
// clean up afterwards).
type
  TWantDataObject = procedure (Sender : TObject; var DataObject : IDataObject) of object;
  TWantFormatsEvent = procedure (Sender : TObject; FormatList : TFormatEtcList) of object;
  TWantDataEvent = procedure (Sender : TObject; Format : TClipFormat; Medium : TClipMedium;
    Aspect : TClipAspect; AIndex : integer; var Handle : THandle) of object;

// This is an abstract class between a TComponents and the data objects
// specific to Delphi controls. Descendants must override the two abstract
// methods (ProvideXxxxx).  The class knows how to clone the data held by the
// controls provided they are held in global memory.
// There is also a copy to clipboard method (which does that) and a DataObject
// property so a dataobject can be obtained for DnD operations.

  TCustomDataSource = class (TComponent)
  private
    FBegin,
    FEnd : TNotifyEvent;
    FWantDataObject : TWantDataObject;
    FWantData : TWantDataEvent;
    FWantFormats : TWantFormatsEvent;
    FPreferredDropEffect : integer;
  protected
    function GetDataObject : IDataObject; virtual;
    function ProvideFormats : TFormatEtcList; virtual; abstract;
    function ProvideData (Format : TClipFormat; Medium : TClipMedium; Aspect : TClipAspect; AIndex : integer) : THandle; virtual; abstract;
  public
    property PreferredDropEffect : integer read FPreferredDropEffect write FPreferredDropEffect;
    procedure CopyToClipboard;
    procedure CutToClipboard;
    property DataObject : IDataObject read GetDataObject;
// The event is called when a dataobject is called for
    property OnBegin : TNotifyEvent read FBegin write FBegin;
    property OnEnd : TNotifyEvent read FEnd write FEnd;
// Use this to provide your own data handle in the format, aspect and medium asked for.
    property OnWantData : TWantDataEvent read FWantData write FWantData;
// Use this to describe your own data formats
    property OnWantFormats : TWantFormatsEvent read FWantFormats write FWantFormats;
// Use this object to pass your own data object
    property OnWantDataObject : TWantDataObject read FWantDataObject write FWantDataObject;
  end;

// This component contains some common properties for the creation of scrap
// files (you can drag a control's contents and drop them on the desktop where
// they appear as a file).  The properties are here, but used in descendants.
// It can be useful to pass a cfObjectDescriptor format even when not passing
// an ole object for embedding or linking operations.  You can place in the
// format information about where the formats have come from.  This is done using the
// DescriptionMode property and OnWantDescription event.
// Surfaces PreferredDropEffect format - can be omitted or made to appear

  TDescriptionMode = (dmNone, dmName, dmExeName, dmTitle);
  TWantDescription = procedure (Sender : TObject; var Description : TObjectDescriptor) of object;

  TDelphiDataSource = class (TCustomDataSource)
  private
    FDescriptionMode : TDescriptionMode;
    FWantDescription : TWantDescription;
    FPreferAllow,
    FScrapAllow : boolean;
    FScrapFilename : string;
  protected
    function ProvideFormats : TFormatEtcList; override;
    function ProvideData (Format : TClipFormat; Medium : TClipMedium; Aspect : TClipAspect; AIndex : integer) : THandle; override;
  public
    property PreferAllow : boolean read FPreferAllow write FPreferAllow default false;
    property ScrapAllow : boolean read FScrapAllow write FScrapAllow default false;
    property ScrapFilename : string read FScrapFilename write FScrapFilename;
    property OnWantDescription : TWantDescription read FWantDescription write FWantDescription;
    property DescriptionMode : TDescriptionMode read FDescriptionMode write FDescriptionMode default dmNone;
  end;

//=== PICTURE DATA SOURCE ======================================================
// This descendant is preset to be able to use graphical information.  You provide
// the TGraphic by linking to a TImage (using the Image property) is the graphic
// is displayed.  Or if a non-visible graphic you link with the TPicture property.
// Setting one disconnects the other.  The class will work as standard with TMetafiles
// (which are actually enhanced metafiles), Bitmaps, Icons (strange but true),
// JPEGs and GIF images (the last two have $DEFINEs to control their inclusion).
// A Palette format is automatically provided if the graphic has one.  A common
// or garden windows metafilepict is provided (controlled by a boolean property)
// as many applications will accept a metafile but not other formats.  The Icon,
// Bitmap, GIF or JPEG is "wrapped" into a windows metafile.  An enhanced metafile
// is converted backwards (possibly loosing information in the process).
// If you have your own data format that you want to include, then an Event allows
// you to set up the data formats available list, and another Event allows you to
// provide the data handle when requested.  In this version all data is transferred
// using global memory which is easy but can be slow and inefficient (sorry).

  TPictureDataSource = class (TDelphiDataSource)
  private
    FImage : TImage;
    FPicture : TPicture;
    FAutoPal,
    FAutoMF : boolean;
    procedure SetImage (Value : TImage);
    function GetPicture : TPicture;
    procedure SetPicture (Value : TPicture);
    function IsPicture : boolean;
  protected
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
    function ProvideFormats : TFormatEtcList; override;
    function ProvideData (Format : TClipFormat; Medium : TClipMedium; Aspect : TClipAspect; AIndex : integer) : THandle; override;
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
  published
// Set to true will try and make a windows metafile format appear
// in the formats list
    property AutoMF : boolean read FAutoMF write FAutoMF default true;
// Set to true will make a palette appear in the formats list if available
    property AutoPalette : boolean read FAutoPal write FAutoPal default true;
// Link your Image in here
    property Image : TImage read FImage write SetImage;
// Put your graphic in here as a TPicture
    property Picture : TPicture read GetPicture write SetPicture stored IsPicture;
// publish description and scrap properties
    property ScrapAllow;
    property ScrapFilename;
    property DescriptionMode;
    property PreferAllow;
// publish event handlers
    property OnBegin;
    property OnEnd;
    property OnWantData;
    property OnWantFormats;
    property OnWantDataObject;
    property OnWantDescription;
  end;

//=== CONTROL LINKED DATA SOURCE ===============================================
// This class contains a control property to allow it to be linked to
// a control as a convinent way to obtain property data from that control.

type
  TCustomControlDataSource = class (TDelphiDataSource)
  private
    FControl : TControl;
    function IsControl : boolean;
  protected
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
  public
    property Control : TControl read FCOntrol write FControl;
  end;

  TControlDataSource = class (TCustomControlDataSource)
  published
    property Control;
    property OnBegin;
    property OnEnd;
    property OnWantData;
    property OnWantFormats;
    property OnWantDataObject;
    property OnWantDescription;
  end;

//=== STRING(S) DATA SOURCE ====================================================
// This chart shows the various "Text" properties available
//
//                Caption  Text   Lines  Items  ItemIndex
//
// TLabel             X
// TEdit                    X
// TMaskEdit                X
// TMemo                    X       X
// TButton            X
// TCheckBox          X
// TRadioButton       X
// TListBox                                X       X(1)
// TComboBox                X
// TGroupBox          X
// TPanel             X
// TRadioGroup                             X       X
// TBitBtn            X
// TCheckListBox                           X       X
// TRichEdit
// TStaticText        X
// TPageControl       X(2)
// TTabControl                             X(3)    X(3)
// TTreeView                X(4)
// TListView                X(5)           X(6)    X(6)
//
// Notes:
// 1. TListBox ItemIndex property is not published
// 2. TPageControl Caption property obtained via ActivePage property
// 3. Called Tabs and TabIndex properties (pain)
// 4. Text property of the selected TTreeView node
// 5. Of the selected TListView nodes
// 6. via Selected property

// Unsupported here:
//   TRichEdit (has built in support)
//   TDateTimePicker
//   TMonthCalendar
//   TStringGrid

type
  TStringFormat  = (sfText, sfOemText, sfFilename,      // single strings
                    sfCSV, sfFilenames, sfPrinters);    // lists of strings
  TStringFormats = set of TStringFormat;

const
  DefaultFormats = [sfText, sfCSV];

type
  TCustomStringDataSource = class (TCustomControlDataSource)
  private
    FAutoLocale : boolean;
    FFormats : TStringFormats;
    FText : string;
    FStrings : TStringList;
    procedure SetText (Value : string);
    function GetText : string;
    procedure SetStrings (Value : TStrings);
    function GetStrings : TStrings;
  protected
    function ProvideFormats : TFormatEtcList; override;
    function ProvideData (Format : TClipFormat; Medium : TClipMedium; Aspect : TClipAspect; AIndex : integer) : THandle; override;
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
    property AutoLocale : boolean read FAutoLocale write FAutoLocale default true;
    property Formats : TStringFormats read FFormats write FFormats default DefaultFormats;
    property Text : string read GetText write SetText stored IsControl;
    property Strings : TStrings read GetStrings write SetStrings stored IsControl;
  end;

// make properties public...
type
  TStringDataSource = class (TCustomStringDataSource)
  published
    property AutoLocale;
    property Control;
    property Formats;
    property Text;
    property Strings;
    property ScrapAllow;
    property PreferAllow;
    property ScrapFilename;
    property DescriptionMode;
    property OnWantData;
    property OnWantDataObject;
    property OnWantFormats;
    property OnWantDescription;
    property OnBegin;
    property OnEnd;
  end;

// URL source component is derived from the string source by adding a second
// text type control to get the url string from.
// Tested with IE only not Netscape
type
  TURLDataSource = class (TCustomStringDataSource)
  private
    FURLControl : TControl;
    FURL : string;
    procedure SetURL (const Value : string);
    function GetURL : string;
    function IsURLControl : boolean;
  protected
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
    function ProvideFormats : TFormatEtcList; override;
    function ProvideData (Format : TClipFormat; Medium : TClipMedium; Aspect : TClipAspect; AIndex : integer) : THandle; override;
  public
    constructor Create (AOwner : TComponent); override;
  published
    property Control;
    property Text;
    property ScrapAllow;
    property URL : string read GetURL write SetURL stored IsURLControl;
    property URLControl : TControl read FURLControl  write FURLControl;
// publish description
    property DescriptionMode;
// publish event handlers
    property OnWantData;
    property OnWantFormats;
    property OnWantDataObject;
    property OnWantDescription;
  end;

//=== DELPHI COMPONENT DATASOURCE ==============================================
// This descendent transfers the published non-default, stored properties of the
// attached component.  It uses the built-in delphi component streaming
// capabilities rather than any custom examination of the component properties.
// This reduces the amount of information available, but simplifes the code here
// enormously.  The component can be reconstructed to obtain the default values.
//
  TComponentDataSource = class (TDelphiDataSource)
  private
    FComponent : TComponent;
  protected
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
    function ProvideFormats : TFormatEtcList; override;
    function ProvideData (Format : TClipFormat; Medium : TClipMedium; Aspect : TClipAspect; AIndex : integer) : THandle; override;
  public
  published
// Component to get data from
    property Component : TComponent read FComponent write FComponent;
// publish description
    property DescriptionMode;
    property PreferAllow;
// publish event handlers
    property OnBegin;
    property OnEnd;
    property OnWantData;
    property OnWantFormats;
    property OnWantDataObject;
    property OnWantDescription;
  end;

//=== DELPHI OBJECT DATASOURCE =================================================
// This data source can pass a pointer to an instance of any Delphi descendant
// of TObject.  BUT you can only drop and use this instance within the context
// that it was generated.  So along with the object is passed the MainTheadId and
// you should only use the dataobject's reference to the TObject if the MainThread
// id and the passed thread id are the same.  The purpose of this dataobject is
// to emulate the drag and drop capabilities of Delphi components (but using Ole
// instead). If you ignore this warning and try to access a control from another
// processes then you are likely to get rubbish returned at best and an AV error
// at worst.

type
  PDelphiObjectData = ^TDelphiObjectData;
  TDelphiObjectData = record
    Control : TObject;
    Thread  : longword
  end;

type
  TDelphiObjectDataSource = class (TCustomControlDataSource)
  private
  protected
    function ProvideFormats : TFormatEtcList; override;
    function ProvideData (Format : TClipFormat; Medium : TClipMedium; Aspect : TClipAspect; AIndex : integer) : THandle; override;
  public
  published
    property Control;
// publish description  and scrap properties
    property DescriptionMode;
    property PreferAllow;
// publish event handlers
    property OnWantData;
    property OnWantFormats;
    property OnWantDataObject;
    property OnWantDescription;
    property OnBegin;
    property OnEnd;
  end;

implementation

//=== DATAOBJECT ===============================================================
// This is the dataobject implementation created as needed passing over copies
// of data handles and FormatEtc data for each handle.
// Keep incoming formats and data copies, and free them when done.