olednd.pas

是一个delphi的流程制作软件

// new interfaces
  FDataObject := Value;
  if Assigned (FDataObject) then
  begin
    Result := FDataObject.EnumFormatEtc (ddGet, FEnumerator);
    Assert (Succeeded (Result), 'Cannot get the format enumerator');
    Reset
  end
end;

// returns a handle to the current formatetc given the
// type of medium required
function TEnumFormats.Handle (Tymed : integer; Index : integer = -1): hGlobal;
var
  FormatEtc : TFormatEtc;
begin
  FreeMedium;
  Result := 0;
  if FValid and (FFormatEtc.tymed and Tymed = Tymed) then
  begin
    FormatEtc := FFormatEtc;
    FormatEtc.lindex := Index;
    FormatEtc.tymed := FormatEtc.tymed and Tymed; // use only the requested type
    if Succeeded (FDataObject.GetData (FormatEtc, FMedium)) then
    begin
      FMediumValid := true;
      Result := FMedium.hGlobal
    end
  end
end;

//--- Get a global data handle (eg for CF_TEXT etc)
function TEnumFormats.GlobalHandle : hGlobal;
begin
  Result := Handle (tsGlobal)
end;

//--- Returns the global handle of the MetafilePict or zero if not present
function TEnumFormats.MetafileHandle : hMetafile;
begin
  Result := Handle (tsMetafilePict)
end;

//--- Returns the global handle to the enhanced metafile or 0 on failure
function TEnumFormats.EnhMetafileHandle : hEnhMetafile;
begin
  Result := Handle (tsEnhMetafile)
end;

//--- Returns a GDI object handle
function TEnumFormats.GDIHandle : hGlobal;
begin
  Result := Handle (tsGDI)
end;

function TEnumFormats.StorageInterface (Index : integer = -1) : IStorage;
begin
  Result := IStorage (Handle (tsStorage, Index))
end;

function TEnumFormats.StreamInterface (Index : integer = -1) : IStream;
begin
  Result := IStream (Handle (tsStream, Index))
end;


//--- function to return a string, used by CF_TEXT, CF_FILENAME, CF_OEMTEXT, CF_RTF
function TEnumFormats.SomeText (Format : TClipFormat) : string;
var
  H : hGlobal;
  P : PChar;
begin
  Result := '';
  if HasFormat (Format) then  // check that text is available *AND* position
  begin                       // the enumerator on the text data
    H := GlobalHandle;        // get the global handle to the data
    if FMediumValid then
    try
      if H <> 0 then
      begin
        P := GlobalLock (H);    // it's a pointer to a null terminated string
        try
          Result := P           // get our copy
        finally
          GlobalUnLock (H)      // let it go
        end
      end
    finally
      FreeMedium                // free the storage medium
    end
  end
end;

//--- function to return a wide char string, used by CF_UNICODETEXT
function TEnumFormats.SomeWideText (Format : TClipFormat) : PWideChar;

  function WCopyStr (Source : PWideChar) : PWideChar;

    function WStrLen (Str: PWideChar): Integer;
    begin
      Result := 0;
      while Str [Result] <> #0 do
        inc (Result)
    end;

  var
    Size : longword;
  begin
    Size := (WStrLen (Source)+1) * sizeof (WideChar);
    Result := CoTaskMemAlloc (Size);
    if Result = nil then
      OutOfMemoryError;
    Move (Source^, Result^, Size)
  end;

var
  H : hGlobal;
  P : PWideChar;
begin
  Result := nil;
  if HasFormat (Format) then  // check that text is available *AND* position
  begin                       // the enumerator on the text data
    H := GlobalHandle;        // get the global handle to the data
    if FMediumValid then
    try
      if H <> 0 then
      begin
        P := GlobalLock (H);     // it's a pointer to a double null terminated string
        try
          Result := WCopyStr (P) // get our copy
        finally
          GlobalUnLock (H)       // let it go
        end
      end
    finally
      FreeMedium                 // free the storage medium
    end
  end
