如何使使用TBitmap的函数为FireMonkey和VCL工作？

Question

在火猴上，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应用程序都可以使用这个函数(而不重复它，因为这意味着我只需要通过代码复制并通过VCL.graphics.Tbitmap替换uses Fmx.graphics.TBitmap )。

他们是一种方式或条件的定义，可以帮助我在这份工作？

Answer 1

不幸的是，在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}

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

Answer 2

您可以将其包括：

文件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 )来说是过分的，但是如果您有许多函数，这可能是有意义的。