olenames.pas

是一个delphi的流程制作软件

//--- Clipboard & DnD type to string conversion --------------------------------
//
// A set of conversion routines which take clipboard or COM DnD values or
// sets (as integer) and convert them into strings.
//
// Grahame Marsh
// Freeware for UNDU - you get it for free I make no promises
// [e-mail]
//------------------------------------------------------------------------------

{$INCLUDE OLE.INC}

unit OleNames;

interface

uses
  Windows, SysUtils, Classes, ActiveX;

// Returns a predefined cf_ code as a string
function GetPredefinedName (ACode : integer) : string;

// Replacement for windows function as it fills in the standard names also
function GetClipboardFormatName (ACode: word) : string;

// Returns the names of available storage medium for a data object
function GetMediumName (ACode : integer) : string;

// Returns the names of status for a data object/object descriptor
function GetStatusName (ACode : integer) : string;

// Returns the names of available draw view aspects for a data object/descriptor
function GetAspectName (ACode : integer) : string;

// Returns the names of available file descriptor data items
function GetValidFileDescriptorNames (ACode : integer) : string;

// Returns the names of file attribute flags
function GetFileAttributeNames (ACode : integer) : string;

// Returns the open mode codes
function GetFileModeNames (ACode : integer) : string;

var
  Separator : string = '/';

implementation

uses
  OleDnd, OleConsts;

//--- Internal utilities -------------------------------------------------------

type
  TName = record
    Code : integer;
    Name : string
  end;

function Assemble (ACode : integer; Names : array of TName) : string;
var
  Loop : integer;
begin
  Result := '';
  for Loop := Low (Names) to High (Names) do
    with Names [Loop] do
      if Code and ACode  <> 0 then
        Result := Result + Name + Separator;

  if Result = '' then
    Result := '<none>'
  else
    Delete (Result, length (Result) - length (Separator) + 1, length (Separator))
end;