end;

//--- function to return a string list of names, used by CF_PRINTERS and CF_HDROP
function TEnumFormats.SomeList (Format : TClipFormat) : TStringList;
var
  H : hGlobal;
  C,
  L : integer;
begin
  Result := TStringList.Create;
  if HasFormat (Format) then
  begin
    H := GlobalHandle;
    if FMediumValid then
    try
      if H <> 0 then
      begin
        C := DroppedCount (H);
        for L := 0 to C - 1 do
          Result.Add (DroppedItem (H, L))
      end
    finally
      FreeMedium
    end
  end
end;

//--- function to return a string list of names, used by CF_FILENAMEMAP
//    from a null terminated series
function TEnumFormats.SomeList0 (Format : TClipFormat) : TStringList;
var
  H : hGlobal;
  P : PChar;
begin
  Result := TStringList.Create;
  if HasFormat (Format) then
  begin
    H := GlobalHandle;
    if FMediumValid then
    try
      P := GlobalLock (H);  // it's a pointer to a null terminated string series
      try
        while P^ <> #0 do
        begin
          Result.Add (P);
          inc (P, length (P) + 1)
        end
      finally
        GlobalUnLock (H)      // let them go
      end
    finally
      FreeMedium
    end
  end
end;

//--- function to return a string list of names, used by CF_DIF, CF_SYLK, CF_CSV
//    from a crlf terminated series
function TEnumFormats.SomeList1 (Format : TClipFormat) : TStringList;
var
  H : hGlobal;
  P : PChar;
begin
  Result := TStringList.Create;
  if HasFormat (Format) then
  begin
    H := GlobalHandle;
    if FMediumValid then
    try
      P := GlobalLock (H);
      try
        Result.Text := P      // build string list
      finally
        GlobalUnLock (H)      // let them go
      end
    finally
      FreeMedium
    end
  end
end;

// Fill a TObjectDescriptor record from an ActiveX.TObjectDescriptor used
// by CF_OBJECTDESCRIPTOR and CF_LINKSCRDESCRIPTOR
function TEnumFormats.SomeDescriptor (Format : TClipFormat) : TObjectDescriptor;
var
  Block : hGlobal;
  BlockData : ActiveX.PObjectDescriptor;
begin
  ZeroMemory (@Result, SizeOf (TObjectDescriptor));
  if HasFormat (Format) then
  begin
    Block := GlobalHandle;
    if FMediumValid then
    try
      BlockData := GlobalLock (Block);
      try
        Result := XlatObjectDescriptor (BlockData^)
      finally
        GlobalUnlock (Block)
      end
    finally
      FreeMedium
    end
  end
end;

//--- TEXT ---
// Returns a text item or empty if not present
function TEnumFormats.Text : string;
begin
  Result := SomeText (CF_TEXT)
end;

// Returns true if some text is available
function TEnumFormats.HasText : boolean;
begin
  Result := HasFormat (CF_TEXT)
end;

//--- RTF TEXT ---
// Returns a rtf item or empty if not present
function TEnumFormats.Rtf : string;
begin
  Result := SomeText (CF_RTF)
end;

// Returns true if some rtf is available
function TEnumFormats.HasRtf : boolean;
begin
  Result := HasFormat (CF_RTF)
end;

//--- OEM TEXT ---
// Returns an oem text item or empty if not present
function TEnumFormats.OemText : string;
begin
  Result := SomeText (CF_OEMTEXT)
end;

// Returns true if some text is available
function TEnumFormats.HasOemText : boolean;
begin
  Result := HasFormat (CF_OEMTEXT)
end;

//--- UNICODE ---
// Returns a pointer to a wide character string.  User has responsibility for
// freeing the wide character string by using CoTaskMemFree.
function TEnumFormats.HasWide : boolean;
begin
  Result := HasFormat (CF_UNICODETEXT)
end;

