如何编写兼容FireMonkey与VCL的TBitmap通用函数？

阿华AIGC实验室

2026-5-19

适配VCL和FMX的通用Bitmap缩放方案

刚好做过类似的需求，要写一个能同时支持VCL.Graphics.TBitmap和FMX.Graphics.TBitmap的ResizeBitmap函数，还不想重复写两遍代码，这里有几个靠谱的实现方式，按推荐程度给你梳理下：

方案1：泛型+RTTI动态适配（推荐）

利用Delphi的泛型特性，结合RTTI来访问两种Bitmap的共有属性，不用写两套逻辑。核心是通过泛型让函数接受任意Bitmap类型，再用RTTI动态获取/设置宽高、执行绘制逻辑，完美适配两者的差异。

代码示例

unit BitmapResizer;

interface

uses
  System.Classes, System.Rtti,
  {$IFDEF VCL}
  VCL.Graphics;
  {$ELSE}
  FMX.Graphics, FMX.Types;
  {$ENDIF}

type
  TBitmapResizer = class
  public
    class procedure Resize<T>(const SourceBitmap: T; TargetWidth, TargetHeight: Integer; out TargetBitmap: T);
  end;

implementation

uses
  System.TypInfo;

class procedure TBitmapResizer.Resize<T>(const SourceBitmap: T; TargetWidth, TargetHeight: Integer; out TargetBitmap: T);
var
  RttiCtx: TRttiContext;
  SrcObj, DestObj: TObject;
  SrcWidth, SrcHeight: Integer;
  RttiType: TRttiType;
begin
  SrcObj := TObject(SourceBitmap);
  // 用RTTI获取源Bitmap的宽高
  RttiType := RttiCtx.GetType(SrcObj.ClassType);
  SrcWidth := RttiType.GetProperty('Width').GetValue(SrcObj).AsInteger;
  SrcHeight := RttiType.GetProperty('Height').GetValue(SrcObj).AsInteger;

  // 创建目标Bitmap实例
  DestObj := TClass(SrcObj.ClassType).Create;
  TargetBitmap := T(DestObj);

  // 设置目标尺寸
  RttiType.GetProperty('Width').SetValue(DestObj, TargetWidth);
  RttiType.GetProperty('Height').SetValue(DestObj, TargetHeight);

  // 执行缩放逻辑，区分VCL和FMX的实现
  {$IFDEF VCL}
  with TBitmap(DestObj).Canvas do
  begin
    StretchDraw(Rect(0, 0, TargetWidth, TargetHeight), TBitmap(SrcObj));
  end;
  {$ELSE}
  TBitmap(DestObj).Assign(SourceBitmap);
  TBitmap(DestObj).Resize(TargetWidth, TargetHeight);
  {$ENDIF}
end;

end.

使用方式

不管是VCL还是FMX项目，直接调用就行，完全不用改代码：

var
  SrcBmp, DestBmp: TBitmap;
begin
  SrcBmp := TBitmap.Create;
  try
    SrcBmp.LoadFromFile('test.bmp');
    TBitmapResizer.Resize(SrcBmp, 200, 200, DestBmp);
    // 这里直接用DestBmp做后续操作
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;
end;

方案2：抽象接口封装（解耦首选）

如果想彻底把VCL和FMX的Bitmap逻辑隔离开，就定义一个统一的IBitmap接口，然后分别为两种Bitmap写适配器类，缩放函数只依赖这个接口，后续要加其他Bitmap类型也很方便。

代码示例

第一步：定义通用接口

unit IBitmapIntf;

interface

type
  IBitmap = interface
    ['{F5A4D2C1-7E0B-4F8E-817D-1F2D34567890}'] // 自己生成个GUID就行
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
    procedure Resize(Width, Height: Integer);
    function GetWidth: Integer;
    function GetHeight: Integer;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
  end;

implementation

end.

第二步：VCL Bitmap适配器

unit VCLBitmapAdapter;

interface

uses
  IBitmapIntf, VCL.Graphics;

type
  TVCLBitmapAdapter = class(TInterfacedObject, IBitmap)
  private
    FBitmap: TBitmap;
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
    procedure Resize(Width, Height: Integer);
    function GetWidth: Integer;
    function GetHeight: Integer;
    property Bitmap: TBitmap read FBitmap; // 暴露原生Bitmap方便特殊操作
  end;

implementation

constructor TVCLBitmapAdapter.Create;
begin
  inherited;
  FBitmap := TBitmap.Create;
end;

destructor TVCLBitmapAdapter.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

procedure TVCLBitmapAdapter.LoadFromFile(const FileName: string);
begin
  FBitmap.LoadFromFile(FileName);
end;

procedure TVCLBitmapAdapter.SaveToFile(const FileName: string);
begin
  FBitmap.SaveToFile(FileName);
