One of the various things not yet implemented in FireMonkey is TClipboard. In FMX.Platform you can find routines for getting and setting text on the clipboard (using Variant arguments – I’ve no idea either), but nothing beyond that. On the forums, Mehmed Ali Caliskan posted some code (apparently inspired by those FMX.Platform methods) for saving the contents of a TBitmap to the clipboard on the Mac. Starting with that, I’ve come up with some routines for copying and pasting FMX bitmap contents to the clipboard on both OS X and Windows. These routines have the following signatures:
function CanPasteBitmapFromClipboard: Boolean; procedure CopyBitmapToClipboard(Bitmap: TBitmap); function PasteBitmapFromClipboard(Bitmap: TBitmap): Boolean;
Before I present the code, it is worth taking a step back to highlight how TBitmap in FireMonkey covers the ground of both TPicture and TBitmap in the VCL. As a result, instead of having different TGraphic descendants for different sorts of bitmap formats (TBitmap for BMP, TJpegImage for JPEG, TPngImage for PNG, TWicImage for TIFF), there’s just TBitmap which can load from – and save to – a range of formats. Another difference with the VCL is that there’s no FMX.Graphics unit – instead, both TBitmap and TCanvas are declared in FMX.Types.
The first task is to identify the native clipboard API. On OS X, this means working with the NSPasteboard object for the ‘general pasteboard’ (OS X actually defines more than one system clipboard, but the general one is the one we want). On my admittedly brief inspection, the NSPasteboard class is conceptually pretty similar to the IDataObject interface on Windows – it’s a bit higher level, but not much, and there’s an intertwining of clipboard and drag and drop functionality common to both.
We can get a reference to the general pasteboard like this:
uses Macapi.ObjectiveC, Macapi.CoreFoundation, Macapi.CocoaTypes, Macapi.Foundation, Macapi.AppKit; function GeneralPasteboard: NSPasteboard; inline; begin Result := TNSPasteboard.Wrap(TNSPasteboard.OCClass.generalPasteboard); end;
To poll for what’s available to paste, call the availableTypeFromArray method. This is passed an NSArray of NSString objects containing the system-defined identifiers for the ‘representation types’ you are interested in – if none is matched, nil is returned, otherwise the first match is.
While you don’t have to break out the needed code into a series of helper functions, I think it makes things clearer if you do. So, first we’ll have a function to construct an NSArray from an arbitrary group of NSObject instances:
function NSObjectArray(const Objs: array of NSObject): NSArray; var Counter: Integer; Obj: NSObject; Ptrs: array of Pointer; begin SetLength(Ptrs, Length(Objs)); Counter := 0; for Obj in Objs do if Obj <> nil then begin Ptrs[Counter] := (Obj as ILocalObject).GetObjectID; Inc(Counter); end; Result := TNSArray.Wrap(TNSArray.OCClass.arrayWithObjects(Ptrs, Counter)); end;
One of docs I read mentioned the illegality of nil elements, which is why I check for them here.
Using NSObjectArray, we can easily write a function to return an array of the standard bitmap representation types:
function NSBitmapTypesArray: NSArray; inline; begin Result := NSObjectArray([NSPasteboardTypePNG, NSPasteboardTypeTIFF]); end;
Initially I was just specifying NSPasteboardTypePNG, but then found the Grab utility bundled with Snow Leopard writing only TIFF images to the
clipboard general pasteboard. Since TBitmap can read both formats, we should therefore check for both.
Finally, we can write CanPasteBitmapFromClipboard as another one-liner:
function CanPasteBitmapFromClipboard: Boolean; begin Result := (GeneralPasteboard.availableTypeFromArray(NSBitmapTypesArray) <> nil); end;
For actual pasting, we can do this:
type TUserMemoryStream = class(TCustomMemoryStream) constructor Create(AMemory: Pointer; const ALength: NativeInt); function Write(const Buffer; Count: Longint): Longint; override; end; constructor TUserMemoryStream.Create(AMemory: Pointer; const ALength: NativeInt); begin inherited Create; SetPointer(AMemory, ALength); end; function TUserMemoryStream.Write(const Buffer; Count: Longint): Longint; begin Result := 0; end; function PasteBitmapFromClipboard(Bitmap: TBitmap): Boolean; var Data: NSData; DataType: NSString; Pasteboard: NSPasteboard; Stream: TCustomMemoryStream; begin Pasteboard := GeneralPasteboard; DataType := Pasteboard.availableTypeFromArray(NSBitmapTypesArray); if DataType <> nil then Data := Pasteboard.dataForType(DataType); if Data = nil then Exit(False); Stream := TUserMemoryStream.Create(Data.bytes, Data.length); try Bitmap.Clear(0); //needed due to FMX bug - try pasting the same PNG multiple times Bitmap.LoadFromStream(Stream); finally Stream.Free; end; Result := True; end;
Instead of defining and using TUserMemoryStream, you could use a normal TMemoryStream and copy the data into it. I prefer to avoid needless copying of data if I can however.
For going the other way – i.e., assigning a bitmap to the general pasteboard – I’ve come up with the following:
procedure CopyBitmapToClipboard(Bitmap: TBitmap); var Data: CFDataRef; Filter: TBitmapCodec; Pasteboard: NSPasteboard; Stream: TMemoryStream; begin Data := nil; Stream := nil; Filter := DefaultBitmapCodecClass.Create; try Stream := TMemoryStream.Create; Filter.SaveToStream(Stream, Bitmap, 'png'); Pasteboard := GeneralPasteboard; Pasteboard.declareTypes(NSObjectArray([NSPasteboardTypePNG]), nil); Data := CFDataCreateWithBytesNoCopy(nil, Stream.Memory, Stream.Size, kCFAllocatorNull); Pasteboard.setData(TNSData.Wrap(Data), NSPasteboardTypePNG); finally if Data <> nil then CFRelease(Data); Filter.Free; Stream.Free; end; end;
Once more, I avoid data copying for data copying’s sake, this time by using the CFDataCreateWithBytesNoCopy function to construct a CFDataRef/NSData object that uses a ‘backing store’ provided on the Delphi side (like CFStringRef and NSString, CFDataRef and NSData are ‘toll-free bridged’, i.e. binary compatible).
The bit before the CFDataCreateWithBytesNoCopy call may need some explaining though: while TBitmap has its own SaveToStream method, using our own TBitmapCodec instance explicitly means we can guarantee a PNG image will be outputted – while the present implementation of TBitmap.SaveToStream will output a PNG image if an alpha channel is defined, it will output a JPEG if one isn’t. As an aside, the JPEG format is a poor default in my view given it is a ‘lossy’ one, but that’s the way it is. [Update 16/12/11: this was fixed in update 3 so that TBitmap.SaveToStream always outputs a PNG image.]
On Windows, implementing CanPasteBitmapFromClipboard is trivial:
uses Winapi.Windows; function CanPasteBitmapFromClipboard: Boolean; begin Result := IsClipboardFormatAvailable(CF_DIB); end;
While we could check for other formats, that shouldn’t be necessary given DIB is the native display format, and so, essentially universal in a Windows context. In fact, it is so universal, we can assume it will be the pixel format used by TBitmap, avoiding the need to stream out:
procedure CopyBitmapToClipboard(Bitmap: TBitmap); var BitsSize: Integer; MemObj: HGLOBAL; Ptr: PBitmapInfoHeader; begin BitsSize := Bitmap.Width * Bitmap.Height * 4; MemObj := GlobalAlloc(GMEM_MOVEABLE and GMEM_DDESHARE, SizeOf(TBitmapInfoHeader) + BitsSize); if MemObj = 0 then RaiseLastOSError; Ptr := GlobalLock(MemObj); if Ptr = nil then begin GlobalFree(MemObj); RaiseLastOSError; end; //fill out the info header FillChar(Ptr^, SizeOf(Ptr^), 0); Ptr.biSize := SizeOf(TBitmapInfoHeader); Ptr.biPlanes := 1; Ptr.biBitCount := 32; Ptr.biCompression := BI_RGB; Ptr.biWidth := Bitmap.Width; if Ptr.biWidth <= 0 then Ptr.biWidth := 1; Ptr.biHeight := -Bitmap.Height; if Ptr.biHeight >= 0 then Ptr.biHeight := -1; //copy over the image bits Inc(Ptr); if BitsSize <> 0 then Move(Bitmap.StartLine^, Ptr^, BitsSize); GlobalUnlock(MemObj); //assign the completed DIB memory object to the clipboard OpenClipboard(0); try EmptyClipboard; if not SetClipboardData(CF_DIB, MemObj) then begin GlobalFree(MemObj); RaiseLastOSError; end; finally CloseClipboard; end; end;
For PasteBitmapFromClipboard though, we do need to stream in since the source may not be a 32 bit colour DIB:
function PasteBitmapFromClipboard(Bitmap: TBitmap): Boolean; var Header: TBitmapFileHeader; MemObj: HGLOBAL; Ptr: PBitmapInfoHeader; Stream: TMemoryStream; begin Ptr := nil; Stream := nil; OpenClipboard(0); try MemObj := GetClipboardData(CF_DIB); if MemObj = 0 then Exit(False); Ptr := GlobalLock(MemObj); if Ptr = nil then Exit(False); FillChar(Header, SizeOf(Header), 0); Header.bfType := $4D42; Header.bfSize := SizeOf(Header) + GlobalSize(MemObj); Header.bfOffBits := SizeOf(Header) + Ptr.biSize; Stream := TMemoryStream.Create; Stream.WriteBuffer(Header, SizeOf(Header)); Stream.WriteBuffer(Ptr^, Header.bfSize - SizeOf(Header)); Stream.Position := 0; Bitmap.LoadFromStream(Stream); Result := True; finally if Ptr <> nil then GlobalUnlock(MemObj); CloseClipboard; Stream.Free; end; end;
So, there you have it: code to read and write a FireMonkey TBitmap from and to the system clipboard on both OS X and Windows.
You can get the complete unit and a small demo project from here. (Update: check out my post here for a FMX TClipboard implementation I’ve made available.)
PS – while I have few complaints about the FMX TBitmap and TCanvas interfaces in general, perhaps inevitably, there was one WTF moment when I was checking them out – the signature for TBitmapCodec.LoadFromStream looks like this:
function LoadFromStream(const AStream: TStream; var Bitmap: TBitmap): Boolean; virtual; abstract;
Was the person who wrote this not quite clear about what const and var actually mean when used on parameters typed to a class, or indeed, any pure reference type…?