Question

关于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应用（不重复，因为它＆＃39; s意味着我只需要复制代码并使用Fmx.graphics.TBitmap替换用途VCL.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;

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

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，您只需要实现＆＃34;缺少＆＃34;功能：

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和1的参数，不是，这意味着一些额外的工作：

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作为通用类型：

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, ...);

或者，使用项目＆＃34;单位范围名称＆＃34;而是列出：

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;

实际上，如果你去了{$IF}或＆＃34;单位范围名称＆＃34;列表方法，让编译器决定使用哪种TBitmap类型，然后你根本不需要Generic，并且在访问两者共有的属性/方法时不需要RTTI TBitmap类型（即使它们没有共同的祖先）：

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, ...);

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

5 个答案:

没有泛型

条件编译