Delphi7下生成二维码

[oicq111]

Delphi7下生成二维码，在线等

[CCDDzclxy]

虽然D现在不火了，但是 这个资料还是很好搜到的啊.......

[风与夕阳]

有个控件 ZXingQRCode
Form文件：

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

[风与夕阳]

代码文件：

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.