盒子论坛 v2.1

各位前辈：

    最近在折腾二维码的问题，在网上查了一些资料，倒是可以弄出来了，但问题也存在，在VCL模式下，二维码清晰没有问题，但在FMX模式下，二维码就很模糊，不知如何处理，请大家指点一下，谢谢。

下面是FMX模式下的代码，使用的是DelphiZXingQRCode模块

procedure PaintQrCode(Bitmap: TBitmap; CodeText: string);
var
  QRCode: TDelphiZXingQRCode;
  Row, Column: Integer;
  QrCodeBmpData : TBitmapData;

begin
  QRCode := TDelphiZXingQRCode.Create;
  try
    QRCode.Data := CodeText;
    QRCode.Encoding := qrAuto;
    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;

procedure TForm2.Button1Click(Sender: TObject);
begin
    PaintQrCode(Image1.Bitmap,Memo1.Text);
end;

此帖子包含附件:

大小:158.5K

----------------------------------------------
【个人签名】：玩了多年DELPHI,终于从菜鸟升级成老菜鸟

作者：

changfenglee (葫芦老四)	★☆☆☆☆	-
	普通会员

2024/4/27 13:23:05

1楼：

而在VCL模式下，二维码就非常清楚，如下所示：
procedure TForm2.PaintBox1Paint(Sender: TObject);
var
  Scale: Double;
begin
  PaintBox1.Canvas.Brush.Color := clRed;          // 背景颜色
  PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.Height, PaintBox1.Width));   // 填充矩形
  if ((PaintBox1.Width > 0) and (PaintBox1.Height > 0)) then
  begin
    if PaintBox1.Width < PaintBox1.Height then
    begin
      Scale := PaintBox1.Width / QRCodeBitmap.Width;
    end
    else
    begin
      Scale := PaintBox1.Height / QRCodeBitmap.Height;
    end;

    PaintBox1.Canvas.StretchDraw(Rect(0, 0, Trunc(Scale * QRCodeBitmap.Width), Trunc(Scale * QRCodeBitmap.Height)), QRCodeBitmap);
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  QRCode: TDelphiZXingQRCode;
  Column, Row: Integer;
begin
  QRCode := TDelphiZXingQRCode.Create;
  try
    QRCode.Data := Edit1.Text;          // 数据
    QRCode.Encoding := TQRCodeEncoding(5);          // 编码方式【qrUTF8BOM】
    QRCode.QuietZone :=  1          ;          // 边框区域
    QRCodeBitmap.SetSize(QRCode.Rows, QRCode.Columns);          // 设定大小
    {【Row：行  ;  Column：列】}
    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
          QRCodeBitmap.Canvas.Pixels[Column, Row] := clGreen;          // 是的就给画布画上绿色
        end else begin
          QRCodeBitmap.Canvas.Pixels[Column, Row] := clWhite;          // 否则就画白色
        end;
      end;
    end;
  finally
    QRCode.Free;
  end;
  PaintBox1.Repaint;

end;

此帖子包含附件:

大小:29.5K

----------------------------------------------
【个人签名】：玩了多年DELPHI,终于从菜鸟升级成老菜鸟

作者：

sail2000 (小帆工作室)	★☆☆☆☆	-
	盒子活跃会员

2024/4/27 15:13:57

2楼：

https://www.cnblogs.com/qiufeng2014/p/4281761.html

http://zarko-gajic.iz.hr/firemonkey-mobile-android-ios-qr-code-generation-using-delphi-xe-5-delphizxingqrcode/
----------------------------------------------
delphi 是兴趣，和工作无关，即使它倒闭。又不靠它 delphi 吃饭，怕甚？

作者：

changfenglee (葫芦老四)	★☆☆☆☆	-
	普通会员

2024/4/27 15:51:24

3楼：

先感谢 sail2000 的指点，目前我在Delphi 11的环境下按您的链接代码做了一些小修改，可以编译通过了，但会报错，代码和错误图示如下：

procedure TForm2.Button1Click(Sender: TObject);
begin
   CreateQRCode(image1,Edit1.Text);
end;

procedure TForm2.CreateQRCode(imgQRCode:TImage;QRText:string);
const
    downsizeQuality: Integer = 2; // bigger value, better quality, slower rendering
  var
    QRCode: TDelphiZXingQRCode;
    Row, Column: Integer;
    pixelColor : TAlphaColor;
    vBitMapData : TBitmapData;
    pixelCount, y, x: Integer;
    columnPixel, rowPixel: Integer;
    function GetPixelCount(AWidth, AHeight: Single): Integer;
    begin
      if QRCode.Rows > 0 then
        Result := Trunc(Min(AWidth, AHeight)) div QRCode.Rows
      else
        Result := 0;
    end;
  begin
    QRCode := TDelphiZXingQRCode.Create;
    try
      QRCode.Data := QRText;
      QRCode.Encoding := TQRCodeEncoding.qrAuto;
      QRCode.QuietZone := StrToIntDef('4', 4);
      pixelCount := GetPixelCount(imgQRCode.Width, imgQRCode.Height);
      case imgQRCode.WrapMode of
        TImageWrapMode.Original,TImageWrapMode.Tile,TImageWrapMode.Center:
        begin
          if pixelCount > 0 then
          imgQRCode.Bitmap.SetSize(QRCode.Columns * pixelCount,
          QRCode.Rows * pixelCount);
        end;
        TImageWrapMode.Fit:
        begin
          if pixelCount > 0 then
          begin
          imgQRCode.Bitmap.SetSize(QRCode.Columns * pixelCount * downsizeQuality,
          QRCode.Rows * pixelCount * downsizeQuality);
          pixelCount := pixelCount * downsizeQuality;
          end;
        end;
        TImageWrapMode.Stretch:
          raise Exception.Create('Not a good idea to stretch the QR Code');
      end;

        try
          imgQRCode.Bitmap.Canvas.Clear(TAlphaColors.White);
          if pixelCount > 0 then
          begin
          if imgQRCode.Bitmap.Map(TMapAccess.Write, vBitMapData)  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
          pixelColor := TAlphaColors.Black
          else
          pixelColor := TAlphaColors.White;
          columnPixel := Column * pixelCount;
          rowPixel := Row * pixelCount;
          for x := 0 to pixelCount - 1 do
          for y := 0 to pixelCount - 1 do
          vBitMapData.SetPixel(columnPixel + x,
          rowPixel + y, pixelColor);
          end;
          end;
          finally
          imgQRCode.Bitmap.Unmap(vBitMapData);
          end;
          end;
         end;
       finally

       end;
   finally
     QRCode.Free;
   end;

