unit DropBMPTarget;

// -----------------------------------------------------------------------------
// Project:         Drag and Drop Component Suite
// Component Names: TDropBMPSource
// Module:          DropBMPSource
// Description:     Implements Dragging & Dropping of Bitmaps
//                  FROM your application to another.
// Version:         3.7
// Date:            22-JUL-1999
// Target:          Win32, Delphi 3 - Delphi 5, C++ Builder 3, C++ Builder 4
// Authors:         Angus Johnson,   ajohnson@rpi.net.au
//                  Anders Melander, anders@melander.dk
//                                   http://www.melander.dk
// Copyright        © 1997-99 Angus Johnson & Anders Melander
// -----------------------------------------------------------------------------

interface

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

{$include DragDrop.inc}

type
  TDropBMPTarget = class(TDropTarget)
  private
    fBitmap: TBitmap;
  protected
    procedure ClearData; override;
    function DoGetData: boolean; override;
    function HasValidFormats: boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Bitmap: TBitmap Read fBitmap;
  end;

procedure Register;
procedure CopyDIBToBitmap(Bitmap: TBitmap; BitmapInfo: PBitmapInfo; DIBSize: integer);

implementation

const
  DIBFormatEtc: TFormatEtc = (cfFormat: CF_DIB;
    ptd: nil; dwAspect: DVASPECT_CONTENT; lindex: -1; tymed: TYMED_HGLOBAL);
  BMPFormatEtc: TFormatEtc = (cfFormat: CF_BITMAP;
    ptd: nil; dwAspect: DVASPECT_CONTENT; lindex: -1; tymed: TYMED_GDI);
  PalFormatEtc: TFormatEtc = (cfFormat: CF_PALETTE;
    ptd: nil; dwAspect: DVASPECT_CONTENT; lindex: -1; tymed: TYMED_GDI);

procedure Register;
begin
  RegisterComponents('DragDrop', [TDropBMPTarget]);
end;

// -----------------------------------------------------------------------------
//	Miscellaneous DIB Function
// -----------------------------------------------------------------------------

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;

// -----------------------------------------------------------------------------
//			TDropBMPTarget
// -----------------------------------------------------------------------------

constructor TDropBMPTarget.Create( AOwner: TComponent );
begin
   inherited Create( AOwner );
   fBitmap := TBitmap.Create;
end;
// -----------------------------------------------------------------------------

destructor TDropBMPTarget.Destroy;
begin
  fBitmap.Free;
  inherited Destroy;
end;
// ----------------------------------------------------------------------------- 

function TDropBMPTarget.HasValidFormats: boolean;
begin
  result := (DataObject.QueryGetData(DIBFormatEtc) = S_OK) or
                (DataObject.QueryGetData(BMPFormatEtc) = S_OK);
end;
// ----------------------------------------------------------------------------- 

procedure TDropBMPTarget.ClearData;
begin
  fBitmap.handle := 0;
end;
// ----------------------------------------------------------------------------- 

function TDropBMPTarget.DoGetData: boolean;
var
  medium, medium2: TStgMedium;
  DIBData: pointer;
begin
  result := false;
  //--------------------------------------------------------------------------
  if (DataObject.GetData(DIBFormatEtc, medium) = S_OK) then
  begin
    if (medium.tymed = TYMED_HGLOBAL) then
    begin
      DIBData := GlobalLock(medium.HGlobal);
      try
        CopyDIBToBitmap(fBitmap, DIBData, GlobalSize(Medium.HGlobal));
        result := true;
      finally
        GlobalUnlock(medium.HGlobal);
      end;
    end;
    ReleaseStgMedium(medium);
  end
  //--------------------------------------------------------------------------
  else if (DataObject.GetData(BMPFormatEtc, medium) = S_OK) then
  begin
    try
      if (medium.tymed <> TYMED_GDI) then exit;
      if (DataObject.GetData(PalFormatEtc, medium2) = S_OK) then
      begin
        try
          fBitmap.LoadFromClipboardFormat(CF_BITMAP, Medium.hBitmap, Medium2.hBitmap);
        finally
          ReleaseStgMedium(medium2);
        end;
      end
      else
        fBitmap.LoadFromClipboardFormat(CF_BITMAP, Medium.hBitmap, 0);
      result := true;
    finally
      ReleaseStgMedium(medium);
    end;
  end
  //--------------------------------------------------------------------------
  else
    result := false;
end;
// ----------------------------------------------------------------------------- 
// ----------------------------------------------------------------------------- 

end.
