来源于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;