end;

此帖子包含附件:

大小:20.8K

----------------------------------------------
【个人签名】：玩了多年DELPHI,终于从菜鸟升级成老菜鸟

作者：

changfenglee (葫芦老四)	★☆☆☆☆	-
	普通会员

2024/4/27 16:53:05

4楼：

问题解决了，代码修改如下：

procedure TForm2.CreateQRCode(imgQRCode:TImage;QRText:string);
const
    downsizeQuality: Integer = 2;
  var
    QRCode: TDelphiZXingQRCode;
    Row, Column: Integer;
    pixelColor : TAlphaColor;
    vBitMapData : TBitmapData;
    pixelCount, y, x: Integer;
    columnPixel, rowPixel: Integer;
    function GetPixelCount(AWidth, AHeight: Single): Integer;
    begin
      if QRCode.Rows > 0 then
        Result := Trunc(Min(AWidth, AHeight)) div QRCode.Rows
      else
        Result := 0;
    end;
  begin
    QRCode := TDelphiZXingQRCode.Create;

    try
      QRCode.Data := QRText;
      QRCode.Encoding := TQRCodeEncoding.qrISO88591;
      QRCode.QuietZone := StrToIntDef('4', 4);
      pixelCount := GetPixelCount(imgQRCode.Width, imgQRCode.Height);

      case imgQRCode.WrapMode of
        TImageWrapMode.Original,TImageWrapMode.Tile,TImageWrapMode.Center:
        begin
          if pixelCount > 0 then
          imgQRCode.Bitmap.SetSize(QRCode.Columns * pixelCount,
          QRCode.Rows * pixelCount);
        end;
        TImageWrapMode.Fit:
        begin
          if pixelCount > 0 then
          begin
          imgQRCode.Bitmap.SetSize(QRCode.Columns * pixelCount * downsizeQuality,
          QRCode.Rows * pixelCount * downsizeQuality);
          pixelCount := pixelCount * downsizeQuality;
          end;
        end;
        TImageWrapMode.Stretch:
          raise Exception.Create('Not a good idea to stretch the QR Code');
      end;

        imgQRCode.Bitmap.Canvas.BeginScene;     //增加这一句

        try

       //取消这一句   imgQRCode.Bitmap.Canvas.ClearRect(TRectF.Create(0, 0, imgQRCode.Width, imgQRCode.Height),TAlphaColors.White);

          if pixelCount > 0 then
          begin
          if imgQRCode.Bitmap.Map(TMapAccess.Write, vBitMapData)  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
          pixelColor := TAlphaColors.Black
          else
          pixelColor := TAlphaColors.White;
          columnPixel := Column * pixelCount;
          rowPixel := Row * pixelCount;

          for x := 0 to pixelCount - 1 do
          for y := 0 to pixelCount - 1 do
          vBitMapData.SetPixel(columnPixel + x,rowPixel + y, pixelColor);
          end;
          end;
          finally
          imgQRCode.Bitmap.Unmap(vBitMapData);
          end;
          end;
         end;
       finally

       end;
   finally
     QRCode.Free;
     imgQRCode.Bitmap.Canvas.EndScene;   //增加这一句
   end;

end;
----------------------------------------------
【个人签名】：玩了多年DELPHI,终于从菜鸟升级成老菜鸟

作者：

changfenglee (葫芦老四)	★☆☆☆☆	-
	普通会员

2024/4/27 16:54:31

5楼：

代码修改以后可以正常生成二维码：

测试环境：DELPHI 11 + WINDOWS11

此帖子包含附件:

大小:21.2K

----------------------------------------------
【个人签名】：玩了多年DELPHI,终于从菜鸟升级成老菜鸟

作者：

akai1203 (w-dins)	★☆☆☆☆	-
	普通会员

2024/4/27 22:14:48

6楼：

不错
----------------------------------------------
-把学习当信仰

作者：

dacsd (ddd)	★☆☆☆☆	-
	盒子活跃会员

2024/4/28 8:29:22

7楼：

不错，受教了。
----------------------------------------------
-

作者：

delphiteacher (delphiteacher)	▲▲▲▲▲	-
	普通会员

2024/4/30 13:44:57

8楼：

手机屏幕分辨率比较高，你生成二维码图片的时候，尺寸放大个2~3倍即可。
----------------------------------------------
欢迎加入OrangeUI的app开发阵营：http://www.orangeui.cn/,联系QQ452330643

信息

登陆以后才能回复