0,0 → 1,213 |
unit DropBMPSource; |
|
// ----------------------------------------------------------------------------- |
// 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 |
// ----------------------------------------------------------------------------- |
// Acknowledgements: |
// Thanks to Dieter Steinwedel for some help with DIBs. |
// http://godard.oec.uni-osnabrueck.de/student_home/dsteinwe/delphi/DietersDelphiSite.htm |
// ----------------------------------------------------------------------------- |
|
interface |
|
uses |
DropSource, |
Classes, Graphics, ActiveX; |
|
{$include DragDrop.inc} |
|
type |
TDropBMPSource = class(TDropSource) |
private |
fBitmap: TBitmap; |
procedure SetBitmap(Bmp: TBitmap); |
protected |
function DoGetData(const FormatEtcIn: TFormatEtc; OUT Medium: TStgMedium):HRESULT; Override; |
public |
constructor Create(aOwner: TComponent); Override; |
destructor Destroy; Override; |
function CutOrCopyToClipboard: boolean; Override; |
published |
property Bitmap: TBitmap Read fBitmap Write SetBitmap; |
end; |
|
procedure Register; |
|
implementation |
|
uses |
Windows, |
SysUtils, |
ClipBrd; |
|
procedure Register; |
begin |
RegisterComponents('DragDrop', [TDropBMPSource]); |
end; |
|
// ----------------------------------------------------------------------------- |
// Miscellaneous DIB Function |
// ----------------------------------------------------------------------------- |
|
function GetHGlobalDIBFromBitmap(Bitmap: Graphics.TBitmap): HGlobal; |
var |
Stream: TMemoryStream; |
DIB: pointer; |
DIBSize: integer; |
bfh: TBitmapFileHeader; |
begin |
Stream := TMemoryStream.Create; |
try |
//let Graphics.pas do the work... |
Bitmap.SaveToStream(Stream); |
//BitmapFileHeader will be discarded |
DIBSize := Stream.Size - sizeof(TBitmapFileHeader); |
Result:=GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT or GMEM_SHARE, DIBSize); |
if Result = 0 then exit; |
DIB := GlobalLock(Result); |
if DIB = nil then |
begin |
GlobalFree(Result); |
Result := 0; |
end else |
begin |
Stream.Seek(0,soFromBeginning); |
//skip BitmapFileHeader... |
Stream.readbuffer(bfh,sizeof(TBitmapFileHeader)); |
//copy data... |
Stream.readbuffer(DIB^,DIBSize); |
GlobalUnlock(Result); |
end; |
finally |
Stream.free; |
end; |
end; |
|
// ----------------------------------------------------------------------------- |
// TDropBMPSource |
// ----------------------------------------------------------------------------- |
|
constructor TDropBMPSource.Create(aOwner: TComponent); |
begin |
inherited Create(aOwner); |
fBitmap := Graphics.TBitmap.Create; |
DragTypes := [dtCopy]; // Default to Copy |
|
AddFormatEtc(CF_BITMAP, NIL, DVASPECT_CONTENT, -1, TYMED_GDI); |
AddFormatEtc(CF_PALETTE, NIL, DVASPECT_CONTENT, -1, TYMED_GDI); |
AddFormatEtc(CF_DIB, NIL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL); |
end; |
// ----------------------------------------------------------------------------- |
|
destructor TDropBMPSource.destroy; |
begin |
fBitmap.Free; |
inherited Destroy; |
end; |
// ----------------------------------------------------------------------------- |
|
procedure TDropBMPSource.SetBitmap(Bmp: Graphics.TBitmap); |
begin |
fBitmap.assign(Bmp); |
end; |
// ----------------------------------------------------------------------------- |
|
function TDropBMPSource.CutOrCopyToClipboard: boolean; |
var |
data: HGlobal; |
begin |
result := false; |
if fBitmap.empty then exit; |
try |
data := GetHGlobalDIBFromBitmap(fBitmap); |
if data = 0 then exit; |
Clipboard.SetAsHandle(CF_DIB,data); |
result := true; |
except |
raise Exception.create('Unable to copy BMP to clipboard.'); |
end; |
end; |
// ----------------------------------------------------------------------------- |
|
function TDropBMPSource.DoGetData(const FormatEtcIn: TFormatEtc; OUT Medium: TStgMedium):HRESULT; |
var |
fmt: WORD; |
pal: HPALETTE; |
begin |
|
Medium.tymed := 0; |
Medium.UnkForRelease := nil; |
Medium.HGlobal := 0; |
//-------------------------------------------------------------------------- |
if not fBitmap.empty and |
(FormatEtcIn.cfFormat = CF_DIB) and |
(FormatEtcIn.dwAspect = DVASPECT_CONTENT) and |
(FormatEtcIn.tymed and TYMED_HGLOBAL <> 0) then |
begin |
try |
Medium.HGlobal := GetHGlobalDIBFromBitmap(fBitmap); |
if Medium.HGlobal <> 0 then |
begin |
Medium.tymed := TYMED_HGLOBAL; |
result := S_OK |
end else |
result := E_OUTOFMEMORY; |
except |
result := E_OUTOFMEMORY; |
end; |
end |
//-------------------------------------------------------------------------- |
else if not fBitmap.empty and |
(FormatEtcIn.cfFormat = CF_BITMAP) and |
(FormatEtcIn.dwAspect = DVASPECT_CONTENT) and |
(FormatEtcIn.tymed and TYMED_GDI <> 0) then |
begin |
try |
//This next line just gets a copy of the bitmap handle... |
fBitmap.SaveToClipboardFormat(fmt, THandle(Medium.hBitmap), pal); |
if pal <> 0 then DeleteObject(pal); |
if Medium.hBitmap <> 0 then |
begin |
Medium.tymed := TYMED_GDI; |
result := S_OK |
end else |
result := E_OUTOFMEMORY; |
except |
result := E_OUTOFMEMORY; |
end; |
end |
//-------------------------------------------------------------------------- |
else if not fBitmap.empty and |
(FormatEtcIn.cfFormat = CF_PALETTE) and |
(FormatEtcIn.dwAspect = DVASPECT_CONTENT) and |
(FormatEtcIn.tymed and TYMED_GDI <> 0) then |
begin |
try |
Medium.hBitmap := CopyPalette(fBitmap.palette); |
if Medium.hBitmap <> 0 then |
begin |
Medium.tymed := TYMED_GDI; |
result := S_OK |
end else |
result := E_OUTOFMEMORY; |
except |
result := E_OUTOFMEMORY; |
end {try} |
end else |
result := DV_E_FORMATETC; |
end; |
// ----------------------------------------------------------------------------- |
// ----------------------------------------------------------------------------- |
|
end. |