RealICQClient/Includes/DRAGDROP/Components/DragDropGraphics.pas

unit DragDropGraphics;

// -----------------------------------------------------------------------------
// Project:         Drag and Drop Component Suite.
// Module:          DragDropGraphics
// Description:     Implements Dragging and Dropping of graphic data.
// Version:         4.0
// Date:            18-MAY-2001
// Target:          Win32, Delphi 5-6
// Authors:         Anders Melander, anders@melander.dk, http://www.melander.dk
// Copyright        © 1997-2001 Angus Johnson & Anders Melander
// -----------------------------------------------------------------------------

interface

uses
  DragDrop,
  DropTarget,
  DropSource,
  ActiveX,
  Windows,
  Graphics,
  Classes;

{$include DragDrop.inc}

type
////////////////////////////////////////////////////////////////////////////////
//
//		TGDIClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
// Base class for GDI clipboard formats (TYMED_GDI).
////////////////////////////////////////////////////////////////////////////////
  TGDIClipboardFormat = class(TClipboardFormat)
  public
    constructor Create; override;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TPaletteClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
// Only used internally by TBitmapClipboardFormat - Not registered
////////////////////////////////////////////////////////////////////////////////
  TPaletteClipboardFormat = class(TGDIClipboardFormat)
  private
    FPalette		: hPalette;
  public
    function GetClipboardFormat: TClipFormat; override;
    function DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean; override;
    function DoSetData(const FormatEtcIn: TFormatEtc;
      var Medium: TStgMedium): boolean; override;
    procedure Clear; override;
    property Palette: hPalette read FPalette write FPalette;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TCustomBitmapClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
  TCustomBitmapClipboardFormat = class(TGDIClipboardFormat)
  private
    FBitmap		: TBitmap;
  protected
    constructor CreateFormat(Atymed: Longint); override;
  public
    destructor Destroy; override;
    procedure Clear; override;
    property Bitmap: TBitmap read FBitmap;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TBitmapClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
  TBitmapClipboardFormat = class(TCustomBitmapClipboardFormat)
  protected
    function DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean; override;
    function DoSetData(const FormatEtcIn: TFormatEtc;
      var AMedium: TStgMedium): boolean; override;
  public
    function GetClipboardFormat: TClipFormat; override;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TDIBClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
  TDIBClipboardFormat = class(TCustomBitmapClipboardFormat)
  private
  protected
    function DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean; override;
    function DoSetData(const FormatEtcIn: TFormatEtc;
      var AMedium: TStgMedium): boolean; override;
  public
    constructor Create; override;
    function GetClipboardFormat: TClipFormat; override;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TCustomMetaFileClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
  TCustomMetaFileClipboardFormat = class(TClipboardFormat)
  private
    FMetaFile		: TMetaFile;
  protected
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Clear; override;
    property MetaFile: TMetaFile read FMetaFile;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TMetaFileClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
  TMetaFileClipboardFormat = class(TCustomMetaFileClipboardFormat)
  private
  protected
    function DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean; override;
  public
    function GetClipboardFormat: TClipFormat; override;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TEnhMetaFileClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
  TEnhMetaFileClipboardFormat = class(TCustomMetaFileClipboardFormat)
  private
  protected
    function DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean; override;
  public
    function GetClipboardFormat: TClipFormat; override;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TBitmapDataFormat
//
////////////////////////////////////////////////////////////////////////////////
  TBitmapDataFormat = class(TCustomDataFormat)
  private
    FBitmap		: TBitmap;
  protected
  public
    constructor Create(AOwner: TDragDropComponent); override;
    destructor Destroy; override;
    function Assign(Source: TClipboardFormat): boolean; override;
    function AssignTo(Dest: TClipboardFormat): boolean; override;
    procedure Clear; override;
    function HasData: boolean; override;
    function NeedsData: boolean; override;
    property Bitmap: TBitmap read FBitmap;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TMetaFileDataFormat
//
////////////////////////////////////////////////////////////////////////////////
  TMetaFileDataFormat = class(TCustomDataFormat)
  private
    FMetaFile		: TMetaFile;
  protected
  public
    constructor Create(AOwner: TDragDropComponent); override;
    destructor Destroy; override;
    function Assign(Source: TClipboardFormat): boolean; override;
    procedure Clear; override;
    function HasData: boolean; override;
    function NeedsData: boolean; override;
    property MetaFile: TMetaFile read FMetaFile;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TDropBMPTarget
