Delphi7下生成二維碼，在線等
uj5u.com熱心網友回復：
雖然D現在不火了，但是 這個資料還是很好搜到的啊.......
uj5u.com熱心網友回復：
有個控制元件 ZXingQRCodeForm檔案：
object Form1: TForm1
Left = 306
Top = 148
BorderStyle = bsDialog
Caption = 'Form1'
ClientHeight = 300
ClientWidth = 570
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 13
Width = 21
Height = 13
Caption = 'Text'
end
object Label2: TLabel
Left = 8
Top = 69
Width = 45
Height = 13
Caption = 'Encoding'
end
object Label3: TLabel
Left = 184
Top = 69
Width = 51
Height = 13
Caption = 'Quiet zone'
end
object Label4: TLabel
Left = 296
Top = 13
Width = 38
Height = 13
Caption = 'Preview'
end
object PaintBox1: TPaintBox
Left = 296
Top = 30
Width = 242
Height = 242
PopupMenu = PopupMenu1
OnPaint = PaintBox1Paint
end
object Image1: TImage
Left = 296
Top = 30
Width = 256
Height = 256
PopupMenu = PopupMenu1
Transparent = True
end
object edtText: TEdit
Left = 8
Top = 32
Width = 265
Height = 21
TabOrder = 0
Text = 'Hello world'
OnChange = edtTextChange
end
object cmbEncoding: TComboBox
Left = 8
Top = 88
Width = 145
Height = 21
Style = csDropDownList
ItemHeight = 13
ItemIndex = 0
TabOrder = 1
Text = 'Auto'
OnChange = edtTextChange
Items.Strings = (
'Auto'
'Numeric'
'Alphanumeric'
'ISO-8859-1'
'UTF-8 without BOM'
'UTF-8 with BOM')
end
object edtQuietZone: TEdit
Left = 184
Top = 88
Width = 89
Height = 21
TabOrder = 2
Text = '1'
OnChange = edtTextChange
end
object PopupMenu1: TPopupMenu
Left = 208
Top = 144
object N1: TMenuItem
Caption = '保存二維碼'
OnClick = N1Click
end
end
object SavePictureDialog1: TSavePictureDialog
Left = 256
Top = 200
end
end
uj5u.com熱心網友回復：
代碼檔案：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DelphiZXingQRCode, StdCtrls, ExtCtrls, Menus, ExtDlgs;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
edtText: TEdit;
cmbEncoding: TComboBox;
edtQuietZone: TEdit;
Label4: TLabel;
PaintBox1: TPaintBox;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
SavePictureDialog1: TSavePictureDialog;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure edtTextChange(Sender: TObject);
procedure N1Click(Sender: TObject);
private
QRCodeBitmap: TBitmap;
procedure UpdateQRCode;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
QRCodeBitmap := TBitmap.Create;
UpdateQRCode;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
QRCodeBitmap.Free;
end;
procedure TForm1.UpdateQRCode;
var
QRCode: TDelphiZXingQRCode;
Row, Col: Integer;
begin
QRCode := TDelphiZXingQRCode.Create;
try
QRCode.Data := Trim(edtText.Text);
QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex);
QRCode.QuietZone := StrToIntDef(Trim(edtQuietZone.Text), 4);
QRCodeBitmap.Height := QRCode.Rows;
QRCodeBitmap.Width := QRCode.Columns;
for Row:=0 to QRCodeBitmap.Height-1 do
begin
for Col:=0 to QRCodeBitmap.Width-1 do
begin
if (QRCode.IsBlack[Row, Col]) then
begin
QRCodeBitmap.Canvas.Pixels[Col, Row] := clBlack;
end else
begin
QRCodeBitmap.Canvas.Pixels[Col, Row] := clWhite;
end;
end;
end;
finally
QRCode.Free;
end;
Image1.Stretch := True;
Image1.Picture.Bitmap := QRCodeBitmap;
//PaintBox1.Repaint;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
//var
// Scale: Double;
begin
// PaintBox1.Canvas.Brush.Color := clWhite;
// PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.Width, PaintBox1.Height));
// if ((QRCodeBitmap.Width > 0) and (QRCodeBitmap.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 TForm1.edtTextChange(Sender: TObject);
begin
//
UpdateQRCode;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
with SavePictureDialog1 do
begin
Filter := 'Bmp檔案(*.bmp)|*.bmp|Png檔案(*.png)|*.png';
case FilterIndex of
1: DefaultExt := 'bmp';
2: DefaultExt := 'png';
end;
if Execute then
begin
// Image1.Picture.Bitmap.SaveToFile(FileName);
QRCodeBitmap.SaveToFile(FileName);
end;
end;
end;
end.
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/20814.html
上一篇：C 實戰練習題目28
下一篇：C 實戰練習題目29