How to create a function that uses TBitmap for FireMonkey and VCL?

Question

In firemonkey TBitmapthere is Fmx.graphics.TBitmap, but on VCL it VCL.graphics.Tbitmap. Their interface is very similar, and I want to create , for example, this function

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

Since the code in resizeBitmapwill be exactly the same for Fmx.graphics.TBitmapor VCL.graphics.Tbitmap, I would like to make this function available for both the VCL application and the FMX application (without duplication, because this means that I just need to copy the code and replace it with Fmx.graphics.TBitmapwith VCL.graphics.Tbitmap)

is their method or conditional definition that can help me in this work?

Answer 1

, Delphi , FMX VCL. , . UserTools.proj % APPDATA%\Embarcadero\BDS\19.0 ( ) :

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

:

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

, .

Answer 2

include:

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;

VCL.BitmapTools.pas - :

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.

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.

, : VCL FMX, () .

,

• , .
• ""

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

T , , , Width Height, .

:

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

, :

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

TBitmap TBitmap, . . .

Answer 3

TBitmap:

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

, :

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

- FMX. :

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

:

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

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

, , , , , , .

, SetBitmapSize, , .

Answer 4

. , . .

, Util- :

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

FMX:

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

VCL:

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

. implements :

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.

implements "" :

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.

const , , :

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

resizeBitmap() Generic, :

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;

FMX.Graphics.TBitmap, VCL.Graphics.TBitmap Generic:

var
  bmp: FMX.Graphics.TBitmap;

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

var
  bmp: VCL.Graphics.TBitmap;

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

TBitmap , FMX.Graphics.TBitmap VCL.Graphics.TBitmap , uses, :

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

var
  bmp: TBitmap;

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

, " ":

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

var
  bmp: TBitmap;

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

- FMX.Graphics.TBitmap VCL.Graphics.TBitmap TPersistent, T, :

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

RTTI , :

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;

:

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 to the list {$IF}or “Unit Scope Names” approach , and let the compiler decide which type to TBitmapuse, then you don’t need a general one, and you don’t need an RTTI when accessing properties / methods that are common to both types TBitmap( even if 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, ...);