来源于https://blog.csdn.net/qq_44111597/article/details/108359774

Delphi用ZXIng 生成二维码【PaintBox】并保存为本地文件添加至【Image】控件中

生成二维码,也可以用DevExporess dxBarCode1书号二维码的生成(15)   (07)FastReport书码ISBN的添加显示,类似地二维码也可以

效果图:


 

 需要声明:uses DelphiZXIngQRCode;
下载地址:

链接:https://pan.baidu.com/s/1P0nh7bTFaLuGrMT3NyUF0Q
提取码:wtzs

【同时记得把路径也添加了,能搜索到就行,不管用哪种方法】

 private
    QRCodeBitmap: TBitmap;
  public
    procedure Update;
//窗体的 OnCreate事件 和 OnDestroy事件:

procedure TForm1.FormCreate(Sender: TObject);                                 // 窗体创建
begin
  QRCodeBitmap := TBitmap.Create;                                             // 代码图位
  Update;
end;

procedure TForm1.FormDestroy(Sender: TObject);                                // 窗体销毁
begin
  QRCodeBitmap.Free;
end;
//PaintBox的 OnPaint事件:

procedure TForm1.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;
    { StretchDraw(Rect, Jpg); }
    { Rect:是你要画的区域(你要放大就设置的大一些,缩小就设置的小一些) }
    { Jpg:是要画的东西(我这里只是用Jpg文件做例子) }
    PaintBox1.Canvas.StretchDraw(Rect(0, 0, Trunc(Scale * QRCodeBitmap.Width), Trunc(Scale * QRCodeBitmap.Height)), QRCodeBitmap);
  end;
end;
//自己声明的 Updata方法:
procedure TForm1.Update;
var
  QRCode: TDelphiZXingQRCode;
  Column, Row: Integer;
begin
  QRCode := TDelphiZXingQRCode.Create;
  try
    QRCode.Data := scEdit1.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;
//就目前上面的代码就已经可以实现生成二维码了,还可以在 scEdit的 OnChange事件中添加 Update方法

procedure TForm1.scEdit1Change(Sender: TObject);
begin
  Update;
end;

 

//下面就是吧 PaintBox中的内容保存至本地以及添加到 Image控件中
procedure SaveBmpFromPaintBox(pbox: TPaintBox; fn: string);
var
  bmp: TBitmap;
  r: TRect;
begin
  bmp := TBitmap.Create;                                                      // 创建图位
  bmp.Width := pbox.Width;                                                    // 图位宽 = 盒子宽度
  bmp.Height := pbox.Height;                                                  // 图位高 = 盒子高度
  try
    r := Rect(0, 0, pbox.Height, pbox.Width);                                 // 矩形图的 左上右下 四边
    { 如果图象一【r1】的选取区域小于图象二【r2】中的选取区域,那么图一【r1】选取区域中的图象,
    拉伸填充到图象二【r2】中的选取区域。(图象区域相同的复制不会造成图象失真,如果变大或者变小,就容易造成失真) }
    bmp.Canvas.CopyRect(r, pbox.Canvas, r); { 两个 r 在上面分别用【r1、r2】表示(从左至右),中间参数为拷贝内容 }
    bmp.SaveToFile(fn);                                                       // 文件保存地址
  finally
    FreeAndNil(bmp);
  end;
end;

procedure TForm1.scGPButton2Click(Sender: TObject);
begin
  SaveBmpFromPaintBox(paintbox1, 'd:\test.bmp');                              // 保存到本地 【需要改成jpg或png的直接改文件的后缀即可】
  Image1.Picture.LoadFromFile('d:\test.bmp');                                 // 本地图片展示到 Image 上
end;