function TEnumFormats.Wide : PWideChar;
begin
  Result := SomeWideText (CF_UNICODETEXT)
end;

//--- FILENAME ---
// Returns a filename or empty if not present

function TEnumFormats.Filename : string;
begin
  Result := SomeText (CF_FILENAME)
end;

// Returns true if a filename is available
function TEnumFormats.HasFilename : boolean;
begin
  Result := HasFormat (CF_FILENAME)
end;

//--- FILENAMES ---
// Returns a TStringList containing the available filenames.  The list
// is returned empty if no names are available.  The caller is responsible
// for destroying the list.
function TEnumFormats.Filenames : TStringList;
begin
  Result := SomeList (CF_HDROP)
end;

// Returns true if filenames are available
function TEnumFormats.HasFilenames : boolean;
begin
  Result := HasFormat (CF_HDROP)
end;

//--- PRINTERS ---
// Returns a TStringList containing a list of printer names or an empty
// List if no names are present.  Caller has duty to destroy returned TStringList.
function TEnumFormats.Printers : TStringList;
begin
  Result := SomeList (CF_PRINTERS)
end;

// Returns true if a list of printer names is available
function TEnumFormats.HasPrinters : boolean;
begin
  Result := HasFormat (CF_PRINTERS)
end;

//--- FILENAMEMAP ---
// Returns a TStringList containing a list of real filenames which map
// one to one with the list returned by CF_FILENAMES.  Caller has duty to
// destroy the returned TStringList.

function TEnumFormats.FilenameMap : TStringList;
begin
  Result := SomeList0 (CF_FILENAMEMAP)
end;

// Returns true if a filename map is available
function TEnumFormats.HasFilenameMap : boolean;
begin
  Result := HasFormat (CF_FILENAMEMAP)
end;

//--- DIF ---
// returns true if DIF format stuff is available
function TEnumFormats.HasDIF : boolean;
begin
  Result := HasFormat (CF_DIF)
end;

// Returns DIF commands in a stringlist
function TEnumFormats.DIF : TStringList;
begin
  Result := SomeList1 (CF_DIF)
end;

//--- SYLK ---
// Returns true if SYLK format stuff is available
function TEnumFormats.HasSYLK : boolean;
begin
  Result := HasFormat (CF_SYLK)
end;

// Returns SYLK rcommands in a stringlist
function TEnumFormats.SYLK : TStringList;
begin
  Result := SomeList1 (CF_SYLK)
end;

// CSV format
function TEnumFormats.HasCSV : boolean;
begin
  Result := HasFormat (CF_CSV)
end;

function TEnumFormats.CSV : TStringList;
begin
  Result := SomeList1 (CF_CSV)
end;

//--- DIB ---
// Returns a TBitmap containging the bitmap, returns an empty TBitmap on
// failure.  Caller has duty to destroy the TBitmap.  The DIB requires conversion.
function TEnumFormats.HasDIB : boolean;
begin
  Result := HasFormat (CF_DIB)
end;

function TEnumFormats.DIB : TBitmap;
var
  InfoSize : integer;
  Info : PBitmapInfo;
  InfoHandle : hGlobal;
  MemoryStream : TMemoryStream;
  BMF : TBitmapFileheader;
begin
  Result := TBitmap.Create;
  if HasDIB then
  begin
    InfoHandle := GlobalHandle;
    if FMediumValid then
    try
      InfoSize := GlobalSize (InfoHandle);
      Info := GlobalLock (InfoHandle);
      try
        ZeroMemory (@BMF, sizeof (TBitmapFileheader));
        BMF.bfType := $4D42;
        MemoryStream := TMemoryStream.Create;
        try
          MemoryStream.Write (BMF, sizeof (BMF));
          MemoryStream.Write (Info^, InfoSize);
          MemoryStream.Seek (0, 0);
          Result.LoadFromStream (MemoryStream)
        finally
          MemoryStream.Free
        end
      finally
        GlobalUnlock (InfoHandle)
      end