[FMX]放大二维码显示 – QDAC官方网站

在以前的文章中，我介绍过如何在 FMX 中绘制二维码，但没有给出放大显示的代码，这里给出下，方便大家使用。

function ScaleQRBitmap(AQRBitmap: TBitmap; const ASize: Integer): TBitmap;overload;
var
  sr, dr: TRectF;
begin
  Result := TBitmap.Create;
  sr.Left := 0;
  sr.Top := 0;
  sr.Right := AQRBitmap.Width;
  sr.Bottom := AQRBitmap.Height;
  dr.Left := 0;
  dr.Top := 0;
  dr.Right := ASize;
  dr.Height := ASize;
  Result.SetSize(ASize, ASize);
  Result.Canvas.BeginScene();
  Result.Canvas.Clear(TAlphaColors.Null);
  Result.Canvas.DrawBitmap(AQRBitmap, sr, dr, 1, True);
  Result.Canvas.EndScene;
end;

function ScaleQRBitmap(const ASize: Integer; const AText: String): TBitmap;overload;
var
  ATemp: TBitmap;
  sr, dr: TRectF;
begin
  ATemp := GenerateQRCode(AText);
  try
    Result:=ScaleQRBitmap(ATemp,ASize);
  finally
    FreeAndNil(ATemp);
  end;
end;

function ScaleQRBitmap(AQRBitmap: TBitmap; const ASize: Integer): TBitmap;overload;

var

sr, dr: TRectF;

begin

Result := TBitmap.Create;

sr.Left := 0;

sr.Top := 0;

sr.Right := AQRBitmap.Width;

sr.Bottom := AQRBitmap.Height;

dr.Left := 0;

dr.Top := 0;

dr.Right := ASize;

dr.Height := ASize;

Result.SetSize(ASize, ASize);

Result.Canvas.BeginScene();

Result.Canvas.Clear(TAlphaColors.Null);

Result.Canvas.DrawBitmap(AQRBitmap, sr, dr, 1, True);

Result.Canvas.EndScene;

end;

function ScaleQRBitmap(const ASize: Integer; const AText: String): TBitmap;overload;

var

ATemp: TBitmap;

sr, dr: TRectF;

begin

ATemp := GenerateQRCode(AText);

try

Result:=ScaleQRBitmap(ATemp,ASize);

finally

FreeAndNil(ATemp);

end;

然后直接调用 ScaleQRBitmap 就可以了。注意 ASize 的计算应考虑进入 SceneScale 的值。参考代码如下：

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  ABitmap: TBitmap;
begin
  ABitmap := ScaleQRBitmap(Trunc(Image1.Width*(Self as IScene).GetSceneScale ), 'http://www.baidu.com');
  try
    Image1.Bitmap.Assign(ABitmap);
  finally
    FreeAndNil(ABitmap);
  end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);

var

ABitmap: TBitmap;

begin

ABitmap := ScaleQRBitmap(Trunc(Image1.Width*(Self as IScene).GetSceneScale ), 'http://www.baidu.com');

try

Image1.Bitmap.Assign(ABitmap);

finally

FreeAndNil(ABitmap);

end;

程序运行效果：

登录