How to make a function which use TBitmap work for FireMonkey and VCL?

Question

On firemonkey TBitmap is Fmx.graphics.TBitmap but on VCL it's VCL.graphics.Tbitmap. Their interface are very similar, and i want to create for example this function

function resizeBitmap(const aBitmap: Tbitmap; const w, h: integer);

As the code in resizeBitmap will be exactly the same for Fmx.graphics.TBitmap or VCL.graphics.Tbitmap i would like to make this function available for both VCL app and FMX app (without duplicate it because it's mean i will simply need to copy past the code and replace in uses Fmx.graphics.TBitmap by VCL.graphics.Tbitmap)

is their a way or a conditional define that can help me in this job ?

Answer 1

Unfortunately there is no conditional define predefined in Delphi to distinguish between FMX and VCL. Fortunately you can have one with little effort. Create a file named UserTools.proj in %APPDATA%\Embarcadero\BDS\19.0 (for Tokyo) and give it the following content:

<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
    <PropertyGroup>
       <DCC_Define>FrameWork_$(FrameworkType);$(DCC_Define)</DCC_Define>
    </PropertyGroup>
</Project>

This allows to check the framework in your code like this:

{$IFDEF FrameWork_VCL}
{$IFDEF FrameWork_FMX}
{$IFDEF FrameWork_None}

The drawback is that this file is user specific.

Answer 2

You could make this an include:

File bitmapcode.inc

// Here, TBitmap is either VCL or FMX, depending on where you include this. 
procedure ResizeBitmap(Bitmap: TBitmap; NewWidth, NewHeight: Integer);
begin
  Bitmap.Width := NewWidth;
  Bitmap.Height := NewHeight
end;

Now, make a unit called VCL.BitmapTools.pas with something like:

unit VCL.BitmapTools;

interface

uses VCL.Graphics {and what else you need} ;

// Here, TBitmap is VCL.Graphics.TBitmap
procedure ResizeBitmap(Bitmap: TBitmap; NewWidth, NewHeight: Integer);

implementation

{$INCLUDE bitmapcode.inc}

end.

And do the same for FMX:

unit FMX.BitmapTools;

interface

uses FMX.Graphics; // etc...

// Here, TBitmap is FMX.Graphics.TBitmap
procedure ResizeBitmap(Bitmap: TBitmap; NewWidth, NewHeight: Integer);

implementation

{$INCLUDE bitmapcode.inc}

end.

So you get two different units, one for VCL and one for FMX, but (almost) no duplication of code.

No generics

Note that using generics is

• not necessary if you do it this way
• not possible for a "generic" bitmap

because in code like

SomeClass<T>.ResizeBitmap(Bitmap: T; NewWidth, NewHeight: Integer); 

T does not have any properties or methods at all, and certainly not properties like Width or Height, so any code that used them would simply not compile.

Conditional compilation

Alternatively, you could use conditional compilation:

uses
{$IF declared(FireMonkeyVersion)}
  FMX.Graphics;
{$ELSE}
  VCL.Graphics;
{$IFEND}

But then again, generics would not be required:

procedure ResizeBitmap(Bitmap: TBitmap; NewWidth, NewHeight: Integer);
begin
  Bitmap.Width := NewWidth;
  Bitmap.Height := NewHeight;
end;

Because TBitmap would refer to the TBitmap that was conditionally compiled in. So forget generics. Use one of the ways above.

Answer 3

Another approach would be to define an interface with the characteristics of both TBitmap versions:

type
  IBitmap = interface
  [GUID here]
    function GetWidth: Integer; // or Single
    procedure SetWidth(Value: Integer);
    // etc...
    property Width: Integer read GetWidth write SetWidth;
    // etc...
  end;

And then write two wrappers, one for each kind of Bitmap:

type
  TVCLBitmapWrapper = class(TInterfacedObject, IBitmap)
  private
    FBitmap: VCL.Graphics.TBitmap;
  public
    constructor Create(From: VCL.Graphics.TBitmap);
    function GetWidth: Integer;
    // etc...
  end;

And something similar for the FMX version. Then you could pass these to your functions:

procedure SetBitmapSize(const Bitmap: IBitmap; H, W: Integer);

And call like:

SetBitmapSize(TVCLBitmapWrapper.Create(MyVCLBitmap) as IBitmap, 33, 123);

or

SetBitmapSize(TFMXBitmapWrapper.Create(MyFMXBitmap) as IBitmap, 127, 99);

Of course, if you must pass this to several functions, you first create the wrapper, pass it to these functions and then, if you want, nil it.

Writing wrappers would be overkill for one simple function like SetBitmapSize, but if you have many functions, it might make sense.

Answer 4

I too would advocate using interfaces. You have two classes that are nearly the same. That's one thing interfaces are made for.

Combining interfaces with class helpers you can define your Util-functions to operate on the interface:

function GetBitmapDimensions(ABitmap: IBitmap): string;
begin
    Result := Format('Height: %d, Width: %d', [ABitmap.Height, ABitmap.Width]);
end;

and easyly use this for FMX:

procedure TForm1.Button1Click(Sender: TObject);
begin
    ShowMessage(GetBitmapDimensions(Image1.Bitmap.AsIBitmap));
end;

as well as for VCL:

procedure TForm1.Button1Click(Sender: TObject);
begin
    ShowMessage(GetBitmapDimensions(Image1.Picture.Bitmap.AsIBitmap));
end;

Here is the code. implements is your friend:

unit Mv.Bitmap;

interface

uses
    Classes;

type
    IBitmap = interface
    ['{YourGuid...}']
        procedure LoadFromFile(const Filename: string);
        procedure SaveToFile(const Filename: string);
        procedure LoadFromStream(Stream: TStream);
        procedure SaveToStream(Stream: TStream);
        procedure SetSize(const AWidth, AHeight: Integer);
        //properties
        function GetHeight: Integer;
        function GetWidth: Integer;
        procedure SetHeight(const Value: Integer);
        procedure SetWidth(const Value: Integer);
        property Height: Integer read GetHeight write SetHeight;
        property Width: Integer read GetWidth write SetWidth;
    end;


implementation

end.

With implements you only need to implement the "missing" functions:

unit Mv.FMX.BitmapHelper;

interface

uses
    Mv.Bitmap,
    FMX.Types;

type

    TIFmxBitmapWrapper = class(TInterfacedObject, IBitmap)
    private
        FBitmap: TBitmap;
    protected
        procedure LoadFromFile(const AFilename: string);
        procedure SaveToFile(const AFilename: string);
        function GetHeight: Integer;
        function GetWidth: Integer;
        property Bitmap: TBitmap read FBitmap implements IBitmap;
    public
        constructor Create(ABitmap: TBitmap);
    end;

    TFmxBitmapHelper = class helper for TBitmap
        function AsIBitmap(): IBitmap;
    end;


implementation

{ TIFmxBitmapWrapper }

constructor TIFmxBitmapWrapper.Create(ABitmap: TBitmap);
begin
    FBitmap := ABitmap;
end;

function TIFmxBitmapWrapper.GetHeight: Integer;
begin
    Result := FBitmap.Height;
end;

function TIFmxBitmapWrapper.GetWidth: Integer;
begin
    Result := FBitmap.Width;
end;

procedure TIFmxBitmapWrapper.LoadFromFile(const AFilename: string);
begin
    FBitmap.LoadFromFile(AFilename);
end;

procedure TIFmxBitmapWrapper.SaveToFile(const AFilename: string);
begin
    FBitmap.SaveToFile(AFilename);
end;

{ TBitmapHelper }

function TFmxBitmapHelper.AsIBitmap: IBitmap;
begin
    Result := TIFmxBitmapWrapper.Create(Self);
end;


end.

The compiler differentiates between parameters that are const and ones, that are not, this means some extra work:

unit Mv.VCL.BitmapHelper;

interface

uses
    Mv.Bitmap,
    Vcl.Graphics;

type

    TIVclBitmapWrapper = class(TInterfacedObject, IBitmap)
    private
        FBitmap: TBitmap;
    protected
        // implement only missing functions (const!!)
        procedure SetSize(const AWidth, AHeight: Integer);
        procedure SetHeight(const AValue: Integer);
        procedure SetWidth(const AValue: Integer);
        property Bitmap: TBitmap read FBitmap implements IBitmap;
    public
        constructor Create(ABitmap: TBitmap);
    end;


    TBitmapHelper = class helper for TBitmap
        function AsIBitmap(): IBitmap;
    end;


implementation

{ TIVclBitmapWrapper }

constructor TIVclBitmapWrapper.Create(ABitmap: TBitmap);
begin
    FBitmap := ABitmap;
end;

procedure TIVclBitmapWrapper.SetHeight(const AValue: Integer);
begin
    FBitmap.Height := AValue;
    //alternative: TBitmapCracker(FBitmap).SetHeight(Value);
end;

procedure TIVclBitmapWrapper.SetSize(const AWidth, AHeight: Integer);
begin
    FBitmap.SetSize(AWidth, AHeight);
end;

procedure TIVclBitmapWrapper.SetWidth(const AValue: Integer);
begin
    FBitmap.Width := AValue;
    //alternative: TBitmapCracker(FBitmap).SetWidth(Value);
end;

{ TBitmapHelper }

function TBitmapHelper.AsIBitmap: IBitmap;
begin
    Result := TIVclBitmapWrapper.Create(Self);
end;

end.

Answer 5

You could make resizeBitmap() be a class method of a Generic class, eg:

type
  TBitmapUtility<T> = class
  public
    class procedure resizeBitmap(const aBitmap: T; const w, h: integer);
  end;

class procedure TBitmapUtility<T>.resizeBitmap(const aBitmap: T; const w, h: integer);
begin
  ...
end;

Then you can specify either FMX.Graphics.TBitmap or VCL.Graphics.TBitmap as the Generic type:

var
  bmp: FMX.Graphics.TBitmap;

TBitmapUtility<FMX.Graphics.TBitmap>.resizeBitmap(bmp, ...);

var
  bmp: VCL.Graphics.TBitmap;

TBitmapUtility<VCL.Graphics.TBitmap>.resizeBitmap(...);

If you specify just TBitmap as the type, the compiler can decide to use FMX.Graphics.TBitmap or VCL.Graphics.TBitmap based on which unit you have in the uses clause, which you can control conditionally:

uses
  ...,
  {$IF Declared(FireMonkeyVersion)}
  FMX.Graphics,
  {$ELSE}
  VCL.Graphics,
  {$IFEND}
  ...;

var
  bmp: TBitmap;

TBitmapUtility<TBitmap>.resizeBitmap(bmp, ...);

Or, use the project's "Unit Scope Names" list instead:

uses
  ...,
  Graphics, // <-- specify either 'Vcl' or 'Fmx' in the Unit Scope Names list...
  ...;

var
  bmp: TBitmap;

TBitmapUtility<TBitmap>.resizeBitmap(bmp, ...);

With that said, you do run into a problem - FMX.Graphics.TBitmap and VCL.Graphics.TBitmap do not have a common ancestor beyond TPersistent, so you can't apply a Generic contraint to T so code like this can compile:

class procedure TBitmapUtility<T>.resizeBitmap(const aBitmap: T; const w, h: integer);
begin
  aBitmap.Width := w;
  aBitmap.Height := h;
end;

You will have to resort to using RTTI to solve this, eg:

uses
  ..., System.Rtti;

type
  TBitmapUtility<T: class> = class
  public
    class procedure resizeBitmap(const aBitmap: T; const w, h: integer);
  end;

class procedure TBitmapUtility<T>.resizeBitmap(const aBitmap: T; const w, h: integer);
var
  Ctx: TRttiContext;
  Typ: TRttiType;
begin
  Typ := Ctx.GetType(TypeInfo(T));
  Typ.GetProperty('Width').SetValue(Pointer(aBitmap), w);
  Typ.GetProperty('Height').SetValue(Pointer(aBitmap), h);
end;

Or:

class procedure TBitmapUtility<T>.resizeBitmap(const aBitmap: T; const w, h: integer);
var
  Ctx: TRttiContext;
  Typ: TRttiType;
  Mth: TRttiMethod;
begin
  Typ := Ctx.GetType(TypeInfo(T));

  Mth := Typ.GetMethod('Resize'); // FMX
  if Mth = nil then
    Mth := Typ.GetMethod('SetSize'); // VCL
  // or use an $IF/$IFDEF to decide which method to lookup...

  if Mth <> nil then
    Mth.Invoke(TObject(aBitmap), [w, h])
  else
  begin
    Typ.GetProperty('Width').SetValue(Pointer(aBitmap), w);
    Typ.GetProperty('Height').SetValue(Pointer(aBitmap), h);
  end;
end;

---

Actually, if you go the {$IF} or "Unit Scope Names" list approach, and let the compiler decide which TBitmap type to use, then you don't actually need the Generic at all, and don't need RTTI when accessing properties/methods that are common to both TBitmap types (even though they don't have a common ancestor):

uses
  ...,
  {$IF Declared(FireMonkeyVersion)}
  FMX.Graphics,
  {$ELSE}
  VCL.Graphics,
  {$ENDIF}
  // or, just 'Graphics' unconditionally...
  ...;

procedure resizeBitmap(const aBitmap: TBitmap; const w, h: integer);

...

procedure resizeBitmap(const aBitmap: TBitmap; const w, h: integer);
begin
  aBitmap.Width := w;
  aBitmap.Height := h;
end;

...

var
  bmp: TBitmap;

resizeBitmap(bmp, ...);