//
////////////////////////////////////////////////////////////////////////////////
  TDropBMPTarget = class(TCustomDropMultiTarget)
  private
    FBitmapFormat	: TBitmapDataFormat;
  protected
    function GetBitmap: TBitmap;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Bitmap: TBitmap read GetBitmap;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TDropBMPSource
//
////////////////////////////////////////////////////////////////////////////////
  TDropBMPSource = class(TCustomDropMultiSource)
  private
    FBitmapFormat	: TBitmapDataFormat;
  protected
    procedure SetBitmap(const Value: TBitmap);
    function GetBitmap: TBitmap;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Bitmap: TBitmap read GetBitmap write SetBitmap;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TDropMetaFileTarget
//
////////////////////////////////////////////////////////////////////////////////
  TDropMetaFileTarget = class(TCustomDropMultiTarget)
  private
    FMetaFileFormat	: TMetaFileDataFormat;
  protected
    function GetMetaFile: TMetaFile;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property MetaFile: TMetaFile read GetMetaFile;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		TDropImageTarget
//
////////////////////////////////////////////////////////////////////////////////
  TDropImageTarget = class(TCustomDropMultiTarget)
  private
    FMetaFileFormat	: TMetaFileDataFormat;
    FBitmapFormat	: TBitmapDataFormat;
    FPicture		: TPicture;
  protected
    function DoGetData: boolean; override;
    procedure ClearData; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Picture: TPicture read FPicture;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//		Component registration
//
////////////////////////////////////////////////////////////////////////////////
procedure Register;


////////////////////////////////////////////////////////////////////////////////
//
//		Misc.
//
////////////////////////////////////////////////////////////////////////////////
procedure CopyDIBToBitmap(Bitmap: TBitmap; BitmapInfo: PBitmapInfo; DIBSize: integer);
function GetHGlobalDIBFromBitmap(Bitmap: TBitmap): HGlobal;


////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
//
//			IMPLEMENTATION
//
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
implementation

uses
  SysUtils;

////////////////////////////////////////////////////////////////////////////////
//
//		Component registration
//
////////////////////////////////////////////////////////////////////////////////
procedure Register;
begin
  RegisterComponents(DragDropComponentPalettePage, [TDropBMPTarget,
    TDropBMPSource, TDropMetaFileTarget, TDropImageTarget]);
end;


////////////////////////////////////////////////////////////////////////////////
//
//		Misc.
//
////////////////////////////////////////////////////////////////////////////////
procedure CopyDIBToBitmap(Bitmap: TBitmap; BitmapInfo: PBitmapInfo; DIBSize: integer);
var
  BitmapFileHeader	: TBitmapFileHeader;
  FileSize		: integer;
  InfoSize		: integer;
  Stream		: TMemoryStream;
begin
  // Write DIB to a stream in the BMP file format
  Stream := TMemoryStream.Create;
  try
    FileSize := sizeof(TBitmapFileHeader) + DIBSize;
    InfoSize := sizeof(TBitmapInfoHeader);
    if (BitmapInfo^.bmiHeader.biBitCount > 8) then
    begin
      if ((BitmapInfo^.bmiHeader.biCompression and BI_BITFIELDS) <> 0) then
        Inc(InfoSize, 12);
    end else
      Inc(InfoSize, sizeof(TRGBQuad) * (1 shl BitmapInfo^.bmiHeader.biBitCount));
    Stream.SetSize(FileSize);
    // Initialize file header
    FillChar(BitmapFileHeader, sizeof(TBitmapFileHeader), 0);
    with BitmapFileHeader do
    begin
      bfType := $4D42; // 'BM' = Windows BMP signature
      bfSize := FileSize; // File size (not needed)
      bfOffBits := sizeof(TBitmapFileHeader) + InfoSize; // Offset of pixel data
    end;
    // Save file header
    Stream.Write(BitmapFileHeader, sizeof(TBitmapFileHeader));
    // Save TBitmapInfo structure and pixel data
    Stream.Write(BitmapInfo^, DIBSize);

    // Rewind and load bitmap from stream
    Stream.Position := 0;
    Bitmap.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

function GetHGlobalDIBFromBitmap(Bitmap: TBitmap): HGlobal;
var
  Stream		: TMemoryStream;
  DIB			: pointer;
  DIBSize		: integer;
