使用TDelphiZXingQRCode控件生成二维码条形码打印到TBitmap位图中，可以把二维码保存到JPG图片中。使用简单，代码如下：
需要的单元：
uses Graphics, Jpeg, DelphiZXingQRCode;
实现代码：
// 根据大小缩放
procedure QRBitmapStretch(SoucreGraphic: TGraphic; ThumbWidth, ThumbHeight: Integer; DestStream: TStream);
var
JpgImg: TJPEGImage;
PTmpBmp: TBitmap;
Rect: TRect;
begin
PTmpBmp := TBitmap.Create();
// 转换为JPG格式
JpgImg := TJPEGImage.Create;
try
Rect.Left := 0;
Rect.Top := 0;
if (ThumbWidth = 0) or (ThumbHeight = 0) then begin
PTmpBmp.Width := SoucreGraphic.Width;
PTmpBmp.Height := SoucreGraphic.Height;
Rect.Right := SoucreGraphic.Width;
Rect.Bottom := SoucreGraphic.Height;
end
else begin
PTmpBmp.Width := ThumbWidth;
PTmpBmp.Height := ThumbHeight;
Rect.Right := ThumbWidth;
Rect.Bottom := ThumbHeight;
end;
PTmpBmp.Canvas.StretchDraw(Rect, SoucreGraphic);
// Ft := JpgImg.PixelFormat;
JpgImg.PixelFormat := jf8bit;
JpgImg.Assign(PTmpBmp);
JpgImg.SaveToStream(DestStream);
finally
JpgImg.Free();
PTmpBmp.Free();
end;
end;
procedure PaintEx(Bitmap: TBitmap; CodeText: string);
var
QRCode: TDelphiZXingQRCode;
Row, Column: Integer;
begin
QRCode := TDelphiZXingQRCode.Create;
try
QRCode.Data := CodeText;
QRCode.Encoding := qrUTF8NoBOM;
QRCode.QuietZone := 1; // 四周空白区域大小
Bitmap.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
Bitmap.Canvas.Pixels[Column, Row] := clBlack;
end
else begin
Bitmap.Canvas.Pixels[Column, Row] := clWhite;
end;
end;
end;
finally
QRCode.Free;
end;
end;
//生成二维码，保存到JPG文件
procedure QRToJpg(W, H: Integer; CodeText: string; JPGFileName: string);
var
DestStream: TMemoryStream;
Bitmap: TBitmap;
begin
if CodeText = '' then
Exit;
Bitmap := TBitmap.Create;
DestStream := TMemoryStream.Create();
try
PaintEx(Bitmap, CodeText);
//
QRBitmapStretch(Bitmap, W, H, DestStream);
//
DestStream.Position := 0;
DestStream.SavetoFile(JPGFileName);
finally
DestStream.Free();
Bitmap.Free();
end;
end;
//调用，生成二维码，并保存到JPG图片中
QRToJpg(200, 200, 'https://www.gaya-soft.cn/download/', 'd:\xtemp\qr.jpg');
TDelphiZXingQRCode控件开源地址为：
TDelphiZXingQRCode源码：
unit DelphiZXingQRCode;
// ZXing QRCode port to Delphi, by Debenu Pty Ltd
// www.debenu.com
// Original copyright notice
(*
* Copyright 2008 ZXing authors
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
*)
interface
type
TQRCodeEncoding = (qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM, qrUTF8BOM);
T2DBooleanArray = array of array of Boolean;
TDelphiZXingQRCode = class
protected
FData: WideString;
FRows: Integer;
FColumns: Integer;
FEncoding: TQRCodeEncoding;
FQuietZone: Integer;
FElements: T2DBooleanArray;
procedure SetEncoding(NewEncoding: TQRCodeEncoding);
procedure SetData(const NewData: WideString);
procedure SetQuietZone(NewQuietZone: Integer);
function GetIsBlack(Row, Column: Integer): Boolean;
procedure Update;
public
constructor Create;
property Data: WideString read FData write SetData;
property Encoding: TQRCodeEncoding read FEncoding write SetEncoding;
property QuietZone: Integer read FQuietZone write SetQuietZone;
property Rows: Integer read FRows;
property Columns: Integer read FColumns;
property IsBlack[Row, Column: Integer]: Boolean read GetIsBlack;
end;
implementation
uses
contnrs, Math, Classes;
type
TByteArray = array of Byte;
T2DByteArray = array of array of Byte;
TIntegerArray = array of Integer;
const
NUM_MASK_PATTERNS = 8;
QUIET_ZONE_SIZE = 4;
ALPHANUMERIC_TABLE: array[0..95] of Integer = (
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x00-0x0f
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x10-0x1f
36, -1, -1, -1, 37, 38, -1, -1, -1, -1, 39, 40, -1, 41, 42, 43, // 0x20-0x2f
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 44, -1, -1, -1, -1, -1, // 0x30-0x3f
-1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, // 0x40-0x4f
25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1 // 0x50-0x5f
);
DEFAULT_BYTE_MODE_ENCODING = 'ISO-8859-1';
POSITION_DETECTION_PATTERN: array[0..6, 0..6] of Integer = (
(1, 1, 1, 1, 1, 1, 1),
(1, 0, 0, 0, 0, 0, 1),
(1, 0, 1, 1, 1, 0, 1),
(1, 0, 1, 1, 1, 0, 1),
(1, 0, 1, 1, 1, 0, 1),
(1, 0, 0, 0, 0, 0, 1),
(1, 1, 1, 1, 1, 1, 1));
HORIZONTAL_SEPARATION_PATTERN: array[0..0, 0..7] of Integer = (
(0, 0, 0, 0, 0, 0, 0, 0));
VERTICAL_SEPARATION_PATTERN: array[0..6, 0..0] of Integer = (
(0), (0), (0), (0), (0), (0), (0));
POSITION_ADJUSTMENT_PATTERN: array[0..4, 0..4] of Integer = (
(1, 1, 1, 1, 1),
(1, 0, 0, 0, 1),
(1, 0, 1, 0, 1),
(1, 0, 0, 0, 1),
(1, 1, 1, 1, 1));
// From Appendix E. Table 1, JIS0510X:2004 (p 71). The table was double-checked by komatsu.
POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE: array[0..39, 0..6] of Integer = (
(-1, -1, -1, -1, -1, -1, -1), // Version 1
( 6, 18, -1, -1, -1, -1, -1), // Version 2
( 6, 22, -1, -1, -1, -1, -1), // Version 3
( 6, 26, -1, -1, -1, -1, -1), // Version 4
( 6, 30, -1, -1, -1, -1, -1), // Version 5
( 6, 34, -1, -1, -1, -1, -1), // Version 6
( 6, 22, 38, -1, -1, -1, -1), // Version 7
( 6, 24, 42, -1, -1, -1, -1), // Version 8
( 6, 26, 46, -1, -1, -1, -1), // Version 9
( 6, 28, 50, -1, -1, -1, -1), // Version 10
( 6, 30, 54, -1, -1, -1, -1), // Version 11
( 6, 32, 58, -1, -1, -1, -1), // Version 12
( 6, 34, 62, -1, -1, -1, -1), // Version 13
( 6, 26, 46, 66, -1, -1, -1), // Version 14
( 6, 26, 48, 70, -1, -1, -1), // Version 15
( 6, 26, 50, 74, -1, -1, -1), // Version 16
( 6, 30, 54, 78, -1, -1, -1), // Version 17
( 6, 30, 56, 82, -1, -1, -1), // Version 18
( 6, 30, 58, 86, -1, -1, -1), // Version 19
( 6, 34, 62, 90, -1, -1, -1), // Version 20
( 6, 28, 50, 72, 94, -1, -1), // Version 21
( 6, 26, 50, 74, 98, -1, -1), // Version 22
( 6, 30, 54, 78, 102, -1, -1), // Version 23
( 6, 28, 54, 80, 106, -1, -1), // Version 24
( 6, 32, 58, 84, 110, -1, -1), // Version 25
( 6, 30, 58, 86, 114, -1, -1), // Version 26
( 6, 34, 62, 90, 118, -1, -1), // Version 27
( 6, 26, 50, 74, 98, 122, -1), // Version 28
( 6, 30, 54, 78, 102, 126, -1), // Version 29
( 6, 26, 52, 78, 104, 130, -1), // Version 30
( 6, 30, 56, 82, 108, 134, -1), // Version 31
( 6, 34, 60, 86, 112, 138, -1), // Version 32
( 6, 30, 58, 86, 114, 142, -1), // Version 33
( 6, 34, 62, 90, 118, 146, -1), // Version 34
( 6, 30, 54, 78, 102, 126, 150), // Version 35
( 6, 24, 50, 76, 102, 128, 154), // Version 36
( 6, 28, 54, 80, 106, 132, 158), // Version 37
( 6, 32, 58, 84, 110, 136, 162), // Version 38
( 6, 26, 54, 82, 110, 138, 166), // Version 39
( 6, 30, 58, 86, 114, 142, 170) // Version 40
);
// Type info cells at the left top corner.
TYPE_INFO_COORDINATES: array[0..14, 0..1] of Integer = (
(8, 0),
(8, 1),
(8, 2),
(8, 3),
(8, 4),
(8, 5),
(8, 7),
(8, 8),
(7, 8),
(5, 8),
(4, 8),
(3, 8),
(2, 8),
(1, 8),
(0, 8)
);
// From Appendix D in JISX0510:2004 (p. 67)
VERSION_INFO_POLY = $1f25; // 1 1111 0010 0101
// From Appendix C in JISX0510:2004 (p.65).
TYPE_INFO_POLY = $537;
TYPE_INFO_MASK_PATTERN = $5412;
VERSION_DECODE_INFO: array[0..33] of Integer = (
$07C94, $085BC, $09A99, $0A4D3, $0BBF6,
$0C762, $0D847, $0E60D, $0F928, $10B78,
$1145D, $12A17, $13532, $149A6, $15683,
$168C9, $177EC, $18EC4, $191E1, $1AFAB,
$1B08E, $1CC1A, $1D33F, $1ED75, $1F250,
$209D5, $216F0, $228BA, $2379F, $24B0B,
$2542E, $26A64, $27541, $28C69);
type
TMode = (qmTerminator, qmNumeric, qmAlphanumeric, qmStructuredAppend,
qmByte, qmECI, qmKanji, qmFNC1FirstPosition, qmFNC1SecondPosition,
qmHanzi);
const
ModeCharacterCountBits: array[TMode] of array[0..2] of Integer = (
(0, 0, 0), (10, 12, 14), (9, 11, 13), (0, 0, 0), (8, 16, 16),
(0, 0, 0), (8, 10, 12), (0, 0, 0), (0, 0, 0), (8, 10, 12));
ModeBits: array[TMode] of Integer = (0, 1, 2, 3, 4, 7, 8, 5, 9, 13);
type
TErrorCorrectionLevel = class
private
FBits: Integer;
public
procedure Assign(Source: TErrorCorrectionLevel);
function Ordinal: Integer;
property Bits: Integer read FBits;
end;
TECB = class
private
Count: Integer;
DataCodewords: Integer;
public
constructor Create(Count, DataCodewords: Integer);
function GetCount: Integer;
function GetDataCodewords: Integer;
end;
TECBArray = array of TECB;
TECBlocks = class
private
ECCodewordsPerBlock: Integer;
ECBlocks: TECBArray;
public
constructor Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB); overload;
constructor Create(ECCodewordsPerBlock: Integer; ECBlocks1, ECBlocks2: TECB); overload;
destructor Destroy; override;
function GetTotalECCodewords: Integer;
function GetNumBlocks: Integer;
function GetECCodewordsPerBlock: Integer;
function GetECBlocks: TECBArray;
end;
TByteMatrix = class
protected
Bytes: T2DByteArray;
FWidth: Integer;
FHeight: Integer;
public
constructor Create(Width, Height: Integer);
function Get(X, Y: Integer): Integer;
procedure SetBoolean(X, Y: Integer; Value: Boolean);
procedure SetInteger(X, Y: Integer; Value: Integer);
function GetArray: T2DByteArray;
procedure Assign(Source: TByteMatrix);
procedure Clear(Value: Byte);
function Hash: AnsiString;
property Width: Integer read FWidth;
property Height: Integer read FHeight;
end;
TBitArray = class
private
Bits: array of Integer;
Size: Integer;
procedure EnsureCapacity(Size: Integer);
public
constructor Create; overload;
constructor Create(Size: Integer); overload;
function GetSizeInBytes: Integer;
function GetSize: Integer;
function Get(I: Integer): Boolean;
procedure SetBit(Index: Integer);
procedure AppendBit(Bit: Boolean);
procedure AppendBits(Value, NumBits: Integer);
procedure AppendBitArray(NewBitArray: TBitArray);
procedure ToBytes(BitOffset: Integer; Source: TByteArray; Offset,
NumBytes: Integer);
procedure XorOperation(Other: TBitArray);
end;
TCharacterSetECI = class
end;
TVersion = class
private
VersionNumber: Integer;
AlignmentPatternCenters: array of Integer;
ECBlocks: array of TECBlocks;
TotalCodewords: Integer;
ECCodewords: Integer;
public
constructor Create(VersionNumber: Integer; AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3, ECBlocks4: TECBlocks);
destructor Destroy; override;
class function GetVersionForNumber(VersionNum: Integer): TVersion;
class function ChooseVersion(NumInputBits: Integer; ecLevel: TErrorCorrectionLevel): TVersion;
function GetTotalCodewords: Integer;
function GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
function GetDimensionForVersion: Integer;
end;
TMaskUtil = class
public
function GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
end;
TQRCode = class
private
FMode: TMode;
FECLevel: TErrorCorrectionLevel;
FVersion: Integer;
FMatrixWidth: Integer;
FMaskPattern: Integer;
FNumTotalBytes: Integer;
FNumDataBytes: Integer;
FNumECBytes: Integer;
FNumRSBlocks: Integer;
FMatrix: TByteMatrix;
FQRCodeError: Boolean;
public
constructor Create;
destructor Destroy; override;
function At(X, Y: Integer): Integer;
function IsValid: Boolean;
function IsValidMaskPattern(MaskPattern: Integer): Boolean;
procedure SetMatrix(NewMatrix: TByteMatrix);
procedure SetECLevel(NewECLevel: TErrorCorrectionLevel);
procedure SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks, NumECBytes, MatrixWidth: Integer);
property QRCodeError: Boolean read FQRCodeError;
property Mode: TMode read FMode write FMode;
property Version: Integer read FVersion write FVersion;
property NumDataBytes: Integer read FNumDataBytes;
property NumTotalBytes: Integer read FNumTotalBytes;
property NumRSBlocks: Integer read FNumRSBlocks;
property MatrixWidth: Integer read FMatrixWidth;
property MaskPattern: Integer read FMaskPattern write FMaskPattern;
property ECLevel: TErrorCorrectionLevel read FECLevel;
end;
TMatrixUtil = class
private
FMatrixUtilError: Boolean;
procedure ClearMatrix(Matrix: TByteMatrix);
procedure EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix);
procedure EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix);
procedure MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix);
procedure EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix);
function FindMSBSet(Value: Integer): Integer;
function CalculateBCHCode(Value, Poly: Integer): Integer;
procedure MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray);
procedure MakeVersionInfoBits(Version: Integer; Bits: TBitArray);
function IsEmpty(Value: Integer): Boolean;
procedure EmbedTimingPatterns(Matrix: TByteMatrix);
procedure EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix);
procedure EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
procedure EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
procedure EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
procedure EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
procedure EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix);
procedure MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix);
public
constructor Create;
property MatrixUtilError: Boolean read FMatrixUtilError;
procedure BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel; Version, MaskPattern: Integer; Matrix: TByteMatrix);
end;
function GetModeBits(Mode: TMode): Integer;
begin
Result := ModeBits[Mode];
end;
function GetModeCharacterCountBits(Mode: TMode; Version: TVersion): Integer;
var
Number: Integer;
Offset: Integer;
begin
Number := Version.VersionNumber;
if (Number <= 9) then
begin
Offset := 0;
end else
if (number <= 26) then
begin
Offset := 1;
end else
begin
Offset := 2;
end;
Result := ModeCharacterCountBits[Mode][Offset];
end;
type
TBlockPair = class
private
FDataBytes: TByteArray;
FErrorCorrectionBytes: TByteArray;
public
constructor Create(BA1, BA2: TByteArray);
function GetDataBytes: TByteArray;
function GetErrorCorrectionBytes: TByteArray;
end;
TGenericGFPoly = class;
TGenericGF = class
private
FExpTable: TIntegerArray;
FLogTable: TIntegerArray;
FZero: TGenericGFPoly;
FOne: TGenericGFPoly;
FSize: Integer;
FPrimitive: Integer;
FGeneratorBase: Integer;
FInitialized: Boolean;
FPolyList: array of TGenericGFPoly;
procedure CheckInit;
procedure Initialize;
public
class function CreateQRCodeField256: TGenericGF;
class function AddOrSubtract(A, B: Integer): Integer;
constructor Create(Primitive, Size, B: Integer);
destructor Destroy; override;
function GetZero: TGenericGFPoly;
function Exp(A: Integer): Integer;
function GetGeneratorBase: Integer;
function Inverse(A: Integer): Integer;
function Multiply(A, B: Integer): Integer;
function BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
end;
TGenericGFPolyArray = array of TGenericGFPoly;
TGenericGFPoly = class
private
FField: TGenericGF;
FCoefficients: TIntegerArray;
public
constructor Create(AField: TGenericGF; ACoefficients: TIntegerArray);
destructor Destroy; override;
function Coefficients: TIntegerArray;
function Multiply(Other: TGenericGFPoly): TGenericGFPoly;
function MultiplyByMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
function Divide(Other: TGenericGFPoly): TGenericGFPolyArray;
function GetCoefficients: TIntegerArray;
function IsZero: Boolean;
function GetCoefficient(Degree: Integer): Integer;
function GetDegree: Integer;
function AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly;
end;
TReedSolomonEncoder = class
private
FField: TGenericGF;
FCachedGenerators: TObjectList;
public
constructor Create(AField: TGenericGF);
destructor Destroy; override;
procedure Encode(ToEncode: TIntegerArray; ECBytes: Integer);
function BuildGenerator(Degree: Integer): TGenericGFPoly;
end;
TEncoder = class
private
FEncoderError: Boolean;
function ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix;
IsHorizontal: Boolean): Integer;
function ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode; overload;
function FilterContent(const Content: WideString; Mode: TMode; EncodeOptions: Integer): WideString;
procedure Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer);
procedure AppendAlphanumericBytes(const Content: WideString;
Bits: TBitArray);
procedure AppendBytes(const Content: WideString; Mode: TMode;
Bits: TBitArray; EncodeOptions: Integer);
procedure AppendKanjiBytes(const Content: WideString; Bits: TBitArray);
procedure AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode;
Bits: TBitArray);
procedure AppendModeInfo(Mode: TMode; Bits: TBitArray);
procedure AppendNumericBytes(const Content: WideString; Bits: TBitArray);
function ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel;
Version: Integer; Matrix: TByteMatrix): Integer;
function GenerateECBytes(DataBytes: TByteArray;
NumECBytesInBlock: Integer): TByteArray;
function GetAlphanumericCode(Code: Integer): Integer;
procedure GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes,
NumDataBytes, NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray;
var NumECBytesInBlock: TIntegerArray);
procedure InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes,
NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray);
//function IsOnlyDoubleByteKanji(const Content: WideString): Boolean;
procedure TerminateBits(NumDataBytes: Integer; var Bits: TBitArray);
function CalculateMaskPenalty(Matrix: TByteMatrix): Integer;
function ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer;
function ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer;
function ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer;
function ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer;
//procedure Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode); overload;
procedure Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
public
constructor Create;
property EncoderError: Boolean read FEncoderError;
end;
function TEncoder.ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer;
begin
Result := ApplyMaskPenaltyRule1Internal(Matrix, True) +
ApplyMaskPenaltyRule1Internal(Matrix, False);
end;
// Apply mask penalty rule 2 and return the penalty. Find 2x2 blocks with the same color and give
// penalty to them.
function TEncoder.ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer;
var
Penalty: Integer;
TheArray: T2DByteArray;
Width: Integer;
Height: Integer;
X: Integer;
Y: Integer;
Value: Integer;
begin
最低0.47元/天 解锁文章
扫一扫
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
