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

问题描述 投票：6回答：5

在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 firemonkey
5个回答
3
投票

遗憾的是，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}

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

1
投票

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

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

1
投票

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

1
投票

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

将接口与类助手组合，您可以定义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.
0
投票

你可以使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, ...);

或者，使用项目的“单位范围名称”列表：

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应用Generic禁令，所以这样的代码可以编译：

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}或“单位范围名称”列表方法，并让编译器决定使用哪种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, ...);
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.