Clippers

A 'clipper' is a helper object, implementing relevant interfaces, that enables assigning instances of a given type to and from a TClipboard. While copying and pasting custom objects can be supported via the TPersistent assignment system (TClipboard descends from TPersistent), clippers enable HasFormatFor and GetObjects<T> support as well as Assign calls. Moreover, it is possible to register a clipper for instances of a value type rather than just another class, and any class rather than just a TPersistent descendant specifically.

The relevant interfaces are defined as so:

type
  ICustomClipper = interface
  ['{399C374B-854A-47D6-AA89-64642E8FC078}']
    function CanLoadFromClipboard(const Clipboard: TClipboard): Boolean;
  end;

  ICustomClipper<T> = interface(ICustomClipper)
    procedure SaveToClipboard(const Clipboard: TClipboard; 
      PreferDelayed: Boolean; const Getter: TFunc<T>);
  end;
  
  TLoadObjectsCallback<T: class> = reference to procedure (
    const AssignTo: TProc<T>; var LookForMore: Boolean);

  IObjectClipper<T: class> = interface(ICustomClipper<T>)
  ['{A1F0A310-77BD-4DD7-A1A5-AF4BED2CA220}']
    procedure LoadFromClipboard(const Clipboard: TClipboard; 
      const Callback: TLoadObjectsCallback<T>);
  end;
  
  TGetInstancesCallback<T> = reference to procedure (
    const Obj: T; var LookForMore: Boolean);
  
  IRecordClipper<T: record> = interface(ICustomClipper<T>)
  ['{A1F0A310-77BD-4DD7-A1A5-AF4BED2CA220}']
    procedure LoadFromClipboard(const Clipboard: TClipboard;
      const Callback: TGetInstancesCallback<T>);
  end;

As such, a clipper for a class needs to implement IObjectClipper and its ancestors, one for a value type IRecordClipper and its ancestors. Having written a class that does this (more on which below), create an instance and pass it to RegisterClipper:

type
  //define a clipper for TMyObject
  TMyObjectClipper = class(TInterfacedObject, ICustomClipper, IObjectClipper<TMyObject>)
  strict protected
    function CanLoadFromClipboard(const Clipboard: TClipboard): Boolean;
    procedure LoadFromClipboard(const Clipboard: TClipboard; 
      const Callback: TLoadObjectsCallback<T>);
    procedure SaveToClipboard(const Clipboard: TClipboard; 
      PreferDelayed: Boolean; const Getter: TFunc<T>);
  end;
//...
initialization
  TClipboard.RegisterClipper<TMyObject>(TMyObjectClipper.Create);
end.

If a clipper for the type has already been registered, it will be replaced rather than cause an exception.

Standard clippers

The platform specific units provide clippers for standard graphic classes:

• For FMX, TBitmap
• For the VCL, TPicture, TBitmap, TGIFImage, TJPEGImage, TMetafile, TPNGImage and TWICImage.

TClipboard itself also provides one-liner support for registering any given TPersistent descendant with a default clipper implementation. For example, you might register a FMX TGradient like so:

TClipboard.RegisterSimpleClipper<TGradient>;

This will then enable assignments between a TGradient and a TClipboard, along with HasFormatFor and GetObjects calls:

Clipboard.Assign(Rectangle1.Fill.Gradient);
if Clipboard.HasFormatFor(TGradient) then
   Rectangle2.Fill.Gradient.Assign(Clipboard);

Clipboard.Open;
try
  Clipboard.Assign(Rectangle1.Fill.Gradient);
  Clipboard.Assign(Rectangle2.Fill.Gradient);
finally
  Clipboard.Close;
end;

Clipboard.GetObjects<TGradient>(
  procedure (const AssignTo: TProc<TGradient>; var LookForMore: Boolean)
  begin
    AssignTo(Rectangle1.Fill.Gradient);
    LookForMore := False;
  end);

Per standard platform limitations multiple assignments won't work properly on Windows (the second assignment will just overwrite the first), however they will on OS X and iOS.

