delphi使用TDelphiZXingQRCode生成二维码条形码

使用TDelphiZXingQRCode控件生成二维码条形码打印到TBitmap位图中，可以把二维码保存到JPG图片中。使用简单，代码如下：

DELPHI VCL实现代码：

 需要的单元：
uses Graphics, Jpeg, DelphiZXingQRCode;


// 根据大小缩放
procedure QRBitmapStretch(SoucreGraphic: TGraphic; ThumbWidth, ThumbHeight: Integer; DestStream: TStream);
var
    JpgImg: TJPEGImage;
    PTmpBmp: TBitmap;
    Rect: TRect;
begin
    PTmpBmp := TBitmap.Create();
    // 转换为JPG格式
    JpgImg := TJPEGImage.Create;
    try
        Rect.Left := 0;
        Rect.Top := 0;
        if (ThumbWidth = 0) or (ThumbHeight = 0) then begin
            PTmpBmp.Width := SoucreGraphic.Width;
            PTmpBmp.Height := SoucreGraphic.Height;
            Rect.Right := SoucreGraphic.Width;
            Rect.Bottom := SoucreGraphic.Height;
        end
        else begin
            PTmpBmp.Width := ThumbWidth;
            PTmpBmp.Height := ThumbHeight;
            Rect.Right := ThumbWidth;
            Rect.Bottom := ThumbHeight;
        end;
        PTmpBmp.Canvas.StretchDraw(Rect, SoucreGraphic);
 
        // Ft := JpgImg.PixelFormat;
        JpgImg.PixelFormat := jf8bit;
        JpgImg.Assign(PTmpBmp);
        JpgImg.SaveToStream(DestStream);
 
    finally
        JpgImg.Free();
        PTmpBmp.Free();
    end;
end;
 
procedure PaintEx(Bitmap: TBitmap; CodeText: string);
var
    QRCode: TDelphiZXingQRCode;
    Row, Column: Integer;
 
begin
    QRCode := TDelphiZXingQRCode.Create;
    try
        QRCode.Data := CodeText;
        QRCode.Encoding := qrUTF8NoBOM;
        QRCode.QuietZone := 1; // 四周空白区域大小
        Bitmap.SetSize(QRCode.Rows, QRCode.Columns);
        for Row := 0 to QRCode.Rows - 1 do begin
            for Column := 0 to QRCode.Columns - 1 do begin
                if (QRCode.IsBlack[Row, Column]) then begin
                    Bitmap.Canvas.Pixels[Column, Row] := clBlack;
                end
                else begin
                    Bitmap.Canvas.Pixels[Column, Row] := clWhite;
                end;
            end;
        end;
    finally
        QRCode.Free;
    end;
end;
 
//生成二维码，保存到JPG文件
procedure QRToJpg(W, H: Integer; CodeText: string; JPGFileName: string);
var
    DestStream: TMemoryStream;
    Bitmap: TBitmap;
 
begin
    if CodeText = '' then
        Exit;
 
    Bitmap := TBitmap.Create;
    DestStream := TMemoryStream.Create();
    try
        PaintEx(Bitmap, CodeText);
        //
        QRBitmapStretch(Bitmap, W, H, DestStream);
        //
        DestStream.Position := 0;
        DestStream.SavetoFile(JPGFileName);
    finally
        DestStream.Free();
        Bitmap.Free();
    end;
end;
 
 
//调用，生成二维码，并保存到JPG图片中 
QRToJpg(200, 200, 'https://www.gaya-soft.cn/download/', 'd:\xtemp\qr.jpg');

网络上没有FMX的实现代码，将上续代码改为可用于FMX的写法：

unit Baiwan.QRCodeHelper;

interface

uses
  System.SysUtils, System.StrUtils, System.Variants, System.Classes, FMX.Graphics,
  System.UITypes, System.Math, System.UIConsts, FMX.Objects, FMX.Surfaces,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Controls, System.Types,
  DelphiZxingQrCode;

type
  TFMXCanvasHelper = class helper for TCanvas
  public
    procedure StretchDraw(R: TRectF; ABitmap: TBitmap; ADoFit: Boolean = true;
        AHighSpeed: Boolean = true);
  end;


// 根据大小缩放
procedure QRBitmapStretch(SoucreGraphic: TBitmap; ThumbWidth, ThumbHeight: Integer; DestStream: TStream);
//生成二维码
procedure PaintQrCode(Bitmap: TBitmap; CodeText: string);
//生成二维码，保存到JPG文件
procedure QrCodeToJpg(W, H: Integer; CodeText: string; JPGFileName: string);

