oleconsts.pas

是一个delphi的流程制作软件

  CLSID_NULL : TCLSID = '{00000000-0000-0000-0000-000000000000}';

// Registered window messages
var
  MsgHelp,
  MsgEndDialog,
  MsgBrowse,
  MsgChangeIcon,
  MsgFileOkString,
  MsgCloseBusyDlg : integer;

//Default drag constants as Delphi style (originals in ActiveX)
const
  ddScrollInset    = DD_DEFSCROLLINSET;    // = 11
  ddScrollDelay    = DD_DEFSCROLLDELAY;    // = 50
  ddScrollInterval = DD_DEFSCROLLINTERVAL; // = 50
  ddDragDelay      = DD_DEFDRAGDELAY;      // = 200
  ddDragMinDist    = DD_DEFDRAGMINDIST;    // = 2

// Filemode constants
const
// defined in objbase.h
  STGM_NOSCRATCH    = $00100000;
  STGM_NOSNAPSHOT   = $00200000;
  STGM_SIMPLE       = $08000000;
// These are declared in SysUtils, so use them from there
//fmOpenRead        = $0000;
//fmOpenWrite       = $0001;
//fmOpenReadWrite   = $0002;
//fmShareCompat     = $0000;
//fmShareExclusive  = $0010;
//fmShareDenyWrite  = $0020;
//fmShareDenyRead   = $0030;
//fmShareDenyNone   = $0040;
  fmDirect          = STGM_DIRECT;           // $00000000
  fmTransacted      = STGM_TRANSACTED;       // $00010000
  fmCreate          = STGM_CREATE;           // $00001000
  fmConvert         = STGM_CONVERT;          // $00020000
  fmFailIfThere     = STGM_FAILIFTHERE;      // $00000000
  fmPriority        = STGM_PRIORITY;         // $00040000
  fmDeleteOnRelease = STGM_DELETEONRELEASE;  // $04000000
  fmSimple          = STGM_SIMPLE;           // $08000000
  fmNoScratch       = STGM_NOSCRATCH;        // $00100000
  fmNoSnapShot      = STGM_NOSNAPSHOT;       // $00200000

// my stuff  
  fmFailExists      = $80000000;             // My flag to show a bit  = fail if there
  fmCreateGroup = fmCreate or fmFailExists or fmConvert;
  fmFailMask    = $0FFFFFFF;
  fmCreateMask  = fmOpenWrite or fmOpenReadWrite or fmShareDenyRead or fmShareDenyNone
    or fmTransacted or fmPriority or fmDeleteOnRelease;

// Array of fixed clipboard formats
type
  TFixedClipName = record
    Code : TClipFormat;
    Name : string
  end;

const
  FixedClipNames : array [1..22] of TFixedClipName =
    ((Code :   1; Name : 'Text'),
     (Code :   2; Name : 'Bitmap'),
     (Code :   3; Name : 'MetafilePict'),
     (Code :   4; Name : 'Sylk'),
     (Code :   5; Name : 'Dif'),
     (Code :   6; Name : 'Tiff'),
     (Code :   7; Name : 'OemText'),
     (Code :   8; Name : 'DIB'),
     (Code :   9; Name : 'Palette'),
     (Code :  10; Name : 'PenData'),
     (Code :  11; Name : 'Riff'),
     (Code :  12; Name : 'Wave'),
     (Code :  13; Name : 'UnicodeText'),
     (Code :  14; Name : 'EnhMetafile'),
     (Code :  15; Name : 'HDrop'),
     (Code :  16; Name : 'Locale'),
     (Code :  17; Name : 'Max'),
     (Code : $80; Name : 'OwnerDisplay'),
     (Code : $81; Name : 'DSPText'),
     (Code : $82; Name : 'DSPBitmap'),
     (Code : $83; Name : 'DSPMetafilePict'),
     (Code : $8E; Name : 'DSPEnhMetafile'));

// A string list of clipboard formats, fixed and registered (locally)
var
  KnownClipboardFormats : TStringList;

// This registers a format with windows and adds the format name and
// number to the stringlist
function RegisterClipboardFormat (const Format : string) : TClipFormat;