begin
  Stream := TMemoryStream.Create;
  try
    // Write bitmap to a stream and extract the DIB data from it.
    Bitmap.SaveToStream(Stream);

    // Calculate size of DIB block.
    DIBSize := Stream.Size - SizeOf(TBitmapFileHeader);

    // Allocate memory for DIB data.
    Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE, DIBSize);
    if (Result = 0) then
      exit;

    DIB := GlobalLock(Result);
    if DIB = nil then
    begin
      GlobalFree(Result);
      Result := 0;
    end else
    begin
      // Skip BMP file header.
      Stream.Seek(SizeOf(TBitmapFileHeader), soFromBeginning);
      // Transfer data from stream to global memory.
      if (Stream.Read(DIB^, DIBSize) <> DIBSize) then
      begin
        GlobalUnlock(Result);
        GlobalFree(Result);
        Result := 0;
      end else
        GlobalUnlock(Result);
    end;
  finally
    Stream.free;
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TGDIClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
constructor TGDIClipboardFormat.Create;
begin
  CreateFormat(TYMED_GDI);
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TPaletteClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
function TPaletteClipboardFormat.GetClipboardFormat: TClipFormat;
begin
  Result := CF_PALETTE;
end;

procedure TPaletteClipboardFormat.Clear;
begin
  if (FPalette <> 0) then
  begin
    DeleteObject(FPalette);
    FPalette := 0;
  end;
end;

function TPaletteClipboardFormat.DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean;
begin
  if (AMedium.hBitmap <> 0) then
  begin
    FPalette := CopyPalette(AMedium.hBitmap);
    Result := (FPalette <> 0);
  end else
    Result := False;
end;

function TPaletteClipboardFormat.DoSetData(const FormatEtcIn: TFormatEtc;
  var Medium: TStgMedium): boolean;
begin
  Result := False;

  try
    Medium.hBitmap := CopyPalette(FPalette);
  except
    exit;
  end;

  if (Medium.hBitmap <> 0) then
  begin
    Medium.tymed := TYMED_GDI;
    result := True;
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TBitmapClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
constructor TCustomBitmapClipboardFormat.CreateFormat(Atymed: Longint);
begin
  inherited CreateFormat(Atymed);

  FBitmap := Graphics.TBitmap.Create;
end;

destructor TCustomBitmapClipboardFormat.Destroy;
begin
  if (FBitmap <> nil) then
    FBitmap.Free;

  inherited Destroy;
end;

procedure TCustomBitmapClipboardFormat.Clear;
begin
  FBitmap.Handle := 0;
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TBitmapClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
function TBitmapClipboardFormat.GetClipboardFormat: TClipFormat;
begin
  Result := CF_BITMAP;
end;

function TBitmapClipboardFormat.DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean;
var
  Palette		: TPaletteClipboardFormat;
begin
  Result := False;
  if (AMedium.hBitmap = 0) then
    exit;
  Palette := TPaletteClipboardFormat.Create;
  try
    // Attempt to get palette from source. However in case the bitmap is in a
    // format which doesn't use palettes, there might not be one available.
    // The CF_BITMAP/CF_PALETTE documentation doesn't mention if CF_BITMAP must
    // always be accompanied with a CF_PALETTE.
    Palette.GetData(ADataObject);
    // Let TBitmap do the work for us.
    FBitmap.LoadFromClipboardFormat(CF_BITMAP, AMedium.hBitmap, Palette.Palette);
  finally
    Palette.Free;
  end;
  Result := True;
end;

function TBitmapClipboardFormat.DoSetData(const FormatEtcIn: TFormatEtc;
  var AMedium: TStgMedium): boolean;
var
  Palette		: HPalette;
  Format		: Word;
  hBitmap		: THandle;
begin
  Result := False;

  try
    Format := CF_BITMAP;
    FBitmap.SaveToClipboardFormat(Format, hBitmap, Palette);
    AMedium.hBitmap := hBitmap;
  except
    exit;
  end;

  try
    if (Format <> CF_BITMAP) then
    begin
      DeleteObject(AMedium.hBitmap);
      AMedium.hBitmap := 0;
      exit;
    end;
    AMedium.tymed := TYMED_GDI;
  finally
    DeleteObject(Palette);
  end;
  Result := True;
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TDIBClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
constructor TDIBClipboardFormat.Create;
begin
  // Note: We must override Create since base class Create sets tymed to
  // TYMED_GDI. 
  CreateFormat(TYMED_HGLOBAL);
