| 0,0 → 1,182 |
|---|
| 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. |