Internally a default clipper uses TComponent streaming. In a copying scenario this entails the source object being set as the published property of a dummy TComponent descendant (TClipping) which is then streamed out; the resulting bytes are then copied to the clipboard using a format named after the fully qualified class name, which will include the module name if the unit scope is not System, FMX, or VCL. E.g., in the TGradient case above the format name will be 'FMX.Graphics.TGradient' (or 'FMX.Types.TGradient' in XE2 or XE3). In contrast, were you to register a simple clipper for the TMyObject class defined in CommonUtils.pas of the SuperDooper.dpr project, the format name will be 'SuperDooper.CommonUtils.TMyObject'. To use a different name pass it as an argument to RegisterSimpleClipper:

RegisterSimpleClipper<TGradient>('My custom format name');

This may be prudent if the interface of a clippable class is not stable between versions, and different versions might be clipped on the same computer.

Custom clippers

As an example of a custom clipper, consider writing one for TRectF records. This will require a class implementing ICustomClipper and IRecordClipper:

type
  TRectFClipper = class(TInterfacedObject, ICustomClipper, IRecordClipper<TRectF>)
  strict private class var
    FFormat: TClipboardFormat;
    class constructor InitializeClass;
  strict protected
    function CanLoadFromClipboard(const Clipboard: TClipboard): Boolean;
    procedure LoadFromClipboard(const Clipboard: TClipboard;
      const Callback: TGetInstancesCallback<TRectF>);
    procedure SaveToClipboard(const Clipboard: TClipboard; PreferDelayed: Boolean;
      const Getter: TFunc<TRectF>);
  public
    class property Format: TClipboardFormat read FFormat;
  end;

In the example a TRectF will be copied as a custom binary format; as such, we need to register a suitable format name. Anything will do, but as a fully qualified type name happens to share the form of a UTI on Apple platforms, let's use that:

class constructor TRectFClipper.InitializeClass;
begin
  FFormat := TClipboard.RegisterFormat('System.Types.TRectF');
end;

TheCanLoadFromClipboard implementation can then just test for the existence of that format:

function TRectFClipper.CanLoadFromClipboard(const Clipboard: TClipboard): Boolean;
begin
  Result := Clipboard.HasFormat(FFormat);
end;

For SaveToClipboard we should use the PreferDelayed argument to determine whether Assign or AssignDelayed should be called to actually put on the data:

procedure TRectFClipper.SaveToClipboard(const Clipboard: TClipboard;
  PreferDelayed: Boolean; const Getter: TFunc<TRectF>);
var
  GetBytes: TFunc<TBytes>;
begin
  GetBytes :=
    function : TBytes
    var
      R: TRectF;
    begin
      R := Getter;
      SetLength(Result, SizeOf(R));
      Move(R, Result[0], SizeOf(R));
    end;
  if PreferDelayed then
    Clipboard.AssignDelayed(FFormat, GetBytes)
  else
    Clipboard.Assign(FFormat, GetBytes);
end;

For reading the data back in LoadFromClipboard we should use the callback version of GetBytes in order to ensure multiple instances are properly supported on Apple plaforms:

procedure TRectFClipper.LoadFromClipboard(const Clipboard: TClipboard;
  const Callback: TGetInstancesCallback<TRectF>);
begin
  Clipboard.GetBytes(FFormat,
    procedure (const Bytes: TBytes; var LookForMore: Boolean)
    var
      R: TRectF;
    begin
      if Length(Bytes) < SizeOf(TRectF) then Exit;
      Move(Bytes[0], R, SizeOf(TRectF));
      Callback(R, LookForMore);
    end);
end;

A small (though important) subtlety here is testing whether the number of bytes read is at least as big as a TRectF rather than exactly the same size. The reason is because on Windows, the OS may 'round up' when assigning a binary buffer to it, meaning that when reading back you may get meaningless padding bytes at the end.

The final job is registering our new clipper:

initialization
  TClipboard.RegisterClipper<TRectF>(TRectFClipper.Create);

This done, the following method calls will now be possible:

Clipboard.Assign(SomeRectF);
if Clipboard.HasFormatFor<TRectF> then //...
Clipboard.GetValues<TRectF>(
  procedure (const Value: TRectF; var LookForMore: Boolean)
  begin
    //...
  end);