end;

function TDIBClipboardFormat.GetClipboardFormat: TClipFormat;
begin
  Result := CF_DIB;
end;

// http://x5.dejanews.com/[ST_rn=ps]/getdoc.xp?AN=382056726.2&CONTEXT=925473183.2090336317&hitnum=0
function TDIBClipboardFormat.DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean;
var
  BitmapInfo		: PBitmapInfo;
  BitmapFileHeader	: TBitmapFileHeader;
  DIBSize		: integer;
  FileSize		: integer;
  InfoSize		: integer;
  Stream		: TMemoryStream;
begin
  // Get data source's DIB block
  BitmapInfo := GlobalLock(AMedium.HGlobal);
  try
    Result := (BitmapInfo <> nil);
    if (not Result) then
      exit;

    // Write DIB to a stream in the BMP file format
    Stream := TMemoryStream.Create;
    try
      // Get size of data source's DIB block
      DIBSize := GlobalSize(AMedium.HGlobal);
      // Calculate total bitmap file size
      FileSize := sizeof(TBitmapFileHeader) + DIBSize;
      // Calculate bitmap header size
      InfoSize := sizeof(TBitmapInfoHeader);
      if (BitmapInfo^.bmiHeader.biBitCount > 8) then
      begin
        if ((BitmapInfo^.bmiHeader.biCompression and BI_BITFIELDS) <> 0) then
          Inc(InfoSize, 12);
      end else
        Inc(InfoSize, sizeof(TRGBQuad) * (1 shl BitmapInfo^.bmiHeader.biBitCount));

      Stream.SetSize(FileSize);
      // Initialize file header
      FillChar(BitmapFileHeader, sizeof(TBitmapFileHeader), 0);
      with BitmapFileHeader do
      begin
        bfType := $4D42; // 'BM' = Windows BMP signature
        bfSize := FileSize; // File size (not needed)
        bfOffBits := sizeof(TBitmapFileHeader) + InfoSize; // Offset of pixel data
      end;
      // Save file header
      Stream.Write(BitmapFileHeader, sizeof(TBitmapFileHeader));
      // Save TBitmapInfo structure and pixel data
      Stream.Write(BitmapInfo^, DIBSize);

      // Rewind and load bitmap from stream
      Stream.Position := 0;
      FBitmap.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
  finally
    GlobalUnlock(AMedium.HGlobal);
  end;
end;

function TDIBClipboardFormat.DoSetData(const FormatEtcIn: TFormatEtc;
  var AMedium: TStgMedium): boolean;
begin
  AMedium.hBitmap := GetHGlobalDIBFromBitmap(FBitmap);
  Result := (AMedium.hBitmap <> 0);
  if (Result) then
    AMedium.tymed := TYMED_HGLOBAL;
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TCustomMetaFileClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
constructor TCustomMetaFileClipboardFormat.Create;
begin
  CreateFormat(TYMED_MFPICT);
  FMetaFile := TMetaFile.Create;
end;

destructor TCustomMetaFileClipboardFormat.Destroy;
begin
  if (FMetaFile <> nil) then
    FMetaFile.Free;
  inherited Destroy;
end;

procedure TCustomMetaFileClipboardFormat.Clear;
begin
  FMetaFile.Clear;
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TMetaFileClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
function TMetaFileClipboardFormat.GetClipboardFormat: TClipFormat;
begin
  Result := CF_METAFILEPICT;
end;

function WMF2EMF(const MetaFile: TMetaFilePict): hEnhMetaFile;
var
  Bits		: Pointer;
  Length	: UINT;
  RefDC		: HDC;
begin
  Length := GetMetaFileBitsEx(MetaFile.hMF, 0, nil);
  if (Length = 0) then
    _RaiseLastWin32Error;
  GetMem(Bits, Length);
  try
    if (GetMetaFileBitsEx(MetaFile.hMF, Length, Bits) < Length) then
      _RaiseLastWin32Error;
    RefDC := GetDC(0);
    try
        Result := SetWinMetaFileBits(Length, Bits, RefDC, MetaFile);
    finally
      ReleaseDC(0, RefDC);
    end;
    if (Result = 0) then
      _RaiseLastWin32Error;
  finally
    FreeMem(Bits);
  end;