type
  TClipName = type string;
  TClipAspect = (caNull, caContent, caThumbnail, caIcon, caDocPrint);
  TClipMedium = (cmNull, cmGlobal, cmFile, cmStream, cmStorage, cmGDI, cmMFPict, cmEnhMF);
  TClipMediums = set of TClipMedium;

function XlatMediums (Value : TClipMediums) : integer; overload;
function XlatMediums (Value : integer) : TClipMediums; overload;
function XlatMedium (Value : integer) : TClipMedium;
function XlatAspect (Value : TClipAspect) : integer;  overload;
function XlatAspect (Value : integer) : TClipAspect;  overload;

type
  TCLSIDStr = string [38];



//=== Common to OleRichEdit and OleContainer ===================================

const
  ovShow             = -1;
  ovOpen             = -2;
  ovHide             = -3;
  ovUIActivate       = -4;
  ovInPlaceActivate  = -5;
  ovDiscardUndoState = -6;
  ovPrimary          = -65536;

type
  TObjectState  = (osEmpty, osLoaded, osRunning, osOpen, osInPlaceActive, osUIActive, osHighlighted, osSelected);
  TCreateType   = (ctNewObject, ctFromFile, ctLinkToFile, ctFromData, ctLinkFromData);
  TConvertInfo  = (ciFormat, ciType, ciLabel, ciMetafile);
  TConvertInfos = set of TConvertInfo;
  TCreateInfo = record
    CreateType   : TCreateType;
    ShowAsIcon   : boolean;
    IconMetaPict : hGlobal;
    ClassID      : TCLSID;
    FileName     : WideString;
    DataObject   : IDataObject
  end;

  TVerbInfo = record
    Verb  : Smallint;
    Flags : word
  end;


// used by richedit stuff in oleinterface.pas

type
  TREObjectFlag = (reIndex, reByPosition, reSelection, reOleObject, reStorage, reSite);
  TREObjectFlags = set of TREObjectFlag;

const
  reoSelection = integer (REO_IOB_SELECTION);

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

implementation

function RegisterClipboardFormat (const Format : string) : TClipFormat;
begin
  Result := Windows.RegisterClipboardFormat (PChar(Format));
  if KnownClipboardFormats.IndexOf (Format) < 0 then
    KnownClipboardFormats.AddObject (Format, pointer (Result))
end;

const
  XlatMediumTable : array [TClipMedium] of integer =
    (TYMED_NULL, TYMED_HGLOBAL, TYMED_FILE, TYMED_ISTREAM, TYMED_ISTORAGE,
     TYMED_GDI, TYMED_MFPICT, TYMED_ENHMF);

// Converts a TFormatMedium into an integer
function XlatMediums (Value : TClipMediums) : integer;
var
  Loop : TClipMedium;
begin
  Result := TYMED_NULL;
  for Loop := low (TClipMedium) to high (TClipMedium) do
    if Loop in Value then
      Result := Result or XlatMediumTable [Loop]
end;

function XlatMediums (Value : integer) : TClipMediums;
var
  Loop : TClipMedium;
begin
  Result := [];
  for Loop := low (TClipMedium) to high (TClipMedium) do
    if XlatMediumTable [Loop] and Value <> 0 then
      Result := Result + [Loop]
end;

function XlatMedium (Value : integer) : TClipMedium;
begin
  for Result := low (TClipMedium) to high (TClipMedium) do
    if XlatMediumTable [Result] = Value then
      exit;

  Result := cmNull
end;

const
  XlatAspectTable : array [TClipAspect] of integer =
    (0, DVASPECT_CONTENT, DVASPECT_THUMBNAIL, DVASPECT_ICON, DVASPECT_DOCPRINT);

// Converts a TClipAspect into an integer
function XlatAspect (Value : TClipAspect) : integer;
var
  Loop : TClipAspect;
begin
  Result := 0;
  for Loop := low (TClipAspect) to high (TClipAspect) do
    if Loop = Value then
    begin
      Result := XlatAspectTable [Loop];
      exit
    end;
end;

// Converts an integer into a TClipAspect
function XlatAspect (Value : integer) : TClipAspect;
begin
  for Result := low (TClipAspect) to high (TClipAspect) do
    if XlatAspectTable [Result] = Value then
      exit;

  Result := caNull
end;

procedure Init;
var
  Result : HRESULT;
  Loop : integer;
