olednd.pas

是一个delphi的流程制作软件

    finally
      FreeMedium
    end
  end
end;

//--- Bitmap ---
// Returns a TBitmap containging the bitmap, returns an empty TBitmap on
// failure.  Caller has duty to destroy the TBitmap.
function TEnumFormats.HasBitmap : boolean;
begin
  Result := HasFormat (CF_BITMAP)
end;

function TEnumFormats.Bitmap : TBitmap;
begin
  Result := TBitmap.Create;
  if HasBitmap then
  try
    Result.Handle := CopyImage (GDIHandle, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
  finally
    FreeMedium
  end
end;

// TIcon
function TEnumFormats.HasIcon : boolean;
begin
  Result := HasFormat (CF_ICON)
end;

function TEnumFormats.Icon : TIcon;
var
  Stream : THandleMemStream;
begin
  Result := TIcon.Create;
  if HasIcon then
  try
    Stream := THandleMemStream.Create (GlobalHandle);
    try
      Result.LoadFromStream (Stream)
    finally
      Stream.Free
    end
  finally
    FreeMedium
  end
end;

// GIF
{$IFDEF GIF}
function TEnumFormats.HasGIF : boolean;
begin
  Result := HasFormat (CF_GIF)
end;

function TEnumFormats.GIF : TGifImage;
var
  Stream : THandleMemStream;
begin
  Result := TGifImage.Create;
  if HasGif then
  try
    Stream := THandleMemStream.Create (GlobalHandle);
    try
      Result.LoadFromStream (Stream)
    finally
      Stream.Free
    end
  finally
    FreeMedium
  end
end;
{$ENDIF}

//--- PALETTE ---
function TEnumFormats.HasPalette : boolean;
begin
  Result := HasFormat (CF_PALETTE)
end;

function TEnumFormats.Palette : hPalette;
begin
  if HasPalette then
    try
      Result := CopyPalette (GDIHandle)  // in graphics.pas, very handy
    finally
      FreeMedium
    end
  else
    Result := 0
end;

//--- METAFILE ---
// Returns a TMetafile containing the metafile, returns an empty
// TMetafile on failure.  Caller has duty to destroy the TMetafile.
// The metafile needs to be converted to a windows enhanced metafile before
// it can be returned as a Delphi TMetafile
function TEnumFormats.Metafile : TMetaFile;
var
  Block : hGlobal;
  BlockData : PMetafilePict;
  MetafileSize : integer;
  TempBits : PChar;
  EnhHandle : hEnhMetafile;
begin
  Result := TMetafile.Create;
  if HasMetafile then
  begin
// get a pointer to the TMetafilePict data passed by the DataObject
    Block := MetafileHandle;
    try
      BlockData := GlobalLock (Block);
      if FMediumValid then
      try
// find out how much storage is needed; allocate memory for it
        MetafileSize := GetMetafileBitsEx (BlockData^.hMF, 0, nil);
        GetMem (TempBits, MetafileSize);
        try
// retrieve the metafile data
          GetMetafileBitsEx (BlockData^.hMF, MetafileSize, TempBits);
// convert the data to an enhanced metafile and obtain a handle to it
          EnhHandle := SetWinMetafileBits (MetafileSize, TempBits, 0, BlockData^)
        finally
          FreeMem (TempBits, MetafileSize)
        end;
// pass the enhanced handle to the TMetafile
        if EnhHandle <> 0 then
          Result.Handle := EnhHandle
      finally
        GlobalUnlock (Block)
      end
    finally
      FreeMedium
    end
  end
end;

// Returns true if the data object contains a MetafilePict
function TEnumFormats.HasMetafile : boolean;
begin
  Result := HasFormat (CF_METAFILEPICT)
end;

//--- ENHANCED METAFILE ---
// Returns a TMetafile containing the enhanced metafile, returns an empty
// metafile on failure.  Caller has duty to destroy the metafile
function TEnumFormats.EnhMetafile : TMetafile;
begin
  Result := TMetafile.Create;
  if HasEnhMetafile then
  try
    Result.Handle := CopyEnhMetafile (EnhMetafileHandle, nil)
  finally
    FreeMedium
  end
end;

// Returns true if the dataobject contains an enhanced metafile
function TEnumFormats.HasEnhMetafile : boolean;
begin
  Result := HasFormat (CF_ENHMETAFILE)
end;

// Returns a TMetafile containing the enhanced metafile, returns an empty
// metafile on failure.  Caller has duty to destroy the metafile
function TEnumFormats.ScreenPicture : TMetafile;
begin
  Result := TMetafile.Create;
  if HasScreenPicture then
  try
    Result.Handle := CopyEnhMetafile (EnhMetafileHandle, nil)
  finally
    FreeMedium
  end
end;

// Returns true if the dataobject contains an enhanced metafile
function TEnumFormats.HasScreenPicture : boolean;
begin
  Result := HasFormat (CF_EMFPICTURE)
end;

//--- Locale ---
function TEnumFormats.Locale : LCID;
var
  H : hGlobal;
  P : PWord;
begin
  Result := 0;
  if HasLocale then
  begin
    H := GlobalHandle;
    if FMediumValid then
    try
      P := GlobalLock (H);
      try
        Result := P^
      finally
        GlobalUnlock (H)
      end
    finally
      FreeMedium
    end
  end
end;

function TEnumFormats.HasLocale : boolean;
begin
  Result := HasFormat (CF_LOCALE)
end;

// Drop Effect
function TEnumFormats.PreferredDropEffect : integer;
var
  H : hGlobal;
  P : PDWord;
begin
  Result := 0;
  if HasPreferredDropEffect then
  begin
    H := GlobalHandle;
    if FMediumValid then
    try
      P := GlobalLock (H);
      try
        Result := P^
      finally
        GlobalUnlock (H)
      end
    finally
      FreeMedium
    end
  end
end;

function TEnumFormats.HasPreferredDropEffect : boolean;
begin
  Result := HasFormat (CF_PREFERREDDROPEFFECT)
end;

//--- URL ---
// Returns a URL item or empty if not present
function TEnumFormats.URL : string;
begin
  if HasFormat (CF_URL) then
    Result := SomeText (CF_URL)
  else
    if HasFormat (CF_NETSCAPE) then
      Result := SomeText (CF_NETSCAPE)
    else
      Result := ''
end;

// Returns true if some text is available
function TEnumFormats.HasURL : boolean;
begin
  Result := HasFormat (CF_URL) or HasFormat (CF_NETSCAPE)
end;


//--- OBJECT DESCRIPTOR ---

function TEnumFormats.ObjectDescriptor : TObjectDescriptor;
begin
  Result := SomeDescriptor (CF_OBJECTDESCRIPTOR)
end;

function TEnumFormats.HasObjectDescriptor : boolean;
begin
  Result := HasFormat (CF_OBJECTDESCRIPTOR)
end;

//--- LINKSRCDESCRIPTOR

function TEnumFormats.LinkDescriptor : TObjectDescriptor;
begin
  Result := SomeDescriptor (CF_LINKSRCDESCRIPTOR)
end;

function TEnumFormats.HasLinkDescriptor : boolean;
begin
  Result := HasFormat (CF_LINKSRCDESCRIPTOR)
end;

//--- LINK SOURCE
function TEnumFormats.LinkSource : IStream;
begin
  if HasLinkSource then
    try
      Result := StreamInterface
    finally
      FreeMedium
    end
  else
    Result := nil
end;

function TEnumFormats.HasLinkSource : boolean;
begin
  Result := HasFormat (CF_LINKSOURCE)
end;

//--- SHELL ID LIST ---
function TEnumFormats.IDList : TStringList;

  procedure AddNameAndPIDL (Root, Relative : PItemIDList);
  var
    Str : string;
    SHFileInfo : TSHFileInfo;
    PIDL : PItemIDList;
  begin
    PIDL := ConcatPIDLs (Root, Relative);
    if Assigned (PIDL) then
    begin
      SetLength (Str, MAX_PATH);
      if SHGetPathFromIDList (PIDL, PChar(Str)) then
        RealizeLength (Str)
      else begin
        SHGetFileInfo (PChar (PIDL), 0, SHFileInfo, SizeOf (TSHFileInfo), SHGFI_PIDL or SHGFI_DISPLAYNAME);
        Str := SHFileInfo.szDisplayName
      end;
      Result.AddObject (Str, pointer (PIDL))
    end
  end;

var
  Block : hGlobal;
  IDA : PIDA;
  Loop : integer;
  PIDL : PItemIDList;
begin
  Result := TStringList.Create;
  if HasIDList then
  begin
    Block := GlobalHandle;
    if FMediumValid then
    try
      IDA := GlobalLock (Block);
      try
// get folder first
        PIDL := PItemIDList (uint (IDA) + IDA^.aoffset [0]);
        AddNameAndPIDL (nil, PIDL);
// loop to get items (horrible code)
{$RANGECHECKS OFF}
        for Loop := 1 to IDA^.cidl do
          AddNameAndPIDL (PIDL, PItemIDList (uint (IDA) + IDA^.aoffset [Loop]))
{$RANGECHECKS ON}
      finally
        GlobalUnlock (Block)
      end
    finally
      FreeMedium
    end
  end
end;

function TEnumFormats.HasIDList : boolean;
begin
  Result := HasFormat (CF_IDLIST)
end;

// Uitility used to free a returned IDList, also correctly frees Objects held
// which are PIDLs
procedure FreeIDList (List : TStringList);
var
  Loop : integer;
begin
  for Loop := List.Count - 1 downto 0 do
    ShellMalloc.Free (PItemIDList (List.Objects [Loop]));
  List.Free
end;

//--- OBJECTPOSITIONS ---

function TEnumFormats.ObjectPositions : TObjectPositions;
var
  Block : hGlobal;
  BlockData : PPoint;
  IDA : PIDA;
  Loop : integer;
begin
  ZeroMemory (@Result, SizeOf (TObjectPositions));
  if HasIDList then
  begin
    Block := GlobalHandle;
    try
      IDA := GlobalLock (Block);
      try
        Result.Count := IDA^.cidl
      finally
        GlobalUnlock (Block)
      end
    finally
      FreeMedium
    end
  end else
    Result.Count := 0;

  if HasObjectPositions and (Result.Count > 0) then
  begin
    Block := GlobalHandle;
    try
      BlockData := GlobalLock (Block);
      try
        Result.Group := BlockData^;
        inc (BlockData);
        SetLength (Result.Offsets, Result.Count);
        for Loop := 0 to Result.Count - 1 do
        begin
          Result.Offsets[Loop] := BlockData^;
          inc (BlockData)
        end
      finally
        GlobalUnlock (Block)
      end
    finally
      FreeMedium
    end
  end
end;

function TEnumFormats.HasObjectPositions : boolean;
begin
  Result := HasFormat (CF_OBJECTPOSITIONS)
end;

//--- FILE DESCRIPTORS
// NB - this function is untested
function TEnumFormats.FileDescriptors : TStringList;
var
  Block : hGlobal;