implementation


// 根据大小缩放
procedure QRBitmapStretch(SoucreGraphic: TBitmap; ThumbWidth, ThumbHeight: Integer; DestStream: TStream);
var
  Surf: TBitmapSurface;
  PTmpBmp: TBitmap;
  Rect: TRectF;
begin
  PTmpBmp := TBitmap.Create();
  // 转换为JPG格式
  Surf := TBitmapSurface.Create;
  try
    Rect.Left := 0;
    Rect.Top := 0;
    if (ThumbWidth = 0) or (ThumbHeight = 0) then begin
        PTmpBmp.Width := SoucreGraphic.Width;
        PTmpBmp.Height := SoucreGraphic.Height;
        Rect.Right := SoucreGraphic.Width;
        Rect.Bottom := SoucreGraphic.Height;
    end
    else begin
        PTmpBmp.Width := ThumbWidth;
        PTmpBmp.Height := ThumbHeight;
        Rect.Right := ThumbWidth;
        Rect.Bottom := ThumbHeight;
    end;

    PTmpBmp.Canvas.StretchDraw(Rect, SoucreGraphic, true, true);

    Surf.Assign(SoucreGraphic);
    TBitmapCodecManager.SaveToStream(DestStream, Surf, '.jpg');

  finally
    Surf.Free();
    PTmpBmp.Free();
  end;
end;

//生成二维码
procedure PaintQrCode(Bitmap: TBitmap; CodeText: string);
var
  QRCode: TDelphiZXingQRCode;
  Row, Column: Integer;
  QrCodeBmpData : TBitmapData;

begin
  QRCode := TDelphiZXingQRCode.Create;
  try
    QRCode.Data := CodeText;
    QRCode.Encoding := qrUTF8NoBOM;
    QRCode.QuietZone := 1; // 四周空白区域大小
    Bitmap.SetSize(QRCode.Rows, QRCode.Columns);

    if (Bitmap.Map(TMapAccess.Write, QrCodeBmpData)) then
    begin
      try
        for Row := 0 to QRCode.Rows - 1 do begin
          for Column := 0 to QRCode.Columns - 1 do begin
            if (QRCode.IsBlack[Row, Column]) then begin
              QrCodeBmpData.SetPixel(Column, Row, TAlphaColorRec.Black);
            end
            else begin
              QrCodeBmpData.SetPixel(Column, Row, TAlphaColorRec.White);
            end;
          end;
        end;
      finally
        Bitmap.Unmap(QrCodeBmpData);
      end;
    end;

  finally
    QRCode.Free;
  end;
end;

//生成二维码，保存到JPG文件
//调用，生成二维码，并保存到JPG图片中
//QrCodeToJpg(200, 200, 'https://www.gaya-soft.cn/download/', 'd:\xtemp\qr.jpg');
procedure QrCodeToJpg(W, H: Integer; CodeText: string; JPGFileName: string);
var
  DestStream: TMemoryStream;
  Bitmap: TBitmap;

begin
  if CodeText = '' then
      Exit;

  Bitmap := TBitmap.Create;
  DestStream := TMemoryStream.Create();
  try
    PaintQrCode(Bitmap, CodeText);
    //
    QRBitmapStretch(Bitmap, W, H, DestStream);
    //
    DestStream.Position := 0;
    DestStream.SavetoFile(JPGFileName);
  finally
    DestStream.Free();
    Bitmap.Free();
  end;
end;


{ TFMXCanvasHelper }
{
  R ：绘制目标区域
  ABitmap：要绘制的位图内容
  ADoFit：是否按比例自适应目标区域大小
  AHighSpeed：是否高速绘图，如果你是要绘制边缘清晰的位图，如二维码，那就要设置为 true，否则设置为 false
}
procedure TFMXCanvasHelper.StretchDraw(R: TRectF; ABitmap: TBitmap;
        ADoFit: Boolean = true; AHighSpeed: Boolean = true);
var
  SR: TRectF;
begin
  SR := RectF(0, 0, ABitmap.Width, ABitmap.Height);
  if ADoFit then
    R := SR.FitInto(R);
  DrawBitmap(ABitmap, SR, R, 1, AHighSpeed);
end;

end.