begin
  Result := OleInitialize (nil);
  Assert (Result in [S_OK, S_FALSE], Format ('OleInitialize failed ($%x)', [Result]));

// create stringlist
  KnownClipboardFormats := TStringList.Create;
// add the fixed names
  for Loop := low (FixedClipNames) to high (FixedClipNames) do
    with FixedClipNames [Loop] do
      KnownClipboardFormats.AddObject (Name, pointer (Code));

// register additional formats
  CF_EMFPICTURE        := RegisterClipboardFormat ('Screen Picture EMF');
  CF_RTF               := RegisterClipboardFormat (RichEdit.CF_RTF);            // 'Rich Text Format'
  CF_RTFNOOBJS         := RegisterClipboardFormat (RichEdit.CF_RTFNOOBJS);      // 'Rich Text Format Without Objects'
  CF_RETEXTOBJ         := RegisterClipboardFormat (RichEdit.CF_RETEXTOBJ);      // 'RichEdit Text and Objects'
  CF_CSV               := RegisterClipboardFormat ('CSV');                      // comma separated values
  CF_URL               := RegisterClipboardFormat (CFSTR_SHELLURL);             // 'UniformResourceLocator'
  CF_NETSCAPE          := RegisterClipboardFormat ('Netscape Bookmark');        // untested!
  CF_FILENAMEA         := RegisterClipboardFormat (CFSTR_FILENAMEA);            // 'FileName'
  CF_FILENAME          := CF_FILENAMEA;
  CF_PRINTERS          := RegisterClipboardFormat (CFSTR_PRINTERGROUP);         // 'PrinterFriendlyName'
  CF_FILENAMEMAPA      := RegisterClipboardFormat (CFSTR_FILENAMEMAPA);         // 'FileNameMap'
  CF_FILENAMEMAP       := CF_FILENAMEMAPA;
  CF_OBJECTDESCRIPTOR  := RegisterClipboardFormat ('Object Descriptor');
  CF_EMBEDDEDOBJECT    := RegisterClipboardFormat ('Embedded Object');
  CF_LINKSRCDESCRIPTOR := RegisterClipboardFormat ('Link Source Descriptor');
  CF_LINKSOURCE        := RegisterClipboardFormat ('Link Source');
  CF_SHELLSCRAP        := RegisterClipboardFormat ('Shell scrap object');
  CF_PREFERREDDROPEFFECT := RegisterClipboardFormat (CFSTR_PREFERREDDROPEFFECT);  // 'Preferred DropEffect'
  CF_IDLIST            := RegisterClipboardFormat (CFSTR_SHELLIDLIST);          // 'Shell IDList Array'
  CF_OBJECTPOSITIONS   := RegisterClipboardFormat (CFSTR_SHELLIDLISTOFFSET);    // 'Shell Object Offsets'
  CF_FILEDESCRIPTORA   := RegisterClipboardFormat (CFSTR_FILEDESCRIPTOR);
  CF_FILEDESCRIPTOR    := CF_FILEDESCRIPTORA;
  CF_FILECONTENTS      := RegisterClipboardFormat (CFSTR_FILECONTENTS);
// Delphi clipboard formats
  CF_PICTURE           := RegisterClipboardFormat ('Delphi Picture');
  CF_COMPONENT         := RegisterClipboardFormat ('Delphi Component');
  CF_OBJECT            := RegisterClipboardFormat ('Delphi Object');
// makes an icon in a TImage dragable/copyable
  CF_ICON              := RegisterClipboardFormat ('Icon');

  MsgHelp         := RegisterWindowMessage (SZOLEUI_MSG_HELP);
  MsgEndDialog    := RegisterWindowMessage (SZOLEUI_MSG_ENDDIALOG);
  MsgBrowse       := RegisterWindowMessage (SZOLEUI_MSG_BROWSE);
  MsgChangeIcon   := RegisterWindowMessage (SZOLEUI_MSG_CHANGEICON);
  MsgFileOkString := RegisterWindowMessage (FILEOKSTRING);
  MsgCloseBusyDlg := RegisterWindowMessage (SZOLEUI_MSG_CLOSEBUSYDIALOG);
end;

initialization
  Init
finalization
  KnownClipboardFormats.Free;
  OleUninitialize
end.