end;

function TMetaFileClipboardFormat.DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean;
var
  pMetaFile		: PMetaFilePict;
begin
  pMetaFile := GlobalLock(AMedium.hMetaFilePict);
  try
    Result := (pMetaFile <> nil);
    if (Result) then
      FMetaFile.Handle := WMF2EMF(pMetaFile^);
  finally
    GlobalUnlock(AMedium.hMetaFilePict);
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TEnhMetaFileClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
function TEnhMetaFileClipboardFormat.GetClipboardFormat: TClipFormat;
begin
  Result := CF_ENHMETAFILE;
end;

function TEnhMetaFileClipboardFormat.DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean;
begin
  Result := (AMedium.hEnhMetaFile <> 0);
  if (Result) then
    FMetaFile.Handle := CopyEnhMetafile(AMedium.hEnhMetaFile, nil);
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TBitmapDataFormat
//
////////////////////////////////////////////////////////////////////////////////
constructor TBitmapDataFormat.Create(AOwner: TDragDropComponent);
begin
  inherited Create(AOwner);
  FBitmap := TBitmap.Create;
  // TGraphic.OnChange is fired too late (after change), but it's the best
  // we can get.
  FBitmap.OnChange := DoOnChanging;
end;

destructor TBitmapDataFormat.Destroy;
begin
  Clear;
  FBitmap.Free;
  inherited Destroy;
end;

function TBitmapDataFormat.Assign(Source: TClipboardFormat): boolean;
begin
  Result := True;

  if (Source is TDIBClipboardFormat) then
    FBitmap.Assign(TDIBClipboardFormat(Source).Bitmap)

  else if (Source is TBitmapClipboardFormat) then
    FBitmap.Assign(TBitmapClipboardFormat(Source).Bitmap)

  // TODO -oanme : Is this nescessary? Palette is extracted in TBitmapClipboardFormat GetData.
  else if (Source is TPaletteClipboardFormat) then
    FBitmap.Palette := CopyPalette(TPaletteClipboardFormat(Source).Palette)

  else
    Result := inherited Assign(Source);
end;

function TBitmapDataFormat.AssignTo(Dest: TClipboardFormat): boolean;
begin
  Result := True;

  if (Dest is TDIBClipboardFormat) then
    TDIBClipboardFormat(Dest).Bitmap.Assign(FBitmap)

  else if (Dest is TBitmapClipboardFormat) then
    TBitmapClipboardFormat(Dest).Bitmap.Assign(FBitmap)

  else if (Dest is TPaletteClipboardFormat) then
    TPaletteClipboardFormat(Dest).Palette := CopyPalette(FBitmap.Palette)

  else
    Result := inherited AssignTo(Dest);
end;

procedure TBitmapDataFormat.Clear;
begin
  Changing;
  FBitmap.Handle := 0;
end;

function TBitmapDataFormat.HasData: boolean;
begin
  Result := (not FBitmap.Empty);
end;

function TBitmapDataFormat.NeedsData: boolean;
begin
  Result := (FBitmap.Empty);
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TMetaFileDataFormat
//
////////////////////////////////////////////////////////////////////////////////
constructor TMetaFileDataFormat.Create(AOwner: TDragDropComponent);
begin
  inherited Create(AOwner);
  FMetaFile := TMetaFile.Create;
  // TGraphic.OnChange is fired too late (after change), but it's the best
  // we can get.
  FMetaFile.OnChange := DoOnChanging;
end;

destructor TMetaFileDataFormat.Destroy;
begin
  Clear;
  FMetaFile.Free;
  inherited Destroy;
end;

function TMetaFileDataFormat.Assign(Source: TClipboardFormat): boolean;
begin
  Result := True;

  if (Source is TMetaFileClipboardFormat) then
    FMetaFile.Assign(TMetaFileClipboardFormat(Source).MetaFile)

  else if (Source is TEnhMetaFileClipboardFormat) then
    FMetaFile.Assign(TEnhMetaFileClipboardFormat(Source).MetaFile)

  else
    Result := inherited Assign(Source);
end;

procedure TMetaFileDataFormat.Clear;
begin
  Changing;
  FMetaFile.Clear;
end;

function TMetaFileDataFormat.HasData: boolean;
begin
  Result := (FMetaFile.Handle <> 0);
end;