//--- function to convert a predefined cf_ code into a string ------------------
function GetPredefinedName (ACode : integer) : string;
const
  Names : array [1..22] of TName =
    ((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'));
var
  Loop : integer;
begin
  for Loop := Low (Names) to High (Names) do
    with Names [Loop] do
      if ACode = Code then
      begin
        Result := Name;
        exit
      end;
  Result := '<unknown format>'
end;

// replacement for windows function as it fills in the standard names also -----
function GetClipboardFormatName (ACode: word) : string;
begin
  if ACode >= $C000 then
  begin
    SetLength (Result, 255);
    Windows.GetClipboardFormatName (ACode, PChar(Result), 255);
    SetLength (Result, StrLen (PChar (Result)))
  end else
    Result := GetPredefinedName (ACode)
end;

//--- Returns the names of available storage medium for a data object ----------
function GetMediumName (ACode : integer) : string;
const
  Names : array [1..8] of TName =
    ((Code : tsGlobal;       Name : 'Global'),
     (Code : tsFile;         Name : 'File'),
     (Code : tsStream;       Name : 'IStream'),
     (Code : tsStorage;      Name : 'IStorage'),
     (Code : tsGDI;          Name : 'GDI'),
     (Code : tsMetafilePict; Name : 'MetafilePict'),
     (Code : tsEnhMetafile;  Name : 'EnhMetafile'),
     (Code : tsNull;         Name : 'Null'));
begin
  Result := Assemble (ACode, Names)
end;

//--- returns the names of available draw view aspects for a -------------------
//    data object/descriptor
function GetAspectName (ACode : integer) : string;
const
  Names : array [1..5] of TName =
    ((Code : dvaContent;    Name : 'Content'),
     (Code : dvaThumbnail;  Name : 'Thumbnail'),
     (Code : dvaIcon;       Name : 'Icon'),
     (Code : dvaDocPrint;   Name : 'Doc print'),
     (Code : dvaShortName;  Name : 'Short name'));
begin
  Result := Assemble (ACode, Names)
end;

//--- Returns the names of status for a data object/object descriptor ----------
function GetStatusName (ACode : integer) : string;
const
  Names : array [1..22] of TName =
   ((Code : omRecomposeOnResize;    Name : 'Recompose on resize'),
    (Code : omOnlyIconic;           Name : 'Only iconic'),
    (Code : omInsertNotReplace;     Name : 'Insert not replace'),
    (Code : omStatic;               Name : 'Static'),
    (Code : omCantLinkInsize;       Name : 'Can''t link inside'),
    (Code : omCanLinkByOLE;         Name : 'Can link by OLE'),
    (Code : omIsLinkObject;         Name : 'Is link object'),
    (Code : omInsizeOut;            Name : 'Inside out'),
    (Code : omActivateWhenVisible;  Name : 'Active when visible'),
    (Code : omRenderingDI;          Name : 'Rendering is device independant'),
    (Code : omInvisible;            Name : 'Invisible at runtime'),
    (Code : omAlwaysRun;            Name : 'Always run'),
    (Code : omButton;               Name : 'Acts like button'),
    (Code : omLabel;                Name : 'Acts like Label'),
    (Code : omNoUIActivate;         Name : 'NO UI Activate'),
    (Code : omAlignable;            Name : 'Alignable'),
    (Code : omSimpleFrame;          Name : 'Simple frame'),
    (Code : omSetClientSiteFirst;   Name : 'Set client site first'),
    (Code : omIMEMode;              Name : 'IME mode'),
    (Code : omNoReactivate;         Name : 'Ignore Activate when visible'),
    (Code : omWantsToMenuMerge;     Name : 'Wants to menu merge'),
    (Code : omMultiUndu;            Name : 'Supports multilevel undu'));
begin
  Result := Assemble (ACode, Names)
end;

// Returns the names of available file descriptor data items
function GetValidFileDescriptorNames (ACode : integer) : string;
const
  Names : array [1..8] of TName =
   ((Code : fdCLSID;      Name : 'CLSID'),
    (Code : fdSizePoint;  Name : 'IconSize'),
    (Code : fdAttributes; Name : 'Attr'),
    (Code : fdCreateTime; Name : 'Create'),
    (Code : fdAccessTime; Name : 'Access'),
    (Code : fdWritesTime; Name : 'Write'),
    (Code : fdFileSize;   Name : 'FileSize'),
    (Code : fdLinkUI;     Name : 'LinkUI'));
begin
  Result := Assemble (ACode, Names)
end;

// Returns the names of file attribute flags
function GetFileAttributeNames (ACode : integer) : string;
const
  Names : array [1..10] of TName =
   ((Code : faReadOnly;   Name : 'ReadOnly'),
    (Code : faHidden;     Name : 'Hidden'),
    (Code : faSysFile;    Name : 'System'),
    (Code : faVolumeID;   Name : 'Volume'),
    (Code : faDirectory;  Name : 'Directory'),
    (Code : faArchive;    Name : 'Archive'),
    (Code : faNormal;     Name : 'Normal'),
    (Code : faTemporary;  Name : 'Temporary'),
    (Code : faCompressed; Name : 'Compressed'),
    (Code : faOffline;    Name : 'Offline'));
begin
  Result := Assemble (ACode, Names)
end;

function GetFileModeNames (ACode : integer) : string;
begin
  Result := '';
  case ACode and $0000000F of
    fmOpenRead      : Result := 'Read';
    fmOpenWrite     : Result := 'Write';
    fmOpenReadWrite : Result := 'Read/Write'
  else
    Result := '<Open?>'
  end;
  Result := Result + Separator;

  case ACode and $000000F0 of
    fmShareCompat     : Result := Result + 'Compatible';
    fmShareExclusive  : Result := Result + 'Exclusive';
    fmShareDenyWrite  : Result := Result + 'Deny Write';
    fmShareDenyRead   : Result := Result + 'Deny Read';
    fmShareDenyNone   : Result := Result + 'Deny None';
  else
     Result := Result + '<Share?>'
  end;
  Result := Result + Separator;

  if ACode and fmTransacted <> 0 then
    Result := Result + 'Transacted'
  else
    Result := Result + 'Direct';
  Result := Result + Separator;

  if ACode and fmConvert <> 0 then
    Result := Result + 'Converted' + Separator;

  if ACode and fmPriority <> 0 then
    Result := Result + 'Priority' + Separator;

  if ACode and fmDeleteOnRelease <> 0 then
    Result := Result + 'AutoDelete' + Separator
end;

end.