end;

procedure TVCLBitmapAdapter.Resize(Width, Height: Integer);
var
  TempBmp: TBitmap;
begin
  TempBmp := TBitmap.Create;
  try
    TempBmp.Width := Width;
    TempBmp.Height := Height;
    TempBmp.Canvas.StretchDraw(Rect(0, 0, Width, Height), FBitmap);
    FBitmap.Assign(TempBmp);
  finally
    TempBmp.Free;
  end;
end;

function TVCLBitmapAdapter.GetWidth: Integer;
begin
  Result := FBitmap.Width;
end;

function TVCLBitmapAdapter.GetHeight: Integer;
begin
  Result := FBitmap.Height;
end;

end.

第三步：FMX Bitmap适配器

unit FMXBitmapAdapter;

interface

uses
  IBitmapIntf, FMX.Graphics;

type
  TFMXBitmapAdapter = class(TInterfacedObject, IBitmap)
  private
    FBitmap: TBitmap;
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
    procedure Resize(Width, Height: Integer);
    function GetWidth: Integer;
    function GetHeight: Integer;
    property Bitmap: TBitmap read FBitmap; // 暴露原生Bitmap
  end;

implementation

constructor TFMXBitmapAdapter.Create;
begin
  inherited;
  FBitmap := TBitmap.Create;
end;

destructor TFMXBitmapAdapter.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

procedure TFMXBitmapAdapter.LoadFromFile(const FileName: string);
begin
  FBitmap.LoadFromFile(FileName);
end;

procedure TFMXBitmapAdapter.SaveToFile(const FileName: string);
begin
  FBitmap.SaveToFile(FileName);
end;

procedure TFMXBitmapAdapter.Resize(Width, Height: Integer);
begin
  FBitmap.Resize(Width, Height); // FMX自带Resize方法，直接用
end;

function TFMXBitmapAdapter.GetWidth: Integer;
begin
  Result := FBitmap.Width;
end;

function TFMXBitmapAdapter.GetHeight: Integer;
begin
  Result := FBitmap.Height;
end;

end.

第四步：通用缩放函数

unit BitmapResizer;

interface

uses
  IBitmapIntf;

procedure ResizeBitmap(const SourceBitmap: IBitmap; TargetWidth, TargetHeight: Integer);

implementation

procedure ResizeBitmap(const SourceBitmap: IBitmap; TargetWidth, TargetHeight: Integer);
begin
  SourceBitmap.Resize(TargetWidth, TargetHeight);
end;

end.

使用方式

VCL项目里这么用：

var
  BitmapAdapter: IBitmap;
begin
  BitmapAdapter := TVCLBitmapAdapter.Create;
  BitmapAdapter.LoadFromFile('test.bmp');
  ResizeBitmap(BitmapAdapter, 200, 200);
  // 如果需要直接操作原生VCL Bitmap，强转就行：(BitmapAdapter as TVCLBitmapAdapter).Bitmap...
end;

FMX项目里换个适配器就行：

var
  BitmapAdapter: IBitmap;
begin
  BitmapAdapter := TFMXBitmapAdapter.Create;
  BitmapAdapter.LoadFromFile('test.bmp');
  ResizeBitmap(BitmapAdapter, 200, 200);
  // 同样可以强转获取原生FMX Bitmap
end;

方案3：条件编译（快速实现）

如果项目比较小，不想搞复杂的泛型或接口，用条件编译也能搞定，代码紧凑直接，就是耦合度稍高一点：

unit BitmapResizer;

interface

uses
  {$IFDEF VCL}
  VCL.Graphics;
  {$ELSE}
  FMX.Graphics;
  {$ENDIF}

procedure ResizeBitmap(const SourceBitmap: TBitmap; TargetWidth, TargetHeight: Integer; out TargetBitmap: TBitmap);

implementation

procedure ResizeBitmap(const SourceBitmap: TBitmap; TargetWidth, TargetHeight: Integer; out TargetBitmap: TBitmap);
begin
  TargetBitmap := TBitmap.Create;
  try
    TargetBitmap.Width := TargetWidth;
    TargetBitmap.Height := TargetHeight;
    {$IFDEF VCL}
    TargetBitmap.Canvas.StretchDraw(Rect(0, 0, TargetWidth, TargetHeight), SourceBitmap);
    {$ELSE}
    TargetBitmap.Assign(SourceBitmap);
    TargetBitmap.Resize(TargetWidth, TargetHeight);
    {$ENDIF}
  except
    TargetBitmap.Free;
    raise;
  end;
end;

end.

这种方式的好处是简单，不用额外写太多代码，缺点是函数依赖项目的编译定义（VCL/FMX），不能在同一个项目里同时处理两种Bitmap（不过一般也没这需求）。