unit DelphiZXingQRCodeTestAppMainForm; // Demo app for ZXing QRCode port to Delphi, by Debenu Pty Ltd (www.debenu.com) // Need a PDF SDK? Checkout Debenu Quick PDF Library: http://www.debenu.com/products/development/debenu-pdf-library/ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DelphiZXingQRCode, ExtCtrls, StdCtrls; type TForm1 = class(TForm) edtText: TEdit; Label1: TLabel; cmbEncoding: TComboBox; Label2: TLabel; Label3: TLabel; edtQuietZone: TEdit; Label4: TLabel; PaintBox1: TPaintBox; procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); procedure PaintBox1Paint(Sender: TObject); procedure edtTextChange(Sender: TObject); procedure cmbEncodingChange(Sender: TObject); procedure edtQuietZoneChange(Sender: TObject); private QRCodeBitmap: TBitmap; public procedure Update; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.cmbEncodingChange(Sender: TObject); begin Update; end; procedure TForm1.edtQuietZoneChange(Sender: TObject); begin Update; end; procedure TForm1.edtTextChange(Sender: TObject); begin Update; end; procedure TForm1.FormCreate(Sender: TObject); begin QRCodeBitmap := TBitmap.Create; edtText.Text := 'BEGIN:VCARD' + #13#10 + 'VERSION:3.0' + #13#10 + 'FN:张志林' + #13#10 + 'TEL;CELL:9999999' + #13#10 + 'ORG:网易研发部' + #13#10 + 'TITLE:技术总监' + #13#10 + 'TEL;WORK:123456789' + #13#10 + 'TEL;WORK:987654321' + #13#10 + 'EMAIL:zhangzhilin@sina.com' + #13#10 + 'END:VCARD' + #13#10; Update; end; procedure TForm1.FormDestroy(Sender: TObject); begin QRCodeBitmap.Free; 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.Update; var QRCode: TDelphiZXingQRCode; Row, Column: Integer; begin QRCode := TDelphiZXingQRCode.Create; try QRCode.Data := edtText.Text; QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex); QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 4); QRCodeBitmap.SetSize(QRCode.Rows, QRCode.Columns); 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] := clBlack; end else begin QRCodeBitmap.Canvas.Pixels[Column, Row] := clWhite; end; end; end; finally QRCode.Free; end; PaintBox1.Repaint; end; end.