Copying and pasting the contents of a FireMonkey TBitmap

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.

OS X

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.]

Windows

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…?