[FMX] 一个生成二维码的函数 – QDAC数据访问组件网站

需要用到 DelphiZXingQRCode 单元，这个单元可以到作者的官网去下载。这个函数只是一个简单的封装：

function GenerateQRCode(AData: String):TBitmap;
var
  AQRCode: TDelphiZXingQRCode;
  R: Integer;
  C: Integer;
  ABitmapData: TBitmapData;
begin
  Result := TBitmap.Create;
  AQRCode := TDelphiZXingQRCode.Create;
  try
    AQRCode.Data := AData;
    AQRCode.Encoding := qrUTF8BOM;
    AQRCode.QuietZone := 4;
    Result.SetSize(AQRCode.Columns, AQRCode.Rows);
    if Result.Map(TMapAccess.Write, ABitmapData) then
    begin
      for R := 0 to AQRCode.Rows - 1 do
      begin
        for C := 0 to AQRCode.Columns - 1 do
        begin
          if AQRCode.IsBlack[R, C] then
            ABitmapData.SetPixel(C, R, TAlphaColors.Black)
          else
            ABitmapData.SetPixel(C, R, TAlphaColors.White);
        end;
      end;
      Result.Unmap(ABitmapData);
    end
    else
      FreeAndNil(Result);
  finally
    FreeAndNil(AQRCode);
  end;
end;

用法：调用这个函数，返回一个TBitmap，你用来显示也好，干啥也好不用了释放了就好，没啥可说的。如果要将其放大绘制到一个画布上，调用画布的 DrawBitmap 方法即可，注意其中 HighSpeed 设置为 True，以避免进行平滑处理。

至于 VCL 的版本，愿意就自己改一个吧，不愿意，就算了，当我没说。

crystalxp 提供的VCL版

function GenerateQRCode(AData: String): TBitmap;
type
  TRGBTriple = PACKED RECORD
    rgbtBlue: Byte;
    rgbtGreen: Byte;
    rgbtRed: Byte;
  END;
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = ARRAY [0 .. 0] OF TRGBTriple;
var
  AQRCode: TDelphiZXingQRCode;
  R: Integer;
  c: Integer;
  Line: pRGBTripleArray;

begin
  Result := TBitmap.Create;
  AQRCode := TDelphiZXingQRCode.Create;
  try
    AQRCode.Data := AData;
    AQRCode.Encoding := qrUTF8BOM;
    AQRCode.QuietZone := 2;
    Result.SetSize(AQRCode.Columns, AQRCode.Rows);
    Result.PixelFormat := pf24bit;
    for R := 0 to AQRCode.Rows - 1 do
    begin
      Line := Result.Scanline[R];
      for c := 0 to AQRCode.Columns - 1 do
      begin
        if (AQRCode.IsBlack[R, c]) then
        begin
          Line[c].rgbtBlue := 0;
          Line[c].rgbtGreen := 0;
          Line[c].rgbtRed := 0;
        end
        else
        begin
          Line[c].rgbtBlue := 255;
          Line[c].rgbtGreen := 255;
          Line[c].rgbtRed := 255;
        end;
      end;
    end;
  finally
    FreeAndNil(AQRCode);
  end;
end;

登录