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

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 3

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.