如何使用TBitmap的功能为FireMonkey和VCL工作？

Posted 2021-03-28

在firemonkey TBitmap是Fmx.graphics.TBitmap但在VCL它是VCL.graphics.Tbitmap。他们的界面非常相似，我想创建例如这个功能

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

由于resizeBitmap中的代码与Fmx.graphics.TBitmap或VCL.graphics.Tbitmap完全相同，我想使这个功能可用于VCL应用程序和FMX应用程序（没有重复它，因为它的意思是我只需要复制过去的代码并替换使用Fmx.graphics.TBitmap作者：VCL.graphics.Tbitmap）

他们是一种可以帮助我完成这项工作的方式或条件定义吗？

答案

遗憾的是，Delphi中没有预定义的条件定义来区分FMX和VCL。幸运的是，你可以轻松地拥有一个。在％APPDATA％ Embarcadero BDS 19.0（对于东京）中创建名为UserTools.proj的文件，并为其提供以下内容：

<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}

缺点是该文件是用户特定的。

另一答案

你可以把它作为一个包括：

文件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，但（几乎）没有重复的代码。

No generics

请注意，使用泛型是

• 没有必要，如果你这样做
• 不可能是“通用”位图

因为在代码中

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

T根本没有任何属性或方法，当然也没有像Width或Height这样的属性，因此任何使用它们的代码都不会编译。

Conditional compilation

或者，您可以使用条件编译：

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。所以忘记泛型。使用上述方法之一。

另一答案

另一种方法是定义具有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;

然后编写两个包装器，每种类型的Bitmap一个：

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这样的简单函数来说，写包装器会有点过分，但是如果你有很多函数，它可能是有意义的。

另一答案

我也会主张使用接口。你有两个几乎相同的类。这是接口的一件事。

将接口与类助手组合，您可以定义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和one的参数，这些参数不是，这意味着一些额外的工作：

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.

另一答案

你可以使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.TBit