function TMetaFileDataFormat.NeedsData: boolean;
begin
  Result := (FMetaFile.Handle = 0);
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TDropBMPTarget
//
////////////////////////////////////////////////////////////////////////////////
constructor TDropBMPTarget.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBitmapFormat := TBitmapDataFormat.Create(Self);
end;

destructor TDropBMPTarget.Destroy;
begin
  FBitmapFormat.Free;
  inherited Destroy;
end;

function TDropBMPTarget.GetBitmap: TBitmap;
begin
  Result := FBitmapFormat.Bitmap;
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TDropBMPSource
//
////////////////////////////////////////////////////////////////////////////////
constructor TDropBMPSource.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  DragTypes := [dtCopy]; // Default to Copy

  FBitmapFormat := TBitmapDataFormat.Create(Self);
end;

destructor TDropBMPSource.destroy;
begin
  FBitmapFormat.Free;
  inherited Destroy;
end;

function TDropBMPSource.GetBitmap: TBitmap;
begin
  Result := FBitmapFormat.Bitmap;
end;

procedure TDropBMPSource.SetBitmap(const Value: TBitmap);
begin
  FBitmapFormat.Bitmap.Assign(Value);
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TDropMetaFileTarget
//
////////////////////////////////////////////////////////////////////////////////
constructor TDropMetaFileTarget.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMetaFileFormat := TMetaFileDataFormat.Create(Self);
end;

destructor TDropMetaFileTarget.Destroy;
begin
  FMetaFileFormat.Free;
  inherited Destroy;
end;

function TDropMetaFileTarget.GetMetaFile: TMetaFile;
begin
  Result := FMetaFileFormat.MetaFile;
end;


////////////////////////////////////////////////////////////////////////////////
//
//		TDropMetaFileTarget
//
////////////////////////////////////////////////////////////////////////////////
constructor TDropImageTarget.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMetaFileFormat := TMetaFileDataFormat.Create(Self);
  FBitmapFormat := TBitmapDataFormat.Create(Self);
  FPicture := TPicture.Create;
end;

destructor TDropImageTarget.Destroy;
begin
  FPicture.Free;
  FBitmapFormat.Free;
  FMetaFileFormat.Free;
  inherited Destroy;
end;

procedure TDropImageTarget.ClearData;
begin
  inherited ClearData;
  FPicture.Assign(nil);
end;

function TDropImageTarget.DoGetData: boolean;
begin
  Result := inherited DoGetData;
  if (Result) then
  begin
    if (FBitmapFormat.HasData) then
      FPicture.Assign(FBitmapFormat.Bitmap)
    else if (FMetaFileFormat.HasData) then
      FPicture.Assign(FMetaFileFormat.MetaFile)
    else
      Result := False;
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
//		Initialization/Finalization
//
////////////////////////////////////////////////////////////////////////////////

initialization
  // Data format registration
  TBitmapDataFormat.RegisterDataFormat;
  TMetaFileDataFormat.RegisterDataFormat;
  // Clipboard format registration
  TBitmapDataFormat.RegisterCompatibleFormat(TDIBClipboardFormat, 0, csSourceTarget, [ddRead]);
  TBitmapDataFormat.RegisterCompatibleFormat(TBitmapClipboardFormat, 1, csSourceTarget, [ddRead]);
  TBitmapDataFormat.RegisterCompatibleFormat(TPaletteClipboardFormat, 1, csSourceTarget, [ddRead]);
  TMetaFileDataFormat.RegisterCompatibleFormat(TEnhMetaFileClipboardFormat, 0, [csTarget], [ddRead]);
  TMetaFileDataFormat.RegisterCompatibleFormat(TMetaFileClipboardFormat, 1, [csTarget], [ddRead]);

finalization
  // It is not nescessary to unregister *both* the TClipboardFormats and
  // the TTargetFormat, but we do it here to demo how the unregister
  // methods are used.

  // Clipboard format unregistration
  TDIBClipboardFormat.UnregisterClipboardFormat;
  TBitmapClipboardFormat.UnregisterClipboardFormat;
  TPaletteClipboardFormat.UnregisterClipboardFormat;
  TEnhMetaFileClipboardFormat.UnregisterClipboardFormat;
  TMetaFileClipboardFormat.UnregisterClipboardFormat;

  // Target format unregistration
  TBitmapDataFormat.UnregisterDataFormat;
  TMetaFileDataFormat.UnregisterDataFormat;
end.