請教各位前輩
因為需要產生RQcode 放在 Image 顯示
請問有沒有完整的 範例可以參考
請各位指點
我的環境是 Delphi7

感激不盡

http://delphi.ktop.com.tw/board.php?cid=31&fid=97&tid=110082

你先研究看看, 有問題再上來
我使用在delphi5上ok, delphi7應該也可行
這不是元件, 是 pas, 所以無須安裝, 你只要把ZintInterface.pas uses 進來,
再看它的sample 應該可以了解更多!

//引用ZXing QRCode port to Delphi, by Debenu Pty Ltd (www.debenu.com)
範例:delphi7 - XE10.2
procedure TForm1.Button1Click(Sender: TObject);
var QRec:TQRCodeSetupRec;
begin
QRec :=QRCodeSetupRecInit;
QRec.Scale:=3;
QRec.Encodeing:=0;
QRec.QuietZone:=4;
MakeQRCode(Image1.Picture.Bitmap,'我的QRCODE',QRec);
end;

//以下3支pas

//unit CmjBarcodeLib;

//unit CmjBarcode;

//unit CmjQRCode;

//*************************************************************************
unit CmjBarcodeLib;

interface

uses Classes,Types,Sysutils,TypInfo,

Graphics,ExtCtrls,dialogs,

CmjBarcode,CmjQRCode;

Type
TQRCodeSetupRec = record
Scale:Integer; //比例
Encodeing:Integer; //0:Auto Numeric 1:Alphanumeric 2:ISO-8859-1
//3:UTF-8 4:without 5:BOM UTF-8 with BOM
QuietZone:Integer; //Default 4
end;
TBarCodeSetupRec = record
Height:Integer; //尺寸倍數 Default 3
Modul:Integer;
Ratio:Integer; //比例
CodeType:Integer; //3: bcCode39; //TBarcodeType(BarType);
CheckSum:Boolean; //Checksum;
showText:Integer; //0:bcoNone, 1:bcoCode, 2:bcoTyp, 3:bcoBoth
Angle:Integer; //Angle;
end;

Const
QRCodeSetupRecInit: TQRCodeSetupRec =
( Scale:3;
Encodeing:0;
QuietZone:4;
);
BarCodeSetupRecInit: TBarCodeSetupRec =
( Height:30;
Modul:1;
Ratio:2; //比例
CodeType:3; //3: bcCode39; //TBarcodeType(BarType);
CheckSum:False; //Checksum;
showText:1;
Angle:0; //Angle;
);


procedure MakeQrCode(QRCodeBitmap:TBitmap;Code:String;QRCodeSetupRec:TQRCodeSetupRec);

Procedure MakeBarcode(Picture:TPicture;Code:String;BarCodeSetupRec:TBarCodeSetupRec);
procedure GetTypeStrList(enum: PTypeInfo; list: TStrings); //取Enum所有值之字串

Procedure GetBarcodeTypeList(List:TStrings);

//--------


//var QRCodeSetupRec:TQRCodeSetupRec; //二維條碼設定值
// BarCodeSetupRec:TBarCodeSetupRec; //一維條碼設定值

//由字串轉為列舉 定義在 TypInfo
//function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
//Example: TFieldType( GetEnumValue(TypeInfo(TFieldType) , 'ftInteger') );

//由列舉轉為字串
//function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
// GetEnumName( TypeInfo(TFieldType) , Ord(ftInteger) );

implementation

Procedure GetBarcodeTypeList(List:TStrings);
begin
GetTypeStrList(TypeInfo(TBarcodeType),List);
end;

procedure GetTypeStrList(enum: PTypeInfo; list: TStrings); //取Enum所有值之字串
var
data: PTypeData;
i: integer;
begin
list.clear;
data := GetTypeData(GetTypeData(enum)^.BaseType^);
for i := 0 to data.MaxValue do
list.add(GetEnumName(enum, i));
end;

Function DeleteCtrl(ss:String):String;
var i:integer;
begin
for i:=length(ss) downto 1 do
begin
if ss[i] in [#13,#10] then
delete(ss,i,1);
end;
Result:=ss;
end;


function ScalePercentBmp(bitmp: TBitmap; iPercent: Integer): Boolean; //
var
TmpBmp: TBitmap;
ARect: TRect;
h, w: Real;
hi, wi: Integer;
begin
Result := False;
try
TmpBmp := TBitmap.Create;
try
h := bitmp.Height * iPercent; // (iPercent / 100);
w := bitmp.Width * iPercent; //(iPercent / 100);
hi := StrToInt(FormatFloat('#', h)) bitmp.Height;
wi := StrToInt(FormatFloat('#', w)) bitmp.Width;
TmpBmp.Width := wi;
TmpBmp.Height := hi;
ARect := Rect(0, 0, wi, hi);
TmpBmp.Canvas.StretchDraw(ARect, Bitmp);
bitmp.Assign(TmpBmp);
finally
TmpBmp.Free;
end;
Result := True;
except
Result := False;
end;
end;

procedure MakeQrCode(QRCodeBitmap:TBitmap;Code:String;QRCodeSetupRec:TQRCodeSetupRec);
var
QRCode: TDelphiZXingQRCode;
Row, Column: Integer;
begin
QRCode := TDelphiZXingQRCode.Create ;
try
QRCode.Data :=DeleteCtrl( Code );
if not QRCodeSetupRec.Encodeing in [0..5] then QRCodeSetupRec.Encodeing:=0;

QRCode.Encoding := TQRCodeEncoding(QRCodeSetupRec.Encodeing);
QRCode.QuietZone := QRCodeSetupRec.QuietZone;
//QRCodeBitmap.SetSize(QRCode.Rows, QRCode.Columns);
QRCodeBitmap.Width:=QRCode.Columns;
QRCodeBitmap.Height:=QRCode.Rows;
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;
ScalePercentBmp(QrCodeBitmap,QRCodeSetupRec.Scale); //Bitmap放大
end;



Procedure MakeBarcode(Picture:TPicture; Code:String;BarCodeSetupRec:TBarCodeSetupRec);

//------------------------------------------

Procedure MakeBarcode2Bmp(Picture:TPicture; Code:String);

var Bitmap: TBitmap;

barcode:TBarcode;
begin

Barcode:=TBarcode.Create(Nil);
Barcode.Text:=DeleteCtrl( Code);
Barcode.Top:=1;
Barcode.Left:=2;
Barcode.Height:= BarcodeSetupRec.Height;
Barcode.Modul:=BarcodeSetupRec.Modul;
Barcode.Ratio:=BarcodeSetupRec.Ratio; //比例
Barcode.Typ:=TBarcodeType(BarcodeSetupRec.CodeType); //3: bcCode39; //TBarcodeType(BarType);
Barcode.CheckSum:=BarcodeSetupRec.CheckSum; //Checksum;
Barcode.showText:=TBarcodeOption(BarcodeSetupRec.showText);
Barcode.Angle:=0; //Angle;

barcode.DrawBarcodeToBmp(Picture.Bitmap);

Barcode.Free;
end;
//------------------------------------------

var Bitmap: TBitmap;

begin
Picture.Assign(Nil); //Clear barcode of source.
if Picture.Graphic = nil then
begin
Bitmap := TBitmap.Create;
try
Picture.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;

Try
MakeBarcode2Bmp(Picture,Code);
Except
on E : Exception do
ShowMessage('錯誤訊息: ' E.Message);
End;
end;


initialization

// QRCodeSetupRec :=QRCodeSetupRecInit;
// BarcodeSetupRec:=BarcodeSetupRecInit;


end.
//*************************************************************


unit CmjBarcode;
interface
uses
WinProcs, WinTypes, Messages, SysUtils, Classes,

Controls, Forms,Graphics, Dialogs;
type
TBarcodeType =
(
bcCode_2_5_interleaved,
bcCode_2_5_industrial,
bcCode_2_5_matrix,
bcCode39,
bcCode39Extended,
bcCode128A,
bcCode128B,
bcCode128C,
bcCode93,
bcCode93Extended,
bcCodeMSI,
bcCodePostNet,
bcCodeCodabar,
bcCodeEAN8,
bcCodeEAN13,
bcCodeUPC_A,
bcCodeUPC_E0,
bcCodeUPC_E1,
bcCodeUPC_Supp2, { UPC 2 digit supplemental }
bcCodeUPC_Supp5, { UPC 5 digit supplemental }
bcCodeEAN128A,
bcCodeEAN128B,
bcCodeEAN128C
);


TBarLineType = (white, black, black_half); {for internal use only}
{ black_half means a black line with 2/5 height (used for PostNet) }


TBarcodeOption = (bcoNone, bcoCode, bcoTyp, bcoBoth); // Type of text to show

TCheckSumMethod =
(
csmNone,
csmModulo10
);


TBarcode = class(TComponent)
private
{ Private-Deklarationen }
FHeight : integer;
FText : string;
FTop : integer;
FLeft : integer;
FModul : integer;
FRatio : double;
FTyp : TBarcodeType;
FCheckSum:boolean;
FShowText:TBarcodeOption;
FAngle : double;
FColor : TColor;
FColorBar:TColor;
FCheckSumMethod : TCheckSumMethod;


modules:array[0..3] of shortint;


procedure OneBarProps(code:char; var Width:integer; var lt:TBarLineType);

procedure DoLines(data:string; Canvas:TCanvas);

function SetLen(pI:byte):string;

function Code_2_5_interleaved:string;
function Code_2_5_industrial:string;
function Code_2_5_matrix:string;
function Code_39:string;
function Code_39Extended:string;
function Code_128:string;
function Code_93:string;
function Code_93Extended:string;
function Code_MSI:string;
function Code_PostNet:string;
function Code_Codabar:string;
function Code_EAN8:string;
function Code_EAN13:string;
function Code_UPC_A:string;
function Code_UPC_E0:string;
function Code_UPC_E1:string;
function Code_Supp5:string;
function Code_Supp2:string;

function GetTypText:string;
procedure MakeModules;

procedure SetModul(v:integer);

function GetWidth : integer;

function DoCheckSumming(const data : string):string;

protected
{ Protected-Deklarationen }
function MakeData : string;

public
{ Public-Deklarationen }
constructor Create(Owner:TComponent); override;
procedure DrawBarcode(Canvas:TCanvas);
procedure DrawText(Canvas:TCanvas);

procedure DrawBarcodeToBmp(Bitmap:TBitmap);
published
{ Published-Deklarationen }
{ Height of Barcode (Pixel)}
property Height : integer read FHeight write FHeight;
property Text : string read FText write FText;
property Top : integer read FTop write FTop;
property Left : integer read FLeft write FLeft;
{ Width of the smallest line in a Barcode }
property Modul : integer read FModul write SetModul;
property Ratio : double read FRatio write FRatio;
property Typ : TBarcodeType read FTyp write FTyp default bcCode_2_5_interleaved;
{ build CheckSum ? }
property Checksum:boolean read FCheckSum write FCheckSum default FALSE;
property CheckSumMethod:TCheckSumMethod read FCheckSumMethod write FCheckSumMethod default csmModulo10;

{ 0 - 360 degree }
property Angle :double read FAngle write FAngle;

property ShowText:TBarcodeOption read FShowText write FShowText default bcoNone;
property Width : integer read GetWidth;

property Color:TColor read FColor write FColor default clWhite;
property ColorBar:TColor read FColorBar write FColorBar default clBlack;
// {$IFDEF UsingVCL}
// property Color:TColor read FColor write FColor default clWhite;
// property ColorBar:TColor read FColorBar write FColorBar default clBlack;
// {$ELSE}
// property Color:TColor read FColor write FColor default TColor($FFFFFF);
// property ColorBar:TColor read FColorBar write FColorBar default TColor($000000);
// {$IFEND}


end;

procedure Register;

implementation

//{$ifdef WIN32}
// {$R barcode.d32}
//{$else}
// {$R barcode.d16}
//{$endif}


uses bcchksum;


type
TBCdata = record
Name:string; { Name of Barcode }
num :Boolean; { numeric data only }
end;

const BCdata:array[bcCode_2_5_interleaved..bcCodeEAN128C] of TBCdata =
(
(Name:'2_5_interleaved'; num:True),
(Name:'2_5_industrial'; num:True),
(Name:'2_5_matrix'; num:True),
(Name:'Code39'; num:False),
(Name:'Code39 Extended'; num:False),
(Name:'Code128A'; num:False),
(Name:'Code128B'; num:False),
(Name:'Code128C'; num:True),
(Name:'Code93'; num:False),
(Name:'Code93 Extended'; num:False),
(Name:'MSI'; num:True),
(Name:'PostNet'; num:True),
(Name:'Codebar'; num:False),
(Name:'EAN8'; num:True),
(Name:'EAN13'; num:True),
(Name:'UPC_A'; num:True),
(Name:'UPC_E0'; num:True),
(Name:'UPC_E1'; num:True),
(Name:'UPC Supp2'; num:True),
(Name:'UPC Supp5'; num:True),
(Name:'EAN128A'; num:False),
(Name:'EAN128B'; num:False),
(Name:'EAN128C'; num:True)
);

{$ifndef WIN32}
function Trim(const S: string): string; export;
{ Removes leading and trailing whitespace from s}
var
I, L: Integer;
begin
L := Length(S);
I := 1;
while (I <= L) and (S[I] <= ' ') do Inc(I);
if I > L then Result := '' else
begin
while S[L] <= ' ' do Dec(L);
Result := Copy(S, I, L - I 1);
end;
end;
{$endif}



{
converts a string from '321' to the internal representation '715'
i need this function because some pattern tables have a different
format :

'00111'
converts to '05161'
}
function Convert(s:string):string;
var
i, v : integer;
t : string;
begin
t := '';
for i:=1 to Length(s) do
begin
v := ord(s[i]) - 1;

if odd(i) then
Inc(v, 5);
t := t Chr(v);
end;
Convert := t;
end;

(*
* Berechne die Quersumme aus einer Zahl x
* z.B.: Quersumme von 1234 ist 10
*)
function quersumme(x:integer):integer;
var
sum:integer;
begin
sum := 0;

while x > 0 do
begin
sum := sum (x mod 10);
x := x div 10;
end;
result := sum;
end;


{
Rotate a Point by Angle 'alpha'
}
function Rotate2D(p:TPoint; alpha:double): TPoint;
var
sinus, cosinus : Extended;
begin
sinus := sin(alpha);
cosinus := cos(alpha);
result.x := Round(p.x*cosinus p.y*sinus);
result.y := Round(-p.x*sinus p.y*cosinus);
end;

{
Move Point "a" by Vector "b"
}
function Translate2D(a, b:TPoint): TPoint;
begin
result.x := a.x b.x;
result.y := a.y b.y;
end;





constructor TBarcode.Create(Owner:TComponent);
begin
inherited Create(owner);
FAngle := 0.0;
FRatio := 2.0;
FModul := 1;
FTyp := bcCodeEAN13;
FCheckSum := FALSE;
FCheckSumMethod := csmModulo10;
FShowText := bcoNone;
FColor := clWhite;
FColorBar := clBlack;

end;


function TBarcode.GetTypText:string;
begin
result := BCdata[FTyp].Name;
end;



{ set Modul Width }
procedure TBarcode.SetModul(v:integer);
begin
if (v >= 1) and (v < 50) then
FModul := v;
end;


{
calculate the width and the linetype of a sigle bar


Code Line-Color Width Height
------------------------------------------------------------------
'0' white 100% full
'1' white 100%*Ratio full
'2' white 150%*Ratio full
'3' white 200%*Ratio full
'5' black 100% full
'6' black 100%*Ratio full
'7' black 150%*Ratio full
'8' black 200%*Ratio full
'A' black 100% 2/5 (used for PostNet)
'B' black 100%*Ratio 2/5 (used for PostNet)
'C' black 150%*Ratio 2/5 (used for PostNet)
'D' black 200%*Ratio 2/5 (used for PostNet)
}
procedure TBarcode.OneBarProps(code:char; var Width:integer; var lt:TBarLineType);
begin
case code of
'0': begin width := modules[0]; lt := white; end;
'1': begin width := modules[1]; lt := white; end;
'2': begin width := modules[2]; lt := white; end;
'3': begin width := modules[3]; lt := white; end;


'5': begin width := modules[0]; lt := black; end;
'6': begin width := modules[1]; lt := black; end;
'7': begin width := modules[2]; lt := black; end;
'8': begin width := modules[3]; lt := black; end;

'A': begin width := modules[0]; lt := black_half; end;
'B': begin width := modules[1]; lt := black_half; end;
'C': begin width := modules[2]; lt := black_half; end;
'D': begin width := modules[3]; lt := black_half; end;
else
begin
{something went wrong :-( }
{mistyped pattern table}
raise Exception.CreateFmt('%s: internal Error', [self.ClassName]);
end;
end;
end;


function TBarcode.MakeData : string;
var
i : integer;
begin
{calculate the with of the different lines (modules)}
MakeModules;


{numeric barcode type ?}
if BCdata[Typ].num then
begin
FText := Trim(FText); {remove blanks}
for i := 1 to Length(Ftext) do
if (FText[i] > '9') or (FText[i] < '0') then
raise Exception.Create('Barcode must be numeric');
end;


{get the pattern of the barcode}
case Typ of
bcCode_2_5_interleaved: Result := Code_2_5_interleaved;
bcCode_2_5_industrial: Result := Code_2_5_industrial;
bcCode_2_5_matrix: Result := Code_2_5_matrix;
bcCode39: Result := Code_39;
bcCode39Extended: Result := Code_39Extended;
bcCode128A,
bcCode128B,
bcCode128C,
bcCodeEAN128A,
bcCodeEAN128B,
bcCodeEAN128C: Result := Code_128;
bcCode93: Result := Code_93;
bcCode93Extended: Result := Code_93Extended;
bcCodeMSI: Result := Code_MSI;
bcCodePostNet: Result := Code_PostNet;
bcCodeCodabar: Result := Code_Codabar;
bcCodeEAN8: Result := Code_EAN8;
bcCodeEAN13: Result := Code_EAN13;
bcCodeUPC_A: Result := Code_UPC_A;
bcCodeUPC_E0: Result := Code_UPC_E0;
bcCodeUPC_E1: Result := Code_UPC_E1;
bcCodeUPC_Supp2: Result := Code_Supp2;
bcCodeUPC_Supp5: Result := Code_Supp5;
else
raise Exception.CreateFmt('%s: wrong BarcodeType', [self.ClassName]);
end;

{
Showmessage(Format('Data <%s>', [Result]));
}
end;



function TBarcode.GetWidth:integer;
var
data : string;
i : integer;
w : integer;
lt : TBarLineType;
begin
Result := 0;

{get barcode pattern}
data := MakeData;

for i:=1 to Length(data) do {examine the pattern string}
begin
OneBarProps(data[i], w, lt);
Inc(Result, w);
end;
end;



function TBarcode.DoCheckSumming(const data : string):string;
begin
case FCheckSumMethod of

csmNone:
Result := data;
csmModulo10:
Result := CheckSumModulo10(data);

end;
end;




{
////////////////////////////// EAN /////////////////////////////////////////
}


{
////////////////////////////// EAN8 /////////////////////////////////////////
}

{Pattern for Barcode EAN Charset A}
{L1 S1 L2 S2}
const tabelle_EAN_A:array['0'..'9'] of string =
(
('2605'), { 0 }
('1615'), { 1 }
('1516'), { 2 }
('0805'), { 3 }
('0526'), { 4 }
('0625'), { 5 }
('0508'), { 6 }
('0706'), { 7 }
('0607'), { 8 }
('2506') { 9 }
);

{Pattern for Barcode EAN Charset C}
{S1 L1 S2 L2}
const tabelle_EAN_C:array['0'..'9'] of string =
(
('7150' ), { 0 }
('6160' ), { 1 }
('6061' ), { 2 }
('5350' ), { 3 }
('5071' ), { 4 }
('5170' ), { 5 }
('5053' ), { 6 }
('5251' ), { 7 }
('5152' ), { 8 }
('7051' ) { 9 }
);


function TBarcode.Code_EAN8:string;
var
i : integer;
tmp : String;
begin
if FCheckSum then
begin
tmp := SetLen(7);
tmp := DoCheckSumming(copy(tmp,length(tmp)-6,7));
end
else
tmp := SetLen(8);

Assert(Length(tmp)=8, 'Invalid Text len (EAN8)');

result := '505'; {Startcode}

for i:=1 to 4 do
result := result tabelle_EAN_A[tmp[i]] ;

result := result '05050'; {Center Guard Pattern}

for i:=5 to 8 do
result := result tabelle_EAN_C[tmp[i]] ;

result := result '505'; {Stopcode}
end;

{////////////////////////////// EAN13 ///////////////////////////////////////}

{Pattern for Barcode EAN Zeichensatz B}
{L1 S1 L2 S2}
const tabelle_EAN_B:array['0'..'9'] of string =
(
('0517'), { 0 }
('0616'), { 1 }
('1606'), { 2 }
('0535'), { 3 }
('1705'), { 4 }
('0715'), { 5 }
('3505'), { 6 }
('1525'), { 7 }
('2515'), { 8 }
('1507') { 9 }
);

{Zuordung der Paraitaetsfolgen f EAN13}
const tabelle_ParityEAN13:array[0..9, 1..6] of char =
(
('A', 'A', 'A', 'A', 'A', 'A'), { 0 }
('A', 'A', 'B', 'A', 'B', 'B'), { 1 }
('A', 'A', 'B', 'B', 'A', 'B'), { 2 }
('A', 'A', 'B', 'B', 'B', 'A'), { 3 }
('A', 'B', 'A', 'A', 'B', 'B'), { 4 }
('A', 'B', 'B', 'A', 'A', 'B'), { 5 }
('A', 'B', 'B', 'B', 'A', 'A'), { 6 }
('A', 'B', 'A', 'B', 'A', 'B'), { 7 }
('A', 'B', 'A', 'B', 'B', 'A'), { 8 }
('A', 'B', 'B', 'A', 'B', 'A') { 9 }
);

function TBarcode.Code_EAN13:string;
var
i, LK: integer;
tmp : String;
begin
if FCheckSum then
begin
tmp := SetLen(12);
tmp := DoCheckSumming(tmp);
end
else
tmp := SetLen(13);

Assert(Length(tmp) = 13, 'Invalid Text len (EAN13)');

LK := StrToInt(tmp[1]);
tmp := copy(tmp,2,12);

result := '505'; {Startcode}

for i:=1 to 6 do
begin
case tabelle_ParityEAN13[LK,i] of
'A' : result := result tabelle_EAN_A[tmp[i]];
'B' : result := result tabelle_EAN_B[tmp[i]] ;
'C' : result := result tabelle_EAN_C[tmp[i]] ;
end;
end;

result := result '05050'; {Center Guard Pattern}

for i:=7 to 12 do
result := result tabelle_EAN_C[tmp[i]] ;

result := result '505'; {Stopcode}
end;

{Pattern for Barcode 2 of 5}
const tabelle_2_5:array['0'..'9', 1..5] of char =
(
('0', '0', '1', '1', '0'), {'0'}
('1', '0', '0', '0', '1'), {'1'}
('0', '1', '0', '0', '1'), {'2'}
('1', '1', '0', '0', '0'), {'3'}
('0', '0', '1', '0', '1'), {'4'}
('1', '0', '1', '0', '0'), {'5'}
('0', '1', '1', '0', '0'), {'6'}
('0', '0', '0', '1', '1'), {'7'}
('1', '0', '0', '1', '0'), {'8'}
('0', '1', '0', '1', '0') {'9'}
);

function TBarcode.Code_2_5_interleaved:string;
var
i, j: integer;
c : char;

begin
result := '5050'; {Startcode}

for i:=1 to Length(FText) div 2 do
begin
for j:= 1 to 5 do
begin
if tabelle_2_5[FText[i*2-1], j] = '1' then
c := '6'
else
c := '5';
result := result c;
if tabelle_2_5[FText[i*2], j] = '1' then
c := '1'
else
c := '0';
result := result c;
end;
end;

result := result '605'; {Stopcode}
end;


function TBarcode.Code_2_5_industrial:string;
var
i, j: integer;
begin
result := '606050'; {Startcode}

for i:=1 to Length(FText) do
begin
for j:= 1 to 5 do
begin
if tabelle_2_5[FText[i], j] = '1' then
result := result '60'
else
result := result '50';
end;
end;

result := result '605060'; {Stopcode}
end;

function TBarcode.Code_2_5_matrix:string;
var
i, j: integer;
c :char;
begin
result := '705050'; {Startcode}

for i:=1 to Length(FText) do
begin
for j:= 1 to 5 do
begin
if tabelle_2_5[FText[i], j] = '1' then
c := '1'
else
c := '0';

{Falls i ungerade ist dann mache Lke zu Strich}
if odd(j) then
c := chr(ord(c) 5);
result := result c;
end;
result := result '0'; {Lke zwischen den Zeichen}
end;

result := result '70505'; {Stopcode}
end;


function TBarcode.Code_39:string;

type TCode39 =
record
c : char;
data : array[0..9] of char;
chk: shortint;
end;

const tabelle_39: array[0..43] of TCode39 = (
( c:'0'; data:'505160605'; chk:0 ),
( c:'1'; data:'605150506'; chk:1 ),
( c:'2'; data:'506150506'; chk:2 ),
( c:'3'; data:'606150505'; chk:3 ),
( c:'4'; data:'505160506'; chk:4 ),
( c:'5'; data:'605160505'; chk:5 ),
( c:'6'; data:'506160505'; chk:6 ),
( c:'7'; data:'505150606'; chk:7 ),
( c:'8'; data:'605150605'; chk:8 ),
( c:'9'; data:'506150605'; chk:9 ),
( c:'A'; data:'605051506'; chk:10),
( c:'B'; data:'506051506'; chk:11),
( c:'C'; data:'606051505'; chk:12),
( c:'D'; data:'505061506'; chk:13),
( c:'E'; data:'605061505'; chk:14),
( c:'F'; data:'506061505'; chk:15),
( c:'G'; data:'505051606'; chk:16),
( c:'H'; data:'605051605'; chk:17),
( c:'I'; data:'506051605'; chk:18),
( c:'J'; data:'505061605'; chk:19),
( c:'K'; data:'605050516'; chk:20),
( c:'L'; data:'506050516'; chk:21),
( c:'M'; data:'606050515'; chk:22),
( c:'N'; data:'505060516'; chk:23),
( c:'O'; data:'605060515'; chk:24),
( c:'P'; data:'506060515'; chk:25),
( c:'Q'; data:'505050616'; chk:26),
( c:'R'; data:'605050615'; chk:27),
( c:'S'; data:'506050615'; chk:28),
( c:'T'; data:'505060615'; chk:29),
( c:'U'; data:'615050506'; chk:30),
( c:'V'; data:'516050506'; chk:31),
( c:'W'; data:'616050505'; chk:32),
( c:'X'; data:'515060506'; chk:33),
( c:'Y'; data:'615060505'; chk:34),
( c:'Z'; data:'516060505'; chk:35),
( c:'-'; data:'515050606'; chk:36),
( c:'.'; data:'615050605'; chk:37),
( c:' '; data:'516050605'; chk:38),
( c:'*'; data:'515060605'; chk:0 ),
( c:'$'; data:'515151505'; chk:39),
( c:'/'; data:'515150515'; chk:40),
( c:' '; data:'515051515'; chk:41),
( c:'%'; data:'505151515'; chk:42)
);


function FindIdx(z:char):integer;
var
i:integer;
begin
for i:=0 to High(tabelle_39) do
begin
if z = tabelle_39[i].c then
begin
result := i;
exit;
end;
end;
result := -1;
end;

var
i, idx : integer;
checksum:integer;
begin
checksum := 0;
{Startcode}
//result := tabelle_39[FindIdx('*')].data '0';
result := String(tabelle_39[FindIdx('*')].data) '0';

for i:=1 to Length(FText) do
begin
idx := FindIdx(FText[i]);
if idx < 0 then
continue;
result := result tabelle_39[idx].data '0';
Inc(checksum, tabelle_39[idx].chk);
end;

{Calculate Checksum Data}
if FCheckSum then
begin
checksum := checksum mod 43;
for i:=0 to High(tabelle_39) do
if checksum = tabelle_39[i].chk then
begin
result := result tabelle_39[i].data '0';
break;
end;
end;

{Stopcode}
result := result tabelle_39[FindIdx('*')].data;
end;

function TBarcode.Code_39Extended:string;

const code39x : array[0..127] of string[2] =
(
('%U'), ('$A'), ('$B'), ('$C'), ('$D'), ('$E'), ('$F'), ('$G'),
('$H'), ('$I'), ('$J'), ('$K'), ('$L'), ('$M'), ('$N'), ('$O'),
('$P'), ('$Q'), ('$R'), ('$S'), ('$T'), ('$U'), ('$V'), ('$W'),
('$X'), ('$Y'), ('$Z'), ('%A'), ('%B'), ('%C'), ('%D'), ('%E'),
(' '), ('/A'), ('/B'), ('/C'), ('/D'), ('/E'), ('/F'), ('/G'),
('/H'), ('/I'), ('/J'), ('/K'), ('/L'), ('/M'), ('/N'), ('/O'),
( '0'), ('1'), ('2'), ('3'), ('4'), ('5'), ('6'), ('7'),
('8'), ('9'), ('/Z'), ('%F'), ('%G'), ('%H'), ('%I'), ('%J'),
('%V'), ('A'), ('B'), ('C'), ('D'), ('E'), ('F'), ('G'),
('H'), ('I'), ('J'), ('K'), ('L'), ('M'), ('N'), ('O'),
('P'), ('Q'), ('R'), ('S'), ('T'), ('U'), ('V'), ('W'),
('X'), ('Y'), ('Z'), ('%K'), ('%L'), ('%M'), ('%N'), ('%O'),
('%W'), (' A'), (' B'), (' C'), (' D'), (' E'), (' F'), (' G'),
(' H'), (' I'), (' J'), (' K'), (' L'), (' M'), (' N'), (' O'),
(' P'), (' Q'), (' R'), (' S'), (' T'), (' U'), (' V'), (' W'),
(' X'), (' Y'), (' Z'), ('%P'), ('%Q'), ('%R'), ('%S'), ('%T')
);


var
save:string;
i : integer;
begin
save := FText;
FText := '';

for i:=1 to Length(save) do
begin
if ord(save[i]) <= 127 then
FText := FText code39x[ord(save[i])];
end;
result := Code_39;
FText := save;
end;



{
Code 128
}
function TBarcode.Code_128:string;
type TCode128 =
record
a, b : char;
c : string[2];
data : string[6];
end;

const tabelle_128: array[0..102] of TCode128 = (
( a:' '; b:' '; c:'00'; data:'212222' ),
( a:'!'; b:'!'; c:'01'; data:'222122' ),
( a:'"'; b:'"'; c:'02'; data:'222221' ),
( a:'#'; b:'#'; c:'03'; data:'121223' ),
( a:'$'; b:'$'; c:'04'; data:'121322' ),
( a:'%'; b:'%'; c:'05'; data:'131222' ),
( a:'&'; b:'&'; c:'06'; data:'122213' ),
( a:''''; b:''''; c:'07'; data:'122312' ),
( a:'('; b:'('; c:'08'; data:'132212' ),
( a:')'; b:')'; c:'09'; data:'221213' ),
( a:'*'; b:'*'; c:'10'; data:'221312' ),
( a:' '; b:' '; c:'11'; data:'231212' ),

( a:'?'; b:'?'; c:'12'; data:'112232' ),

( a:'-'; b:'-'; c:'13'; data:'122132' ),
( a:'.'; b:'.'; c:'14'; data:'122231' ),
( a:'/'; b:'/'; c:'15'; data:'113222' ),
( a:'0'; b:'0'; c:'16'; data:'123122' ),
( a:'1'; b:'1'; c:'17'; data:'123221' ),
( a:'2'; b:'2'; c:'18'; data:'223211' ),
( a:'3'; b:'3'; c:'19'; data:'221132' ),
( a:'4'; b:'4'; c:'20'; data:'221231' ),
( a:'5'; b:'5'; c:'21'; data:'213212' ),
( a:'6'; b:'6'; c:'22'; data:'223112' ),
( a:'7'; b:'7'; c:'23'; data:'312131' ),
( a:'8'; b:'8'; c:'24'; data:'311222' ),
( a:'9'; b:'9'; c:'25'; data:'321122' ),
( a:':'; b:':'; c:'26'; data:'321221' ),
( a:';'; b:';'; c:'27'; data:'312212' ),
( a:'<'; b:'<'; c:'28'; data:'322112' ),
( a:'='; b:'='; c:'29'; data:'322211' ),
( a:'>'; b:'>'; c:'30'; data:'212123' ),
( a:'?'; b:'?'; c:'31'; data:'212321' ),
( a:'@'; b:'@'; c:'32'; data:'232121' ),
( a:'A'; b:'A'; c:'33'; data:'111323' ),
( a:'B'; b:'B'; c:'34'; data:'131123' ),
( a:'C'; b:'C'; c:'35'; data:'131321' ),
( a:'D'; b:'D'; c:'36'; data:'112313' ),
( a:'E'; b:'E'; c:'37'; data:'132113' ),
( a:'F'; b:'F'; c:'38'; data:'132311' ),
( a:'G'; b:'G'; c:'39'; data:'211313' ),
( a:'H'; b:'H'; c:'40'; data:'231113' ),
( a:'I'; b:'I'; c:'41'; data:'231311' ),
( a:'J'; b:'J'; c:'42'; data:'112133' ),
( a:'K'; b:'K'; c:'43'; data:'112331' ),
( a:'L'; b:'L'; c:'44'; data:'132131' ),
( a:'M'; b:'M'; c:'45'; data:'113123' ),
( a:'N'; b:'N'; c:'46'; data:'113321' ),
( a:'O'; b:'O'; c:'47'; data:'133121' ),
( a:'P'; b:'P'; c:'48'; data:'313121' ),
( a:'Q'; b:'Q'; c:'49'; data:'211331' ),
( a:'R'; b:'R'; c:'50'; data:'231131' ),
( a:'S'; b:'S'; c:'51'; data:'213113' ),
( a:'T'; b:'T'; c:'52'; data:'213311' ),
( a:'U'; b:'U'; c:'53'; data:'213131' ),
( a:'V'; b:'V'; c:'54'; data:'311123' ),
( a:'W'; b:'W'; c:'55'; data:'311321' ),
( a:'X'; b:'X'; c:'56'; data:'331121' ),
( a:'Y'; b:'Y'; c:'57'; data:'312113' ),
( a:'Z'; b:'Z'; c:'58'; data:'312311' ),
( a:'['; b:'['; c:'59'; data:'332111' ),
( a:'\'; b:'\'; c:'60'; data:'314111' ),
( a:']'; b:']'; c:'61'; data:'221411' ),
( a:'^'; b:'^'; c:'62'; data:'431111' ),
( a:'_'; b:'_'; c:'63'; data:'111224' ),
( a:' '; b:'`'; c:'64'; data:'111422' ),
( a:' '; b:'a'; c:'65'; data:'121124' ),
( a:' '; b:'b'; c:'66'; data:'121421' ),
( a:' '; b:'c'; c:'67'; data:'141122' ),
( a:' '; b:'d'; c:'68'; data:'141221' ),
( a:' '; b:'e'; c:'69'; data:'112214' ),
( a:' '; b:'f'; c:'70'; data:'112412' ),
( a:' '; b:'g'; c:'71'; data:'122114' ),
( a:' '; b:'h'; c:'72'; data:'122411' ),
( a:' '; b:'i'; c:'73'; data:'142112' ),
( a:' '; b:'j'; c:'74'; data:'142211' ),
( a:' '; b:'k'; c:'75'; data:'241211' ),
( a:' '; b:'l'; c:'76'; data:'221114' ),
( a:' '; b:'m'; c:'77'; data:'413111' ),
( a:' '; b:'n'; c:'78'; data:'241112' ),
( a:' '; b:'o'; c:'79'; data:'134111' ),
( a:' '; b:'p'; c:'80'; data:'111242' ),
( a:' '; b:'q'; c:'81'; data:'121142' ),
( a:' '; b:'r'; c:'82'; data:'121241' ),
( a:' '; b:'s'; c:'83'; data:'114212' ),
( a:' '; b:'t'; c:'84'; data:'124112' ),
( a:' '; b:'u'; c:'85'; data:'124211' ),
( a:' '; b:'v'; c:'86'; data:'411212' ),
( a:' '; b:'w'; c:'87'; data:'421112' ),
( a:' '; b:'x'; c:'88'; data:'421211' ),
( a:' '; b:'y'; c:'89'; data:'212141' ),
( a:' '; b:'z'; c:'90'; data:'214121' ),
( a:' '; b:'{'; c:'91'; data:'412121' ),
( a:' '; b:'|'; c:'92'; data:'111143' ),
( a:' '; b:'}'; c:'93'; data:'111341' ),
( a:' '; b:'~'; c:'94'; data:'131141' ),
( a:' '; b:' '; c:'95'; data:'114113' ),
( a:' '; b:' '; c:'96'; data:'114311' ),
( a:' '; b:' '; c:'97'; data:'411113' ),
( a:' '; b:' '; c:'98'; data:'411311' ),
( a:' '; b:' '; c:'99'; data:'113141' ),
( a:' '; b:' '; c:' '; data:'114131' ),
( a:' '; b:' '; c:' '; data:'311141' ),
( a:' '; b:' '; c:' '; data:'411131' ) { FNC1 }
);

StartA = '211412';
StartB = '211214';
StartC = '211232';
Stop = '2331112';




{find Code 128 Codeset A or B}
function Find_Code128AB(c:char):integer;
var
i:integer;
v:char;
begin
for i:=0 to High(tabelle_128) do
begin
if FTyp = bcCode128A then
v := tabelle_128[i].a
else
v := tabelle_128[i].b;

if c = v then
begin
result := i;
exit;
end;
end;
result := -1;
end;

{ find Code 128 Codeset C }
function Find_Code128C(c:string):integer;
var i:integer;
begin
for i:=0 to High(tabelle_128) do begin
if tabelle_128[i].c = c then begin
result := i;
exit;
end;
end;
result := -1;
end;



var i, j, idx: integer;
startcode:string;
checksum : integer;
codeword_pos : integer;

begin
case FTyp of
bcCode128A, bcCodeEAN128A:
begin checksum := 103; startcode:= StartA; end;
bcCode128B, bcCodeEAN128B:
begin checksum := 104; startcode:= StartB; end;
bcCode128C, bcCodeEAN128C:
begin checksum := 105; startcode:= StartC; end;
end;

result := Convert(startcode); {Startcode}
codeword_pos := 1;

case FTyp of
bcCodeEAN128A,
bcCodeEAN128B,
bcCodeEAN128C:
begin
{
special identifier
FNC1 = function code 1
for EAN 128 barcodes
}
result := result Convert(tabelle_128[102].data);
Inc(checksum, 102*codeword_pos);
Inc(codeword_pos);
{
if there is no checksum at the end of the string
the EAN128 needs one (modulo 10)
}
if FCheckSum then FText:=DoCheckSumming(FTEXT);
end;
end;

if (FTyp = bcCode128C) or (FTyp = bccodeEAN128C) then
begin
if (Length(FText) mod 2<>0) then FText:='0' FText;
for i:=1 to (Length(FText) div 2) do
begin
j:=(i-1)*2 1;
idx:=Find_Code128C(copy(Ftext,j,2));
if idx < 0 then idx := Find_Code128C('00');
result := result Convert(tabelle_128[idx].data);
Inc(checksum, idx*codeword_pos);
Inc(codeword_pos);
end;
end
else
for i:=1 to Length(FText) do
begin
idx := Find_Code128AB(FText[i]);
if idx < 0 then
idx := Find_Code128AB(' ');
result := result Convert(tabelle_128[idx].data);
Inc(checksum, idx*codeword_pos);
Inc(codeword_pos);
end;

checksum := checksum mod 103;
result := result Convert(tabelle_128[checksum].data);

result := result Convert(Stop); {Stopcode}
end;

function TBarcode.Code_93:string;
type TCode93 =
record
c : char;
data : array[0..5] of char;
end;

const tabelle_93: array[0..46] of TCode93 = (
( c:'0'; data:'131112' ),
( c:'1'; data:'111213' ),
( c:'2'; data:'111312' ),
( c:'3'; data:'111411' ),
( c:'4'; data:'121113' ),
( c:'5'; data:'121212' ),
( c:'6'; data:'121311' ),
( c:'7'; data:'111114' ),
( c:'8'; data:'131211' ),
( c:'9'; data:'141111' ),
( c:'A'; data:'211113' ),
( c:'B'; data:'211212' ),
( c:'C'; data:'211311' ),
( c:'D'; data:'221112' ),
( c:'E'; data:'221211' ),
( c:'F'; data:'231111' ),
( c:'G'; data:'112113' ),
( c:'H'; data:'112212' ),
( c:'I'; data:'112311' ),
( c:'J'; data:'122112' ),
( c:'K'; data:'132111' ),
( c:'L'; data:'111123' ),
( c:'M'; data:'111222' ),
( c:'N'; data:'111321' ),
( c:'O'; data:'121122' ),
( c:'P'; data:'131121' ),
( c:'Q'; data:'212112' ),
( c:'R'; data:'212211' ),
( c:'S'; data:'211122' ),
( c:'T'; data:'211221' ),
( c:'U'; data:'221121' ),
( c:'V'; data:'222111' ),
( c:'W'; data:'112122' ),
( c:'X'; data:'112221' ),
( c:'Y'; data:'122121' ),
( c:'Z'; data:'123111' ),
( c:'-'; data:'121131' ),
( c:'.'; data:'311112' ),
( c:' '; data:'311211' ),
( c:'$'; data:'321111' ),
( c:'/'; data:'112131' ),
( c:' '; data:'113121' ),
( c:'%'; data:'211131' ),
( c:'['; data:'121221' ), {only used for Extended Code 93}
( c:']'; data:'312111' ), {only used for Extended Code 93}
( c:'{'; data:'311121' ), {only used for Extended Code 93}
( c:'}'; data:'122211' ) {only used for Extended Code 93}
);


{find Code 93}
function Find_Code93(c:char):integer;
var
i:integer;
begin
for i:=0 to High(tabelle_93) do
begin
if c = tabelle_93[i].c then
begin
result := i;
exit;
end;
end;
result := -1;
end;




var
i, idx : integer;
checkC, checkK, {Checksums}
weightC, weightK : integer;
begin

result := Convert('111141'); {Startcode}

for i:=1 to Length(FText) do
begin
idx := Find_Code93(FText[i]);
if idx < 0 then
raise Exception.CreateFmt('%s:Code93 bad Data <%s>', [self.ClassName,FText]);
result := result Convert(tabelle_93[idx].data);
end;

checkC := 0;
checkK := 0;

weightC := 1;
weightK := 2;

for i:=Length(FText) downto 1 do
begin
idx := Find_Code93(FText[i]);

Inc(checkC, idx*weightC);
Inc(checkK, idx*weightK);

Inc(weightC);
if weightC > 20 then weightC := 1;
Inc(weightK);
if weightK > 15 then weightC := 1;
end;

Inc(checkK, checkC);

checkC := checkC mod 47;
checkK := checkK mod 47;

result := result Convert(tabelle_93[checkC].data)
Convert(tabelle_93[checkK].data);

result := result Convert('1111411'); {Stopcode}
end;





function TBarcode.Code_93Extended:string;
const code93x : array[0..127] of string[2] =
(
(']U'), ('[A'), ('[B'), ('[C'), ('[D'), ('[E'), ('[F'), ('[G'),
('[H'), ('[I'), ('[J'), ('[K'), ('[L'), ('[M'), ('[N'), ('[O'),
('[P'), ('[Q'), ('[R'), ('[S'), ('[T'), ('[U'), ('[V'), ('[W'),
('[X'), ('[Y'), ('[Z'), (']A'), (']B'), (']C'), (']D'), (']E'),
(' '), ('{A'), ('{B'), ('{C'), ('{D'), ('{E'), ('{F'), ('{G'),
('{H'), ('{I'), ('{J'), ('{K'), ('{L'), ('{M'), ('{N'), ('{O'),
( '0'), ('1'), ('2'), ('3'), ('4'), ('5'), ('6'), ('7'),
('8'), ('9'), ('{Z'), (']F'), (']G'), (']H'), (']I'), (']J'),
(']V'), ('A'), ('B'), ('C'), ('D'), ('E'), ('F'), ('G'),
('H'), ('I'), ('J'), ('K'), ('L'), ('M'), ('N'), ('O'),
('P'), ('Q'), ('R'), ('S'), ('T'), ('U'), ('V'), ('W'),
('X'), ('Y'), ('Z'), (']K'), (']L'), (']M'), (']N'), (']O'),
(']W'), ('}A'), ('}B'), ('}C'), ('}D'), ('}E'), ('}F'), ('}G'),
('}H'), ('}I'), ('}J'), ('}K'), ('}L'), ('}M'), ('}N'), ('}O'),
('}P'), ('}Q'), ('}R'), ('}S'), ('}T'), ('}U'), ('}V'), ('}W'),
('}X'), ('}Y'), ('}Z'), (']P'), (']Q'), (']R'), (']S'), (']T')
);

var
{save:array[0..254] of char;}
{old:string;}
save : string;
i : integer;
begin
{CharToOem(PChar(FText), save);}



save := FText;
FText := '';


for i:=0 to Length(save)-1 do
begin
if ord(save[i]) <= 127 then
FText := FText code93x[ord(save[i])];
end;

{Showmessage(Format('Text: <%s>', [FText]));}

result := Code_93;
FText := save;
end;



function TBarcode.Code_MSI:string;
const tabelle_MSI:array['0'..'9'] of string[8] =
(
( '51515151' ), {'0'}
( '51515160' ), {'1'}
( '51516051' ), {'2'}
( '51516060' ), {'3'}
( '51605151' ), {'4'}
( '51605160' ), {'5'}
( '51606051' ), {'6'}
( '51606060' ), {'7'}
( '60515151' ), {'8'}
( '60515160' ) {'9'}
);

var
i:integer;
check_even, check_odd, checksum:integer;
begin
result := '60'; {Startcode}
check_even := 0;
check_odd := 0;

for i:=1 to Length(FText) do
begin
if odd(i-1) then
check_odd := check_odd*10 ord(FText[i])
else
check_even := check_even ord(FText[i]);

result := result tabelle_MSI[FText[i]];
end;

checksum := quersumme(check_odd*2) check_even;

checksum := checksum mod 10;
if checksum > 0 then
checksum := 10-checksum;

result := result tabelle_MSI[chr(ord('0') checksum)];

result := result '515'; {Stopcode}
end;



function TBarcode.Code_PostNet:string;
const tabelle_PostNet:array['0'..'9'] of string[10] =
(
( '5151A1A1A1' ), {'0'}
( 'A1A1A15151' ), {'1'}
( 'A1A151A151' ), {'2'}
( 'A1A15151A1' ), {'3'}
( 'A151A1A151' ), {'4'}
( 'A151A151A1' ), {'5'}
( 'A15151A1A1' ), {'6'}
( '51A1A1A151' ), {'7'}
( '51A1A151A1' ), {'8'}
( '51A151A1A1' ) {'9'}
);
var
i:integer;
begin
result := '51';

for i:=1 to Length(FText) do
begin
result := result tabelle_PostNet[FText[i]];
end;
result := result '5';
end;


function TBarcode.Code_Codabar:string;
type TCodabar =
record
c : char;
data : array[0..6] of char;
end;

const tabelle_cb: array[0..19] of TCodabar = (
( c:'1'; data:'5050615' ),
( c:'2'; data:'5051506' ),
( c:'3'; data:'6150505' ),
( c:'4'; data:'5060515' ),
( c:'5'; data:'6050515' ),
( c:'6'; data:'5150506' ),
( c:'7'; data:'5150605' ),
( c:'8'; data:'5160505' ),
( c:'9'; data:'6051505' ),
( c:'0'; data:'5050516' ),
( c:'-'; data:'5051605' ),
( c:'$'; data:'5061505' ),
( c:':'; data:'6050606' ),
( c:'/'; data:'6060506' ),
( c:'.'; data:'6060605' ),
( c:' '; data:'5060606' ),
( c:'A'; data:'5061515' ),
( c:'B'; data:'5151506' ),
( c:'C'; data:'5051516' ),
( c:'D'; data:'5051615' )
);



{find Codabar}
function Find_Codabar(c:char):integer;
var
i:integer;
begin
for i:=0 to High(tabelle_cb) do
begin
if c = tabelle_cb[i].c then
begin
result := i;
exit;
end;
end;
result := -1;
end;

var
i, idx : integer;
begin
//result := tabelle_cb[Find_Codabar('A')].data ('0'); //modify by 2013-2-25
result := String(tabelle_cb[Find_Codabar('A')].data) ('0'); //modify by 2013-2-25
for i:=1 to Length(FText) do
begin
idx := Find_Codabar(FText[i]);
result := result tabelle_cb[idx].data '0';
end;
result := result tabelle_cb[Find_Codabar('B')].data;
end;



{---------------}

{Assist function}
function TBarcode.SetLen(pI:byte):string;
begin
Result := FText;
while Length(Result) < pI do
Result:='0' Result;
end;



function TBarcode.Code_UPC_A:string;
var
i : integer;
tmp : String;
begin
FText := SetLen(12);
if FCheckSum then tmp:=DoCheckSumming(copy(FText,1,11));
if FCheckSum then FText:=tmp else tmp:=FText;
result := '505'; {Startcode}
for i:=1 to 6 do
result := result tabelle_EAN_A[tmp[i]];
result := result '05050'; {Trennzeichen}
for i:=7 to 12 do
result := result tabelle_EAN_C[tmp[i]];
result := result '505'; {Stopcode}
end;


{UPC E Parity Pattern Table , Number System 0}
const tabelle_UPC_E0:array['0'..'9', 1..6] of char =
(
('E', 'E', 'E', 'o', 'o', 'o' ), { 0 }
('E', 'E', 'o', 'E', 'o', 'o' ), { 1 }
('E', 'E', 'o', 'o', 'E', 'o' ), { 2 }
('E', 'E', 'o', 'o', 'o', 'E' ), { 3 }
('E', 'o', 'E', 'E', 'o', 'o' ), { 4 }
('E', 'o', 'o', 'E', 'E', 'o' ), { 5 }
('E', 'o', 'o', 'o', 'E', 'E' ), { 6 }
('E', 'o', 'E', 'o', 'E', 'o' ), { 7 }
('E', 'o', 'E', 'o', 'o', 'E' ), { 8 }
('E', 'o', 'o', 'E', 'o', 'E' ) { 9 }
);

function TBarcode.Code_UPC_E0:string;
var i,j : integer;
tmp : String;
c : char;
begin
FText := SetLen(7);
tmp:=DoCheckSumming(copy(FText,1,6));
c:=tmp[7];
if FCheckSum then FText:=tmp else tmp := FText;
result := '505'; {Startcode}
for i:=1 to 6 do
begin
if tabelle_UPC_E0[c,i]='E' then
begin
for j:= 1 to 4 do result := result tabelle_EAN_C[tmp[i],5-j];
end
else
begin
result := result tabelle_EAN_A[tmp[i]];
end;
end;
result := result '05050'; {Stopcode}
end;

function TBarcode.Code_UPC_E1:string;
var i,j : integer;
tmp : String;
c : char;
begin
FText := SetLen(7);
tmp:=DoCheckSumming(copy(FText,1,6));
c:=tmp[7];
if FCheckSum then FText:=tmp else tmp := FText;
result := '505'; {Startcode}
for i:=1 to 6 do
begin
if tabelle_UPC_E0[c,i]='E' then
begin
result := result tabelle_EAN_A[tmp[i]];
end
else
begin
for j:= 1 to 4 do result := result tabelle_EAN_C[tmp[i],5-j];
end;
end;
result := result '05050'; {Stopcode}
end;

{assist function}
function getSupp(Nr : String) : String;
var i,fak,sum : Integer;
tmp : String;
begin
sum := 0;
tmp := copy(nr,1,Length(Nr)-1);
fak := Length(tmp);
for i:=1 to length(tmp) do
begin
if (fak mod 2) = 0 then
sum := sum (StrToInt(tmp[i])*9)
else
sum := sum (StrToInt(tmp[i])*3);
dec(fak);
end;
sum:=((sum mod 10) mod 10) mod 10;
result := tmp IntToStr(sum);
end;

function TBarcode.Code_Supp5:string;
var i,j : integer;
tmp : String;
c : char;
begin
FText := SetLen(5);
tmp:=getSupp(copy(FText,1,5) '0');
c:=tmp[6];
if FCheckSum then FText:=tmp else tmp := FText;
result := '506'; {Startcode}
for i:=1 to 5 do
begin
if tabelle_UPC_E0[c,(6-5) i]='E' then
begin
for j:= 1 to 4 do result := result tabelle_EAN_C[tmp[i],5-j];
end
else
begin
result := result tabelle_EAN_A[tmp[i]];
end;
if i<5 then result:=result '05'; // character delineator
end;
end;

function TBarcode.Code_Supp2:string;
var i,j : integer;
tmp,mS : String;
c : char;
begin
FText := SetLen(2);
i:=StrToInt(Ftext);
case i mod 4 of
3: mS:='EE';
2: mS:='Eo';
1: mS:='oE';
0: mS:='oo';
end;
tmp:=getSupp(copy(FText,1,5) '0');
c:=tmp[3];
if FCheckSum then FText:=tmp else tmp := FText;
result := '506'; {Startcode}
for i:=1 to 2 do
begin
if mS[i]='E' then
begin
for j:= 1 to 4 do result := result tabelle_EAN_C[tmp[i],5-j];
end
else
begin
result := result tabelle_EAN_A[tmp[i]];
end;
if i<2 then result:=result '05'; // character delineator
end;
end;

{---------------}




procedure TBarcode.MakeModules;
begin
case Typ of
bcCode_2_5_interleaved,
bcCode_2_5_industrial,
bcCode39,
bcCodeEAN8,
bcCodeEAN13,
bcCode39Extended,
bcCodeCodabar,
bcCodeUPC_A,
bcCodeUPC_E0,
bcCodeUPC_E1,
bcCodeUPC_Supp2,
bcCodeUPC_Supp5:

begin
if Ratio < 2.0 then Ratio := 2.0;
if Ratio > 3.0 then Ratio := 3.0;
end;

bcCode_2_5_matrix:
begin
if Ratio < 2.25 then Ratio := 2.25;
if Ratio > 3.0 then Ratio := 3.0;
end;
bcCode128A,
bcCode128B,
bcCode128C,
bcCode93,
bcCode93Extended,
bcCodeMSI,
bcCodePostNet: ;
end;


modules[0] := FModul;
modules[1] := Round(FModul*FRatio);
modules[2] := modules[1] * 3 div 2;
modules[3] := modules[1] * 2;
end;






{
Draw the Barcode

Parameter :
'data' holds the pattern for a Barcode.
A barcode begins always with a black line and
ends with a black line.

The white Lines builds the space between the black Lines.

A black line must always followed by a white Line and vica versa.

Examples:
'50505' // 3 thin black Lines with 2 thin white Lines
'606' // 2 fat black Lines with 1 thin white Line

'5605015' // Error


data[] : see procedure OneBarProps

}
procedure TBarcode.DoLines(data:string; Canvas:TCanvas);

var i:integer;
lt : TBarLineType;
xadd:integer;
width, height:integer;
a,b,c,d, {Edges of a line (we need 4 Point because the line}
{is a recangle}
orgin : TPoint;
alpha:double;
begin
xadd := 0;
orgin.x := FLeft;
orgin.y := FTop;
alpha := FAngle*pi / 180.0;

//with Canvas do
//begin
Canvas.Pen.Width := 1;

for i:=1 to Length(data) do {examine the pattern string}
begin

{
input: pattern code
output: Width and Linetype
}
OneBarProps(data[i], width, lt);

if (lt = black) or (lt = black_half) then
begin
Canvas.Pen.Color := FColorBar;
end
else
begin
Canvas.Pen.Color := FColor;
end;
Canvas.Brush.Color := Canvas.Pen.Color;

if lt = black_half then
height := FHeight * 2 div 5
else
height := FHeight;

a.x := xadd;
a.y := 0;

b.x := xadd;
b.y := height;

{c.x := xadd width;}
c.x := xadd Width-1; {23.04.1999 Line was 1 Pixel too wide}
c.y := Height;

{d.x := xadd width;}
d.x := xadd Width-1; {23.04.1999 Line was 1 Pixel too wide}
d.y := 0;

{a,b,c,d builds the rectangle we want to draw}


{rotate the rectangle}
a := Translate2D(Rotate2D(a, alpha), orgin);
b := Translate2D(Rotate2D(b, alpha), orgin);
c := Translate2D(Rotate2D(c, alpha), orgin);
d := Translate2D(Rotate2D(d, alpha), orgin);

{draw the rectangle}
Canvas.Polygon([a,b,c,d]);

xadd := xadd width;
end;
//end;

// with Canvas do
// begin
// Pen.Width := 1;
//
// for i:=1 to Length(data) do {examine the pattern string}
// begin
//
// {
// input: pattern code
// output: Width and Linetype
// }
// OneBarProps(data[i], width, lt);
//
// if (lt = black) or (lt = black_half) then
// begin
// Pen.Color := FColorBar;
// end
// else
// begin
// Pen.Color := FColor;
// end;
// Brush.Color := Pen.Color;
//
// if lt = black_half then
// height := FHeight * 2 div 5
// else
// height := FHeight;
//
// a.x := xadd;
// a.y := 0;
//
// b.x := xadd;
// b.y := height;
//
// {c.x := xadd width;}
// c.x := xadd Width-1; {23.04.1999 Line was 1 Pixel too wide}
// c.y := Height;
//
// {d.x := xadd width;}
// d.x := xadd Width-1; {23.04.1999 Line was 1 Pixel too wide}
// d.y := 0;
//
// {a,b,c,d builds the rectangle we want to draw}
//
//
// {rotate the rectangle}
// a := Translate2D(Rotate2D(a, alpha), orgin);
// b := Translate2D(Rotate2D(b, alpha), orgin);
// c := Translate2D(Rotate2D(c, alpha), orgin);
// d := Translate2D(Rotate2D(d, alpha), orgin);
//
// {draw the rectangle}
// Polygon([a,b,c,d]);
//
// xadd := xadd width;
// end;
// end;

end;

procedure TBarcode.DrawBarcode(Canvas:TCanvas);
var
data : string;
SaveFont: TFont;
SavePen: TPen;
SaveBrush: TBrush;
begin
Savefont := TFont.Create;
SavePen := TPen.Create;
SaveBrush := TBrush.Create;
{get barcode pattern}
data := MakeData;


try
{store Canvas properties}
Savefont.Assign(Canvas.Font);
SavePen.Assign(Canvas.Pen);
SaveBrush.Assign(Canvas.Brush);

DoLines(data, Canvas); {draw the barcode}

if FShowText <> bcoNone then
DrawText(Canvas); {show readable Text}


{restore old Canvas properties}
Canvas.Font.Assign(savefont);
Canvas.Pen.Assign(SavePen);
Canvas.Brush.Assign(SaveBrush);
finally
Savefont.Free;
SavePen.Free;
SaveBrush.Free;
end;
end;

procedure TBarcode.DrawBarcodeToBmp(Bitmap:TBitmap);
var
data : string;
SaveFont: TFont;
SavePen: TPen;
SaveBrush: TBrush;
//Bmp:TBitmap;
begin
//Bitmap:=TBitmap.Create;

Savefont := TFont.Create;
SavePen := TPen.Create;
SaveBrush := TBrush.Create;


{get barcode pattern}
data := MakeData;


try
{store Canvas properties}
Savefont.Assign(Bitmap.Canvas.Font);
SavePen.Assign(Bitmap.Canvas.Pen);
SaveBrush.Assign(Bitmap.Canvas.Brush);
// Showmessage( Self.Width.ToString ' / ' Self.Height.ToString);
Bitmap.Width:=Self.Width 3;
Bitmap.Height:=Self.Height 2;
DoLines(data, Bitmap.Canvas); {draw the barcode}

if FShowText <> bcoNone then
DrawText(Bitmap.Canvas); {show readable Text}


{restore old Canvas properties}
Bitmap.Canvas.Font.Assign(savefont);
Bitmap.Canvas.Pen.Assign(SavePen);
Bitmap.Canvas.Brush.Assign(SaveBrush);
finally
Savefont.Free;
SavePen.Free;
SaveBrush.Free;
end;
// Bitmap.Width:=Self.Width 3; Bitmap.Height:=Self.Height 2;
//Bitmap.Assign(Bmp);
//Showmessage( Bitmap.Width.ToString '/' Bitmap.Height.ToString );
//Bmp.Free;
end;

{
draw contents and type/name of barcode
as human readable text at the left
upper edge of the barcode.

main use for this procedure is testing.

note: this procedure changes Pen and Brush
of the current canvas.
}
procedure TBarcode.DrawText(Canvas:TCanvas);
var w,h:integer;
begin
// with Canvas do
// begin
Canvas.Font.Size := 6;
{the fixed font size is a problem, if you
use very large or small barcodes}
w:=Canvas.TextWidth(FText);
h:=Canvas.TextHeight(FTExt);

Canvas.Pen.Color := clBlack;
Canvas.Brush.Color := clWhite;


if FShowText in [bcoCode, bcoBoth] then
begin
w:=Canvas.TextWidth(FText);
h:=Canvas.TextHeight(FTExt);
//Canvas.TextOut(FLeft, FTop, FText); {contents of Barcode}
Canvas.TextOut( (Self.Width-w) div 2, (Self.Height-h) 2, FText); {contents of Barcode}
end;


if FShowText in [bcoTyp, bcoBoth] then
begin
w:=Canvas.TextWidth(GetTypText);
h:=Canvas.TextHeight(GetTypText);
Canvas.TextOut( (Self.Width-w) div 2, 1, GetTypText); {type/name of barcode}
//Canvas.TextOut(FLeft, FTop 14, GetTypText); {type/name of barcode}
end;
// end;
end;



procedure Register;
begin
{
there is a function to determine the page name
independent of your language
but i forgot it.
could you get me a hint to avoid this hard coded string 'Extras'
}
RegisterComponents('CmjVcl', [TBarcode]);
end;

end.

//********************************************************************************


unit CmjQRCode;

// 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
Penalty := 0;
TheArray := Matrix.GetArray;
Width := Matrix.Width;
Height := Matrix.Height;
for Y := 0 to Height - 2 do
begin
for X := 0 to Width - 2 do
begin
Value := TheArray[Y][X];
if ((Value = TheArray[Y][X 1]) and (Value = TheArray[Y 1][X]) and
(Value = TheArray[Y 1][X 1])) then
begin
Inc(Penalty, 3);
end;
end;
end;
Result := Penalty;
end;

// Apply mask penalty rule 3 and return the penalty. Find consecutive cells of 00001011101 or
// 10111010000, and give penalty to them. If we find patterns like 000010111010000, we give
// penalties twice (i.e. 40 * 2).
function TEncoder.ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer;
var
Penalty: Integer;
TheArray: T2DByteArray;
Width: Integer;
Height: Integer;
X: Integer;
Y: Integer;
begin
Penalty := 0;
TheArray := Matrix.GetArray;
Width := Matrix.Width;
Height := Matrix.Height;
for Y := 0 to Height - 1 do
begin
for X := 0 to Width - 1 do
begin
if ((X 6 < Width) and
(TheArray[Y][X] = 1) and
(TheArray[Y][X 1] = 0) and
(TheArray[Y][X 2] = 1) and
(TheArray[Y][X 3] = 1) and
(TheArray[Y][X 4] = 1) and
(TheArray[Y][X 5] = 0) and
(TheArray[Y][X 6] = 1) and
(((X 10 < Width) and
(TheArray[Y][X 7] = 0) and
(TheArray[Y][X 8] = 0) and
(TheArray[Y][X 9] = 0) and
(TheArray[Y][X 10] = 0)) or
((x - 4 >= 0) and
(TheArray[Y][X - 1] = 0) and
(TheArray[Y][X - 2] = 0) and
(TheArray[Y][X - 3] = 0) and
(TheArray[Y][X - 4] = 0)))) then
begin
Inc(Penalty, 40);
end;
if ((Y 6 < Height) and
(TheArray[Y][X] = 1) and
(TheArray[Y 1][X] = 0) and
(TheArray[Y 2][X] = 1) and
(TheArray[Y 3][X] = 1) and
(TheArray[Y 4][X] = 1) and
(TheArray[Y 5][X] = 0) and
(TheArray[Y 6][X] = 1) and
(((Y 10 < Height) and
(TheArray[Y 7][X] = 0) and
(TheArray[Y 8][X] = 0) and
(TheArray[Y 9][X] = 0) and
(TheArray[Y 10][X] = 0)) or
((Y - 4 >= 0) and
(TheArray[Y - 1][X] = 0) and
(TheArray[Y - 2][X] = 0) and
(TheArray[Y - 3][X] = 0) and
(TheArray[Y - 4][X] = 0)))) then
begin
Inc(Penalty, 40);
end;
end;
end;
Result := Penalty;
end;

// Apply mask penalty rule 4 and return the penalty. Calculate the ratio of dark cells and give
// penalty if the ratio is far from 50%. It gives 10 penalty for 5% distance. Examples:
// - 0% => 100
// - 40% => 20
// - 45% => 10
// - 50% => 0
// - 55% => 10
// - 55% => 20
// - 100% => 100
function TEncoder.ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer;
var
NumDarkCells: Integer;
TheArray: T2DByteArray;
Width: Integer;
Height: Integer;
NumTotalCells: Integer;
DarkRatio: Double;
X: Integer;
Y: Integer;
begin
NumDarkCells := 0;
TheArray := Matrix.GetArray;
Width := Matrix.Width;
Height := matrix.Height;
for Y := 0 to Height - 1 do
begin
for X := 0 to Width - 1 do
begin
if (TheArray[Y][X] = 1) then
begin
Inc(NumDarkCells);
end;
end;
end;
numTotalCells := matrix.Height * Matrix.Width;
DarkRatio := NumDarkCells / NumTotalCells;
Result := Round(Abs((DarkRatio * 100 - 50)) / 50);
end;

// Helper function for applyMaskPenaltyRule1. We need this for doing this calculation in both
// vertical and horizontal orders respectively.
function TEncoder.ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix; IsHorizontal: Boolean): Integer;
var
Penalty: Integer;
NumSameBitCells: Integer;
PrevBit: Integer;
TheArray: T2DByteArray;
I: Integer;
J: Integer;
Bit: Integer;
ILimit: Integer;
JLimit: Integer;
begin
Penalty := 0;
NumSameBitCells := 0;
PrevBit := -1;
// Horizontal mode:
// for (int i = 0; i < matrix.height(); i) {
// for (int j = 0; j < matrix.width(); j) {
// int bit = matrix.get(i, j);
// Vertical mode:
// for (int i = 0; i < matrix.width(); i) {
// for (int j = 0; j < matrix.height(); j) {
// int bit = matrix.get(j, i);
if (IsHorizontal) then
begin
ILimit := Matrix.Height;
JLimit := Matrix.Width;
end else
begin
ILimit := Matrix.Width;
JLimit := Matrix.Height;
end;
TheArray := Matrix.GetArray;

for I := 0 to ILimit - 1 do
begin
for J := 0 to JLimit - 1 do
begin
if (IsHorizontal) then
begin
Bit := TheArray[I][J];
end else
begin
Bit := TheArray[J][I];
end;
if (Bit = PrevBit) then
begin
Inc(NumSameBitCells);
// Found five repetitive cells with the same color (bit).
// We'll give penalty of 3.
if (NumSameBitCells = 5) then
begin
Inc(Penalty, 3);
end else if (NumSameBitCells > 5) then
begin
// After five repetitive cells, we'll add the penalty one
// by one.
Inc(Penalty, 1);;
end;
end else
begin
NumSameBitCells := 1; // Include the cell itself.
PrevBit := bit;
end;
end;
NumSameBitCells := 0; // Clear at each row/column.
end;
Result := Penalty;
end;

{ TQRCode }

constructor TQRCode.Create;
begin
FMode := qmTerminator;
FQRCodeError := False;
FECLevel := nil;
FVersion := -1;
FMatrixWidth := -1;
FMaskPattern := -1;
FNumTotalBytes := -1;
FNumDataBytes := -1;
FNumECBytes := -1;
FNumRSBlocks := -1;
FMatrix := nil;
end;

destructor TQRCode.Destroy;
begin
if (Assigned(FECLevel)) then
begin
FECLevel.Free;
end;
if (Assigned(FMatrix)) then
begin
FMatrix.Free;
end;
inherited;
end;

function TQRCode.At(X, Y: Integer): Integer;
var
Value: Integer;
begin
// The value must be zero or one.
Value := FMatrix.Get(X, Y);
if (not ((Value = 0) or (Value = 1))) then
begin
FQRCodeError := True;
end;
Result := Value;
end;

function TQRCode.IsValid: Boolean;
begin
Result :=
// First check if all version are not uninitialized.
((FECLevel <> nil) and
(FVersion <> -1) and
(FMatrixWidth <> -1) and
(FMaskPattern <> -1) and
(FNumTotalBytes <> -1) and
(FNumDataBytes <> -1) and
(FNumECBytes <> -1) and
(FNumRSBlocks <> -1) and
// Then check them in other ways..
IsValidMaskPattern(FMaskPattern) and
(FNumTotalBytes = FNumDataBytes FNumECBytes) and
// ByteMatrix stuff.
(Assigned(FMatrix)) and
(FMatrixWidth = FMatrix.Width) and
// See 7.3.1 of JISX0510:2004 (Fp.5).
(FMatrix.Width = FMatrix.Height)); // Must be square.
end;

function TQRCode.IsValidMaskPattern(MaskPattern: Integer): Boolean;
begin
Result := (MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS);
end;

procedure TQRCode.SetMatrix(NewMatrix: TByteMatrix);
begin
if (Assigned(FMatrix)) then
begin
FMatrix.Free;
FMatrix := nil;
end;
FMatrix := NewMatrix;
end;

procedure TQRCode.SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks,
NumECBytes, MatrixWidth: Integer);
begin
FVersion := VersionNum;
FNumTotalBytes := NumBytes;
FNumDataBytes := NumDataBytes;
FNumRSBlocks := NumRSBlocks;
FNumECBytes := NumECBytes;
FMatrixWidth := MatrixWidth;
end;

procedure TQRCode.SetECLevel(NewECLevel: TErrorCorrectionLevel);
begin
if (Assigned(FECLevel)) then
begin
FECLevel.Free;
end;
FECLevel := TErrorCorrectionLevel.Create;
FECLevel.Assign(NewECLevel);
end;

{ TByteMatrix }

procedure TByteMatrix.Clear(Value: Byte);
var
X, Y: Integer;
begin
for Y := 0 to FHeight - 1 do
begin
for X := 0 to FWidth - 1 do
begin
Bytes[Y][X] := Value;
end;
end;
end;

constructor TByteMatrix.Create(Width, Height: Integer);
var
Y: Integer;
X: Integer;
begin
FWidth := Width;
FHeight := Height;
SetLength(Bytes, Height);
for Y := 0 to Height - 1 do
begin
SetLength(Bytes[Y], Width);
for X := 0 to Width - 1 do
begin
Bytes[Y][X] := 0;
end;
end;
end;

function TByteMatrix.Get(X, Y: Integer): Integer;
begin
if (Bytes[Y][X] = 255) then Result := -1 else Result := Bytes[Y][X];
end;

function TByteMatrix.GetArray: T2DByteArray;
begin
Result := Bytes;
end;

function TByteMatrix.Hash: AnsiString;
var
X, Y: Integer;
Counter: Integer;
CC: Integer;
begin
Result := '';
for Y := 0 to FHeight - 1 do
begin
Counter := 0;
for X := 0 to FWidth - 1 do
begin
CC := Get(X, Y);
if (CC = -1) then CC := 255;
Counter := Counter CC;
end;
Result := Result AnsiChar((Counter mod 26) 65);
end;
end;

procedure TByteMatrix.SetBoolean(X, Y: Integer; Value: Boolean);
begin
Bytes[Y][X] := Byte(Value) and $FF;
end;

procedure TByteMatrix.SetInteger(X, Y, Value: Integer);
begin
Bytes[Y][X] := Value and $FF;
end;

procedure TByteMatrix.Assign(Source: TByteMatrix);
var
SourceLength: Integer;
begin
SourceLength := Length(Source.Bytes);
SetLength(Bytes, SourceLength);
if (SourceLength > 0) then
begin
Move(Source.Bytes[0], Bytes[0], SourceLength);
end;
FWidth := Source.Width;
FHeight := Source.Height;
end;

{ TEncoder }

function TEncoder.CalculateMaskPenalty(Matrix: TByteMatrix): Integer;
var
Penalty: Integer;
begin
Penalty := 0;
Inc(Penalty, ApplyMaskPenaltyRule1(Matrix));
Inc(Penalty, ApplyMaskPenaltyRule2(Matrix));
Inc(Penalty, ApplyMaskPenaltyRule3(Matrix));
Inc(Penalty, ApplyMaskPenaltyRule4(Matrix));
Result := Penalty;
end;

{procedure TEncoder.Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
begin
Encode(Content, ECLevel, nil, QRCode);
end;}

procedure TEncoder.Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
var
Mode: TMode;
DataBits: TBitArray;
FinalBits: TBitArray;
HeaderBits: TBitArray;
HeaderAndDataBits: TBitArray;
Matrix: TByteMatrix;
NumLetters: Integer;
MatrixUtil: TMatrixUtil;
BitsNeeded: Integer;
ProvisionalBitsNeeded: Integer;
ProvisionalVersion: TVersion;
Version: TVersion;
ECBlocks: TECBlocks;
NumDataBytes: Integer;
Dimension: Integer;
FilteredContent: WideString;
begin
DataBits := TBitArray.Create;
HeaderBits := TBitArray.Create;

// Pick an encoding mode appropriate for the content. Note that this will not attempt to use
// multiple modes / segments even if that were more efficient. Twould be nice.
// Collect data within the main segment, separately, to count its size if needed. Don't add it to
// main payload yet.

Mode := ChooseMode(Content, EncodeOptions);
FilteredContent := FilterContent(Content, Mode, EncodeOptions);
AppendBytes(FilteredContent, Mode, DataBits, EncodeOptions);

// (With ECI in place,) Write the mode marker
AppendModeInfo(Mode, HeaderBits);

// Hard part: need to know version to know how many bits length takes. But need to know how many
// bits it takes to know version. First we take a guess at version by assuming version will be
// the minimum, 1:
ProvisionalVersion := TVersion.GetVersionForNumber(1);
try
ProvisionalBitsNeeded := HeaderBits.GetSize
GetModeCharacterCountBits(Mode, ProvisionalVersion)
DataBits.GetSize;
finally
ProvisionalVersion.Free;
end;

ProvisionalVersion := TVersion.ChooseVersion(ProvisionalBitsNeeded, ECLevel);
try
// Use that guess to calculate the right version. I am still not sure this works in 100% of cases.
BitsNeeded := HeaderBits.GetSize
GetModeCharacterCountBits(Mode, ProvisionalVersion)
DataBits.GetSize;
Version := TVersion.ChooseVersion(BitsNeeded, ECLevel);
finally
ProvisionalVersion.Free;
end;

HeaderAndDataBits := TBitArray.Create;
FinalBits := TBitArray.Create;
try
HeaderAndDataBits.AppendBitArray(HeaderBits);

// Find "length" of main segment and write it
if (Mode = qmByte) then
begin
NumLetters := DataBits.GetSizeInBytes;
end else
begin
NumLetters := Length(FilteredContent);
end;
AppendLengthInfo(NumLetters, Version.VersionNumber, Mode, HeaderAndDataBits);
// Put data together into the overall payload
HeaderAndDataBits.AppendBitArray(DataBits);

ECBlocks := Version.GetECBlocksForLevel(ECLevel);
NumDataBytes := Version.GetTotalCodewords - ECBlocks.GetTotalECCodewords;

// Terminate the bits properly.
TerminateBits(NumDataBytes, HeaderAndDataBits);

// Interleave data bits with error correction code.
InterleaveWithECBytes(HeaderAndDataBits, Version.GetTotalCodewords,
NumDataBytes, ECBlocks.GetNumBlocks, FinalBits);

// QRCode qrCode = new QRCode(); // This is passed in


QRCode.SetECLevel(ECLevel);
QRCode.Mode := Mode;
QRCode.Version := Version.VersionNumber;

// Choose the mask pattern and set to "qrCode".
Dimension := Version.GetDimensionForVersion;
Matrix := TByteMatrix.Create(Dimension, Dimension);

QRCode.MaskPattern := ChooseMaskPattern(FinalBits, ECLevel, Version.VersionNumber, Matrix);

Matrix.Free;
Matrix := TByteMatrix.Create(Dimension, Dimension);

// Build the matrix and set it to "qrCode".
MatrixUtil := TMatrixUtil.Create;
try
MatrixUtil.BuildMatrix(FinalBits, QRCode.ECLevel, QRCode.Version,
QRCode.MaskPattern, Matrix);
finally
MatrixUtil.Free;
end;

QRCode.SetMatrix(Matrix); // QRCode will free the matrix
finally
DataBits.Free;
HeaderAndDataBits.Free;
FinalBits.Free;
HeaderBits.Free;
Version.Free;
end;
end;

function TEncoder.FilterContent(const Content: WideString; Mode: TMode;
EncodeOptions: Integer): WideString;
var
X: Integer;
CanAdd: Boolean;
begin
Result := '';
for X := 1 to Length(Content) do
begin
CanAdd := False;
if (Mode = qmNumeric) then
begin
CanAdd := (Content[X] >= '0') and (Content[X] <= '9');
end else
if (Mode = qmAlphanumeric) then
begin
CanAdd := GetAlphanumericCode(Ord(Content[X])) > 0;
end else
if (Mode = qmByte) then
begin
if (EncodeOptions = 3) then
begin
CanAdd := Ord(Content[X]) <= $FF;
end else
if ((EncodeOptions = 4) or (EncodeOptions = 5)) then
begin
CanAdd := True;
end;
end;
if (CanAdd) then
begin
Result := Result Content[X];
end;
end;
end;

// Return the code point of the table used in alphanumeric mode or
// -1 if there is no corresponding code in the table.
function TEncoder.GetAlphanumericCode(Code: Integer): Integer;
begin
if (Code < Length(ALPHANUMERIC_TABLE)) then
begin
Result := ALPHANUMERIC_TABLE[Code];
end else
begin
Result := -1;
end;
end;

// Choose the mode based on the content
function TEncoder.ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode;
var
AllNumeric: Boolean;
AllAlphanumeric: Boolean;
AllISO: Boolean;
I: Integer;
C: WideChar;
begin
if (EncodeOptions = 0) then
begin
AllNumeric := Length(Content) > 0;
I := 1;
while (I <= Length(Content)) and (AllNumeric) do
begin
C := Content[I];
if ((C < '0') or (C > '9')) then
begin
AllNumeric := False;
end else
begin
Inc(I);
end;
end;

if (not AllNumeric) then
begin
AllAlphanumeric := Length(Content) > 0;
I := 1;
while (I <= Length(Content)) and (AllAlphanumeric) do
begin
C := Content[I];
if (GetAlphanumericCode(Ord(C)) < 0) then
begin
AllAlphanumeric := False;
end else
begin
Inc(I);
end;
end;
end else
begin
AllAlphanumeric := False;
end;

if (not AllAlphanumeric) then
begin
AllISO := Length(Content) > 0;
I := 1;
while (I <= Length(Content)) and (AllISO) do
begin
C := Content[I];
if (Ord(C) > $FF) then
begin
AllISO := False;
end else
begin
Inc(I);
end;
end;
end else
begin
AllISO := False;
end;

if (AllNumeric) then
begin
Result := qmNumeric;
end else
if (AllAlphanumeric) then
begin
Result := qmAlphanumeric;
end else
if (AllISO) then
begin
Result := qmByte;
EncodeOptions := 3;
end else
begin
Result := qmByte;
EncodeOptions := 4;
end;
end else
if (EncodeOptions = 1) then
begin
Result := qmNumeric;
end else
if (EncodeOptions = 2) then
begin
Result := qmAlphanumeric;
end else
begin
Result := qmByte;
end;
end;

constructor TEncoder.Create;
begin
FEncoderError := False;
end;

{function TEncoder.IsOnlyDoubleByteKanji(const Content: WideString): Boolean;
var
I: Integer;
Char1: Integer;
begin
Result := True;
I := 0;
while ((I < Length(Content)) and Result) do
begin
Char1 := Ord(Content[I 1]);
if (((Char1 < $81) or (Char1 > $9F)) and ((Char1 < $E0) or (Char1 > $EB))) then
begin
Result := False;
end;
end;
end;}

function TEncoder.ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel; Version: Integer; Matrix: TByteMatrix): Integer;
var
MinPenalty: Integer;
BestMaskPattern: Integer;
MaskPattern: Integer;
MatrixUtil: TMatrixUtil;
Penalty: Integer;
begin
MinPenalty := MaxInt;
BestMaskPattern := -1;

// We try all mask patterns to choose the best one.
for MaskPattern := 0 to NUM_MASK_PATTERNS - 1 do
begin
MatrixUtil := TMatrixUtil.Create;
try
MatrixUtil.BuildMatrix(Bits, ECLevel, Version, MaskPattern, Matrix);
finally
MatrixUtil.Free;
end;
Penalty := CalculateMaskPenalty(Matrix);
if (Penalty < MinPenalty) then
begin
MinPenalty := Penalty;
BestMaskPattern := MaskPattern;
end;
end;

Result := BestMaskPattern;
end;

// Terminate bits as described in 8.4.8 and 8.4.9 of JISX0510:2004 (p.24).
procedure TEncoder.TerminateBits(NumDataBytes: Integer; var Bits: TBitArray);
var
Capacity: Integer;
I: Integer;
NumBitsInLastByte: Integer;
NumPaddingBytes: Integer;
begin
Capacity := NumDataBytes shl 3;
if (Bits.GetSize > Capacity) then
begin
FEncoderError := True;
Exit;
end;
I := 0;
while ((I < 4) and (Bits.GetSize < capacity)) do
begin
Bits.AppendBit(False);
Inc(I);
end;

// Append termination bits. See 8.4.8 of JISX0510:2004 (p.24) for details.
// If the last byte isn't 8-bit aligned, we'll add padding bits.
NumBitsInLastByte := Bits.GetSize and $07;
if (NumBitsInLastByte > 0) then
begin
for I := numBitsInLastByte to 7 do
begin
Bits.AppendBit(False);
end;
end;

// If we have more space, we'll fill the space with padding patterns defined in 8.4.9 (p.24).
NumPaddingBytes := NumDataBytes - Bits.GetSizeInBytes;
for I := 0 to NumPaddingBytes - 1 do
begin
if ((I and $01) = 0) then
begin
Bits.AppendBits($EC, 8);
end else
begin
Bits.AppendBits($11, 8);
end;
end;
if (Bits.GetSize <> Capacity) then
begin
FEncoderError := True;
end;
end;

// Get number of data bytes and number of error correction bytes for block id "blockID". Store
// the result in "numDataBytesInBlock", and "numECBytesInBlock". See table 12 in 8.5.1 of
// JISX0510:2004 (p.30)
procedure TEncoder.GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes, NumDataBytes,
NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray;
var NumECBytesInBlock: TIntegerArray);
var
NumRSBlocksInGroup1: Integer;
NumRSBlocksInGroup2: Integer;
NumTotalBytesInGroup1: Integer;
NumTotalBytesInGroup2: Integer;
NumDataBytesInGroup1: Integer;
NumDataBytesInGroup2: Integer;
NumECBytesInGroup1: Integer;
NumECBytesInGroup2: Integer;
begin
if (BlockID >= NumRSBlocks) then
begin
FEncoderError := True;
Exit;
end;
// numRsBlocksInGroup2 = 196 % 5 = 1
NumRSBlocksInGroup2 := NumTotalBytes mod NumRSBlocks;
// numRsBlocksInGroup1 = 5 - 1 = 4
NumRSBlocksInGroup1 := NumRSBlocks - NumRSBlocksInGroup2;
// numTotalBytesInGroup1 = 196 / 5 = 39
NumTotalBytesInGroup1 := NumTotalBytes div NumRSBlocks;
// numTotalBytesInGroup2 = 39 1 = 40
NumTotalBytesInGroup2 := NumTotalBytesInGroup1 1;
// numDataBytesInGroup1 = 66 / 5 = 13
NumDataBytesInGroup1 := NumDataBytes div NumRSBlocks;
// numDataBytesInGroup2 = 13 1 = 14
NumDataBytesInGroup2 := NumDataBytesInGroup1 1;
// numEcBytesInGroup1 = 39 - 13 = 26
NumECBytesInGroup1 := NumTotalBytesInGroup1 - NumDataBytesInGroup1;
// numEcBytesInGroup2 = 40 - 14 = 26
NumECBytesInGroup2 := NumTotalBytesInGroup2 - NumDataBytesInGroup2;
// Sanity checks.
// 26 = 26
if (NumECBytesInGroup1 <> NumECBytesInGroup2) then
begin
FEncoderError := True;
Exit;
end;
// 5 = 4 1.
if (NumRSBlocks <> (NumRSBlocksInGroup1 NumRSBlocksInGroup2)) then
begin
FEncoderError := True;
Exit;
end;
// 196 = (13 26) * 4 (14 26) * 1
if (NumTotalBytes <>
((NumDataBytesInGroup1 NumECBytesInGroup1) * NumRsBlocksInGroup1)
((NumDataBytesInGroup2 NumECBytesInGroup2) * NumRsBlocksInGroup2)) then
begin
FEncoderError := True;
Exit;
end;

if (BlockID < NumRSBlocksInGroup1) then
begin
NumDataBytesInBlock[0] := NumDataBytesInGroup1;
NumECBytesInBlock[0] := numECBytesInGroup1;
end else
begin
NumDataBytesInBlock[0] := NumDataBytesInGroup2;
NumECBytesInBlock[0] := numEcBytesInGroup2;
end;
end;

// Interleave "bits" with corresponding error correction bytes. On success, store the result in
// "result". The interleave rule is complicated. See 8.6 of JISX0510:2004 (p.37) for details.
procedure TEncoder.InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes,
NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray);
var
DataBytesOffset: Integer;
MaxNumDataBytes: Integer;
MaxNumECBytes: Integer;
Blocks: TObjectList;
NumDataBytesInBlock: TIntegerArray;
NumECBytesInBlock: TIntegerArray;
Size: Integer;
DataBytes: TByteArray;
ECBytes: TByteArray;
I, J: Integer;
BlockPair: TBlockPair;
begin
SetLength(ECBytes, 0);

// "bits" must have "getNumDataBytes" bytes of data.
if (Bits.GetSizeInBytes <> NumDataBytes) then
begin
FEncoderError := True;
Exit;
end;

// Step 1. Divide data bytes into blocks and generate error correction bytes for them. We'll
// store the divided data bytes blocks and error correction bytes blocks into "blocks".
DataBytesOffset := 0;
MaxNumDataBytes := 0;
MaxNumEcBytes := 0;

// Since, we know the number of reedsolmon blocks, we can initialize the vector with the number.
Blocks := TObjectList.Create(True);
try
Blocks.Capacity := NumRSBlocks;

for I := 0 to NumRSBlocks - 1 do
begin
SetLength(NumDataBytesInBlock, 1);
SetLength(NumECBytesInBlock, 1);
GetNumDataBytesAndNumECBytesForBlockID(
NumTotalBytes, NumDataBytes, NumRSBlocks, I,
NumDataBytesInBlock, NumEcBytesInBlock);

Size := NumDataBytesInBlock[0];
SetLength(DataBytes, Size);
Bits.ToBytes(8 * DataBytesOffset, DataBytes, 0, Size);
ECBytes := GenerateECBytes(DataBytes, NumEcBytesInBlock[0]);
BlockPair := TBlockPair.Create(DataBytes, ECBytes);
Blocks.Add(BlockPair);

MaxNumDataBytes := Max(MaxNumDataBytes, Size);
MaxNumECBytes := Max(MaxNumECBytes, Length(ECBytes));
Inc(DataBytesOffset, NumDataBytesInBlock[0]);
end;
if (NumDataBytes <> DataBytesOffset) then
begin
FEncoderError := True;
Exit;
end;

// First, place data blocks.
for I := 0 to MaxNumDataBytes - 1 do
begin
for J := 0 to Blocks.Count - 1 do
begin
DataBytes := TBlockPair(Blocks.Items[J]).GetDataBytes;
if (I < Length(DataBytes)) then
begin
Result.AppendBits(DataBytes[I], 8);
end;
end;
end;
// Then, place error correction blocks.
for I := 0 to MaxNumECBytes - 1 do
begin
for J := 0 to Blocks.Count - 1 do
begin
ECBytes := TBlockPair(Blocks.Items[J]).GetErrorCorrectionBytes;
if (I < Length(ECBytes)) then
begin
Result.AppendBits(ECBytes[I], 8);
end;
end;
end;
finally
Blocks.Free;
end;
if (numTotalBytes <> Result.GetSizeInBytes) then // Should be same.
begin
FEncoderError := True;
Exit;
end;
end;

function TEncoder.GenerateECBytes(DataBytes: TByteArray; NumECBytesInBlock: Integer): TByteArray;
var
NumDataBytes: Integer;
ToEncode: TIntegerArray;
ReedSolomonEncoder: TReedSolomonEncoder;
I: Integer;
ECBytes: TByteArray;
GenericGF: TGenericGF;
begin
NumDataBytes := Length(DataBytes);
SetLength(ToEncode, NumDataBytes NumECBytesInBlock);

for I := 0 to NumDataBytes - 1 do
begin
ToEncode[I] := DataBytes[I] and $FF;
end;

GenericGF := TGenericGF.CreateQRCodeField256;
try
ReedSolomonEncoder := TReedSolomonEncoder.Create(GenericGF);
try
ReedSolomonEncoder.Encode(ToEncode, NumECBytesInBlock);
finally
ReedSolomonEncoder.Free;
end;
finally
GenericGF.Free;
end;

SetLength(ECBytes, NumECBytesInBlock);
for I := 0 to NumECBytesInBlock - 1 do
begin
ECBytes[I] := ToEncode[NumDataBytes I];
end;

Result := ECBytes;
end;

// Append mode info. On success, store the result in "bits".
procedure TEncoder.AppendModeInfo(Mode: TMode; Bits: TBitArray);
begin
Bits.AppendBits(GetModeBits(Mode), 4);
end;

// Append length info. On success, store the result in "bits".
procedure TEncoder.AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode; Bits: TBitArray);
var
NumBits: Integer;
Version: TVersion;
begin
Version := TVersion.GetVersionForNumber(VersionNum);
try
NumBits := GetModeCharacterCountBits(Mode, Version);
finally
Version.Free;
end;

if (NumLetters > ((1 shl NumBits) - 1)) then
begin
FEncoderError := True;
Exit;
end;

Bits.AppendBits(NumLetters, NumBits);
end;

// Append "bytes" in "mode" mode (encoding) into "bits". On success, store the result in "bits".
procedure TEncoder.AppendBytes(const Content: WideString; Mode: TMode; Bits: TBitArray; EncodeOptions: Integer);
begin
if (Mode = qmNumeric) then
begin
AppendNumericBytes(Content, Bits);
end else
if (Mode = qmAlphanumeric) then
begin
AppendAlphanumericBytes(Content, Bits);
end else
if (Mode = qmByte) then
begin
Append8BitBytes(Content, Bits, EncodeOptions);
end else
if (Mode = qmKanji) then
begin
AppendKanjiBytes(Content, Bits);
end else
begin
FEncoderError := True;
Exit;
end;
end;

procedure TEncoder.AppendNumericBytes(const Content: WideString; Bits: TBitArray);
var
ContentLength: Integer;
I: Integer;
Num1: Integer;
Num2: Integer;
Num3: Integer;
begin
ContentLength := Length(Content);
I := 0;
while (I < ContentLength) do
begin
Num1 := Ord(Content[I 0 1]) - Ord('0');
if (I 2 < ContentLength) then
begin
// Encode three numeric letters in ten bits.
Num2 := Ord(Content[I 1 1]) - Ord('0');
Num3 := Ord(Content[I 2 1]) - Ord('0');
Bits.AppendBits(Num1 * 100 Num2 * 10 Num3, 10);
Inc(I, 3);
end else
if (I 1 < ContentLength) then
begin
// Encode two numeric letters in seven bits.
Num2 := Ord(Content[I 1 1]) - Ord('0');
Bits.AppendBits(Num1 * 10 Num2, 7);
Inc(I, 2);
end else
begin
// Encode one numeric letter in four bits.
Bits.AppendBits(Num1, 4);
Inc(I);
end;
end;
end;

procedure TEncoder.AppendAlphanumericBytes(const Content: WideString; Bits: TBitArray);
var
ContentLength: Integer;
I: Integer;
Code1: Integer;
Code2: Integer;
begin
ContentLength := Length(Content);
I := 0;
while (I < ContentLength) do
begin
Code1 := GetAlphanumericCode(Ord(Content[I 0 1]));
if (Code1 = -1) then
begin
FEncoderError := True;
Exit;
end;
if (I 1 < ContentLength) then
begin
Code2 := GetAlphanumericCode(Ord(Content[I 1 1]));
if (Code2 = -1) then
begin
FEncoderError := True;
Exit;
end;
// Encode two alphanumeric letters in 11 bits.
Bits.AppendBits(Code1 * 45 Code2, 11);
Inc(I, 2);
end else
begin
// Encode one alphanumeric letter in six bits.
Bits.AppendBits(Code1, 6);
Inc(I);
end;
end;
end;

procedure TEncoder.Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer);
var
Bytes: TByteArray;
I: Integer;
UTF8Version: AnsiString;
begin
SetLength(Bytes, 0);
if (EncodeOptions = 3) then
begin
SetLength(Bytes, Length(Content));
for I := 1 to Length(Content) do
begin
Bytes[I - 1] := Ord(Content[I]) and $FF;
end;
end else
if (EncodeOptions = 4) then
begin
// Add the UTF-8 BOM
UTF8Version := #$EF#$BB#$BF UTF8Encode(Content);
SetLength(Bytes, Length(UTF8Version));
if (Length(UTF8Version) > 0) then
begin
Move(UTF8Version[1], Bytes[0], Length(UTF8Version));
end;
end else
if (EncodeOptions = 5) then
begin
// No BOM
UTF8Version := UTF8Encode(Content);
SetLength(Bytes, Length(UTF8Version));
if (Length(UTF8Version) > 0) then
begin
Move(UTF8Version[1], Bytes[0], Length(UTF8Version));
end;
end;
for I := 0 to Length(Bytes) - 1 do
begin
Bits.AppendBits(Bytes[I], 8);
end;
end;

procedure TEncoder.AppendKanjiBytes(const Content: WideString; Bits: TBitArray);
var
Bytes: TByteArray;
ByteLength: Integer;
I: Integer;
Byte1: Integer;
Byte2: Integer;
Code: Integer;
Subtracted: Integer;
Encoded: Integer;
begin
SetLength(Bytes, 0);
try

except
FEncoderError := True;
Exit;
end;

ByteLength := Length(Bytes);
I := 0;
while (I < ByteLength) do
begin
Byte1 := Bytes[I] and $FF;
Byte2 := Bytes[I 1] and $FF;
Code := (Byte1 shl 8) or Byte2;
Subtracted := -1;
if ((Code >= $8140) and (Code <= $9ffc)) then
begin
Subtracted := Code - $8140;
end else
if ((Code >= $e040) and (Code <= $ebbf)) then
begin
Subtracted := Code - $c140;
end;
if (Subtracted = -1) then
begin
FEncoderError := True;
Exit;
end;
Encoded := ((Subtracted shr 8) * $c0) (Subtracted and $ff);
Bits.AppendBits(Encoded, 13);
Inc(I, 2);
end;
end;

procedure TMatrixUtil.ClearMatrix(Matrix: TByteMatrix);
begin
Matrix.Clear(Byte(-1));
end;

constructor TMatrixUtil.Create;
begin
FMatrixUtilError := False;
end;

// Build 2D matrix of QR Code from "dataBits" with "ecLevel", "version" and "getMaskPattern". On
// success, store the result in "matrix" and return true.
procedure TMatrixUtil.BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel;
Version, MaskPattern: Integer; Matrix: TByteMatrix);
begin
ClearMatrix(Matrix);
EmbedBasicPatterns(Version, Matrix);

// Type information appear with any version.
EmbedTypeInfo(ECLevel, MaskPattern, Matrix);

// Version info appear if version >= 7.
MaybeEmbedVersionInfo(Version, Matrix);

// Data should be embedded at end.
EmbedDataBits(DataBits, MaskPattern, Matrix);
end;

// Embed basic patterns. On success, modify the matrix and return true.
// The basic patterns are:
// - Position detection patterns
// - Timing patterns
// - Dark dot at the left bottom corner
// - Position adjustment patterns, if need be
procedure TMatrixUtil.EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix);
begin
// Let's get started with embedding big squares at corners.
EmbedPositionDetectionPatternsAndSeparators(Matrix);

// Then, embed the dark dot at the left bottom corner.
EmbedDarkDotAtLeftBottomCorner(Matrix);

// Position adjustment patterns appear if version >= 2.
MaybeEmbedPositionAdjustmentPatterns(Version, Matrix);

// Timing patterns should be embedded after position adj. patterns.
EmbedTimingPatterns(Matrix);
end;

// Embed type information. On success, modify the matrix.
procedure TMatrixUtil.EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix);
var
TypeInfoBits: TBitArray;
I: Integer;
Bit: Boolean;
X1, Y1: Integer;
X2, Y2: Integer;
begin
TypeInfoBits := TBitArray.Create;
try
MakeTypeInfoBits(ECLevel, MaskPattern, TypeInfoBits);

for I := 0 to TypeInfoBits.GetSize - 1 do
begin
// Place bits in LSB to MSB order. LSB (least significant bit) is the last value in
// "typeInfoBits".
Bit := TypeInfoBits.Get(TypeInfoBits.GetSize - 1 - I);

// Type info bits at the left top corner. See 8.9 of JISX0510:2004 (p.46).
X1 := TYPE_INFO_COORDINATES[I][0];
Y1 := TYPE_INFO_COORDINATES[I][1];
Matrix.SetBoolean(X1, Y1, Bit);

if (I < 8) then
begin
// Right top corner.
X2 := Matrix.Width - I - 1;
Y2 := 8;
Matrix.SetBoolean(X2, Y2, Bit);
end else
begin
// Left bottom corner.
X2 := 8;
Y2 := Matrix.Height - 7 (I - 8);
Matrix.SetBoolean(X2, Y2, Bit);
end;
end;
finally
TypeInfoBits.Free;
end;
end;

// Embed version information if need be. On success, modify the matrix and return true.
// See 8.10 of JISX0510:2004 (p.47) for how to embed version information.
procedure TMatrixUtil.MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix);
var
VersionInfoBits: TBitArray;
I, J: Integer;
BitIndex: Integer;
Bit: Boolean;
begin
if (Version < 7) then
begin
Exit; // Don't need version info.
end;

VersionInfoBits := TBitArray.Create;
try
MakeVersionInfoBits(Version, VersionInfoBits);

BitIndex := 6 * 3 - 1; // It will decrease from 17 to 0.
for I := 0 to 5 do
begin
for J := 0 to 2 do
begin
// Place bits in LSB (least significant bit) to MSB order.
Bit := VersionInfoBits.Get(BitIndex);
Dec(BitIndex);
// Left bottom corner.
Matrix.SetBoolean(I, Matrix.Height - 11 J, Bit);
// Right bottom corner.
Matrix.SetBoolean(Matrix.Height - 11 J, I, bit);
end;
end;
finally
VersionInfoBits.Free;
end;
end;

// Embed "dataBits" using "getMaskPattern". On success, modify the matrix and return true.
// For debugging purposes, it skips masking process if "getMaskPattern" is -1.
// See 8.7 of JISX0510:2004 (p.38) for how to embed data bits.
procedure TMatrixUtil.EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix);
var
BitIndex: Integer;
Direction: Integer;
X, Y, I, XX: Integer;
Bit: Boolean;
MaskUtil: TMaskUtil;
begin
MaskUtil := TMaskUtil.Create;
try
bitIndex := 0;
direction := -1;
// Start from the right bottom cell.
X := Matrix.Width - 1;
Y := Matrix.Height - 1;
while (X > 0) do
begin
// Skip the vertical timing pattern.
if (X = 6) then
begin
Dec(X, 1);
end;
while ((Y >= 0) and (y < Matrix.Height)) do
begin
for I := 0 to 1 do
begin
XX := X - I;
// Skip the cell if it's not empty.
if (not IsEmpty(Matrix.Get(XX, Y))) then
begin
Continue;
end;

if (BitIndex < DataBits.GetSize) then
begin
Bit := DataBits.Get(BitIndex);
Inc(BitIndex);
end else
begin
// Padding bit. If there is no bit left, we'll fill the left cells with 0, as described
// in 8.4.9 of JISX0510:2004 (p. 24).
Bit := False;
end;

// Skip masking if mask_pattern is -1.
if (MaskPattern <> -1) then
begin
if (MaskUtil.GetDataMaskBit(MaskPattern, XX, Y)) then
begin
Bit := not Bit;
end;
end;
Matrix.SetBoolean(XX, Y, Bit);
end;
Inc(Y, Direction);
end;
Direction := -Direction; // Reverse the direction.
Inc(Y, Direction);
Dec(X, 2); // Move to the left.
end;
finally
MaskUtil.Free;
end;

// All bits should be consumed.
if (BitIndex <> DataBits.GetSize()) then
begin
FMatrixUtilError := True;
Exit;
end;
end;

// Return the position of the most significant bit set (to one) in the "value". The most
// significant bit is position 32. If there is no bit set, return 0. Examples:
// - findMSBSet(0) => 0
// - findMSBSet(1) => 1
// - findMSBSet(255) => 8
function TMatrixUtil.FindMSBSet(Value: Integer): Integer;
var
NumDigits: Integer;
begin
NumDigits := 0;
while (Value <> 0) do
begin
Value := Value shr 1;
Inc(NumDigits);
end;
Result := NumDigits;
end;

// Calculate BCH (Bose-Chaudhuri-Hocquenghem) code for "value" using polynomial "poly". The BCH
// code is used for encoding type information and version information.
// Example: Calculation of version information of 7.
// f(x) is created from 7.
// - 7 = 000111 in 6 bits
// - f(x) = x^2 x^1 x^0
// g(x) is given by the standard (p. 67)
// - g(x) = x^12 x^11 x^10 x^9 x^8 x^5 x^2 1
// Multiply f(x) by x^(18 - 6)
// - f'(x) = f(x) * x^(18 - 6)
// - f'(x) = x^14 x^13 x^12
// Calculate the remainder of f'(x) / g(x)
// x^2
// __________________________________________________
// g(x) )x^14 x^13 x^12
// x^14 x^13 x^12 x^11 x^10 x^7 x^4 x^2
// --------------------------------------------------
// x^11 x^10 x^7 x^4 x^2
//
// The remainder is x^11 x^10 x^7 x^4 x^2
// Encode it in binary: 110010010100
// The return value is 0xc94 (1100 1001 0100)
//
// Since all coefficients in the polynomials are 1 or 0, we can do the calculation by bit
// operations. We don't care if cofficients are positive or negative.
function TMatrixUtil.CalculateBCHCode(Value, Poly: Integer): Integer;
var
MSBSetInPoly: Integer;
begin
// If poly is "1 1111 0010 0101" (version info poly), msbSetInPoly is 13. We'll subtract 1
// from 13 to make it 12.
MSBSetInPoly := FindMSBSet(Poly);
Value := Value shl (MSBSetInPoly - 1);
// Do the division business using exclusive-or operations.
while (FindMSBSet(Value) >= MSBSetInPoly) do
begin
Value := Value xor (Poly shl (FindMSBSet(Value) - MSBSetInPoly));
end;
// Now the "value" is the remainder (i.e. the BCH code)
Result := Value;
end;

// Make bit vector of type information. On success, store the result in "bits" and return true.
// Encode error correction level and mask pattern. See 8.9 of
// JISX0510:2004 (p.45) for details.
procedure TMatrixUtil.MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray);
var
TypeInfo: Integer;
BCHCode: Integer;
MaskBits: TBitArray;
begin
if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then
begin
TypeInfo := (ECLevel.Bits shl 3) or MaskPattern;
Bits.AppendBits(TypeInfo, 5);

BCHCode := CalculateBCHCode(TypeInfo, TYPE_INFO_POLY);
Bits.AppendBits(BCHCode, 10);

MaskBits := TBitArray.Create;
try
MaskBits.AppendBits(TYPE_INFO_MASK_PATTERN, 15);
Bits.XorOperation(MaskBits);
finally
MaskBits.Free;
end;

if (Bits.GetSize <> 15) then // Just in case.
begin
FMatrixUtilError := True;
Exit;
end;
end;
end;

// Make bit vector of version information. On success, store the result in "bits" and return true.
// See 8.10 of JISX0510:2004 (p.45) for details.
procedure TMatrixUtil.MakeVersionInfoBits(Version: Integer; Bits: TBitArray);
var
BCHCode: Integer;
begin
Bits.AppendBits(Version, 6);
BCHCode := CalculateBCHCode(Version, VERSION_INFO_POLY);
Bits.AppendBits(BCHCode, 12);

if (Bits.GetSize() <> 18) then
begin
FMatrixUtilError := True;
Exit;
end;
end;

// Check if "value" is empty.
function TMatrixUtil.IsEmpty(Value: Integer): Boolean;
begin
Result := (Value = -1);
end;

procedure TMatrixUtil.EmbedTimingPatterns(Matrix: TByteMatrix);
var
I: Integer;
Bit: Integer;
begin
// -8 is for skipping position detection patterns (size 7), and two horizontal/vertical
// separation patterns (size 1). Thus, 8 = 7 1.
for I := 8 to Matrix.Width - 9 do
begin
Bit := (I 1) mod 2;
// Horizontal line.
if (IsEmpty(Matrix.Get(I, 6))) then
begin
Matrix.SetInteger(I, 6, Bit);
end;
// Vertical line.
if (IsEmpty(Matrix.Get(6, I))) then
begin
Matrix.SetInteger(6, I, Bit);
end;
end;
end;

// Embed the lonely dark dot at left bottom corner. JISX0510:2004 (p.46)
procedure TMatrixUtil.EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix);
begin
if (Matrix.Get(8, Matrix.Height - 8) = 0) then
begin
FMatrixUtilError := True;
Exit;
end;
Matrix.SetInteger(8, Matrix.Height - 8, 1);
end;

procedure TMatrixUtil.EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
var
X: Integer;
begin
// We know the width and height.
for X := 0 to 7 do
begin
if (not IsEmpty(Matrix.Get(XStart X, YStart))) then
begin
FMatrixUtilError := True;
Exit;
end;
Matrix.SetInteger(XStart X, YStart, HORIZONTAL_SEPARATION_PATTERN[0][X]);
end;
end;

procedure TMatrixUtil.EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
var
Y: Integer;
begin
// We know the width and height.
for Y := 0 to 6 do
begin
if (not IsEmpty(Matrix.Get(XStart, YStart Y))) then
begin
FMatrixUtilError := True;
Exit;
end;
Matrix.SetInteger(XStart, YStart Y, VERTICAL_SEPARATION_PATTERN[Y][0]);
end;
end;

// Note that we cannot unify the function with embedPositionDetectionPattern() despite they are
// almost identical, since we cannot write a function that takes 2D arrays in different sizes in
// C/C . We should live with the fact.
procedure TMatrixUtil.EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
var
X, Y: Integer;
begin
// We know the width and height.
for Y := 0 to 4 do
begin
for X := 0 to 4 do
begin
if (not IsEmpty(Matrix.Get(XStart X, YStart Y))) then
begin
FMatrixUtilError := True;
Exit;
end;
Matrix.SetInteger(XStart X, YStart Y, POSITION_ADJUSTMENT_PATTERN[Y][X]);
end;
end;
end;

procedure TMatrixUtil.EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
var
X, Y: Integer;
begin
// We know the width and height.
for Y := 0 to 6 do
begin
for X := 0 to 6 do
begin
if (not IsEmpty(Matrix.Get(XStart X, YStart Y))) then
begin
FMatrixUtilError := True;
Exit;
end;
Matrix.SetInteger(XStart X, YStart Y, POSITION_DETECTION_PATTERN[Y][X]);
end;
end;
end;

// Embed position detection patterns and surrounding vertical/horizontal separators.
procedure TMatrixUtil.EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix);
var
PDPWidth: Integer;
HSPWidth: Integer;
VSPSize: Integer;
begin
// Embed three big squares at corners.
PDPWidth := Length(POSITION_DETECTION_PATTERN[0]);
// Left top corner.
EmbedPositionDetectionPattern(0, 0, Matrix);
// Right top corner.
EmbedPositionDetectionPattern(Matrix.Width - PDPWidth, 0, Matrix);
// Left bottom corner.
EmbedPositionDetectionPattern(0, Matrix.Width- PDPWidth, Matrix);

// Embed horizontal separation patterns around the squares.
HSPWidth := Length(HORIZONTAL_SEPARATION_PATTERN[0]);
// Left top corner.
EmbedHorizontalSeparationPattern(0, HSPWidth - 1, Matrix);
// Right top corner.
EmbedHorizontalSeparationPattern(Matrix.Width - HSPWidth,
HSPWidth - 1, Matrix);
// Left bottom corner.
EmbedHorizontalSeparationPattern(0, Matrix.Width - HSPWidth, Matrix);

// Embed vertical separation patterns around the squares.
VSPSize := Length(VERTICAL_SEPARATION_PATTERN);
// Left top corner.
EmbedVerticalSeparationPattern(VSPSize, 0, Matrix);
// Right top corner.
EmbedVerticalSeparationPattern(Matrix.Height - VSPSize - 1, 0, Matrix);
// Left bottom corner.
EmbedVerticalSeparationPattern(VSPSize, Matrix.Height - VSPSize, Matrix);
end;

// Embed position adjustment patterns if need be.
procedure TMatrixUtil.MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix);
var
Index: Integer;
Coordinates: array of Integer;
NumCoordinates: Integer;
X, Y, I, J: Integer;
begin
if (Version >= 2) then
begin
Index := Version - 1;
NumCoordinates := Length(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index]);
SetLength(Coordinates, NumCoordinates);
Move(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index][0], Coordinates[0], NumCoordinates * SizeOf(Integer));
for I := 0 to NumCoordinates - 1 do
begin
for J := 0 to NumCoordinates - 1 do
begin
Y := Coordinates[I];
X := Coordinates[J];
if ((X = -1) or (Y = -1)) then
begin
Continue;
end;
// If the cell is unset, we embed the position adjustment pattern here.
if (IsEmpty(Matrix.Get(X, Y))) then
begin
// -2 is necessary since the x/y coordinates point to the center of the pattern, not the
// left top corner.
EmbedPositionAdjustmentPattern(X - 2, Y - 2, Matrix);
end;
end;
end;
end;
end;


{ TBitArray }


procedure TBitArray.AppendBits(Value, NumBits: Integer);
var
NumBitsLeft: Integer;
begin
if ((NumBits < 0) or (NumBits > 32)) then
begin

end;
EnsureCapacity(Size NumBits);
for NumBitsLeft := NumBits downto 1 do
begin
AppendBit(((Value shr (NumBitsLeft - 1)) and $01) = 1);
end;
end;

constructor TBitArray.Create(Size: Integer);

begin
Size := Size;
SetLength(Bits, (Size 31) shr 5);
end;

constructor TBitArray.Create;
begin
Size := 0;
SetLength(Bits, 1);
end;

function TBitArray.Get(I: Integer): Boolean;
begin
Result := (Bits[I shr 5] and (1 shl (I and $1F))) <> 0;
end;

function TBitArray.GetSize: Integer;
begin
Result := Size;
end;

function TBitArray.GetSizeInBytes: Integer;
begin
Result := (Size 7) shr 3;
end;

procedure TBitArray.SetBit(Index: Integer);
begin
Bits[Index shr 5] := Bits[Index shr 5] or (1 shl (Index and $1F));
end;

procedure TBitArray.AppendBit(Bit: Boolean);
begin
EnsureCapacity(Size 1);
if (Bit) then
begin
Bits[Size shr 5] := Bits[Size shr 5] or (1 shl (Size and $1F));
end;
Inc(Size);
end;

procedure TBitArray.ToBytes(BitOffset: Integer; Source: TByteArray; Offset,
NumBytes: Integer);
var
I: Integer;
J: Integer;
TheByte: Integer;
begin
for I := 0 to NumBytes - 1 do
begin
TheByte := 0;
for J := 0 to 7 do
begin
if (Get(BitOffset)) then
begin
TheByte := TheByte or (1 shl (7 - J));
end;
Inc(BitOffset);
end;
Source[Offset I] := TheByte;
end;
end;

procedure TBitArray.XorOperation(Other: TBitArray);
var
I: Integer;
begin
if (Length(Bits) = Length(Other.Bits)) then
begin
for I := 0 to Length(Bits) - 1 do
begin
// The last byte could be incomplete (i.e. not have 8 bits in
// it) but there is no problem since 0 XOR 0 == 0.
Bits[I] := Bits[I] xor Other.Bits[I];
end;
end;
end;

procedure TBitArray.AppendBitArray(NewBitArray: TBitArray);
var
OtherSize: Integer;
I: Integer;
begin
OtherSize := NewBitArray.GetSize;
EnsureCapacity(Size OtherSize);
for I := 0 to OtherSize - 1 do
begin
AppendBit(NewBitArray.Get(I));
end;
end;

procedure TBitArray.EnsureCapacity(Size: Integer);
begin
if (Size > (Length(Bits) shl 5)) then
begin
SetLength(Bits, Size);
end;
end;

{ TErrorCorrectionLevel }

procedure TErrorCorrectionLevel.Assign(Source: TErrorCorrectionLevel);
begin
Self.FBits := Source.FBits;
end;

function TErrorCorrectionLevel.Ordinal: Integer;
begin
Result := 0;
end;

{ TVersion }

class function TVersion.ChooseVersion(NumInputBits: Integer;
ECLevel: TErrorCorrectionLevel): TVersion;
var
VersionNum: Integer;
Version: TVersion;
NumBytes: Integer;
ECBlocks: TECBlocks;
NumECBytes: Integer;
NumDataBytes: Integer;
TotalInputBytes: Integer;
begin
Result := nil;
// In the following comments, we use numbers of Version 7-H.
for VersionNum := 1 to 40 do
begin
Version := TVersion.GetVersionForNumber(VersionNum);

// numBytes = 196
NumBytes := Version.GetTotalCodewords;
// getNumECBytes = 130
ECBlocks := Version.GetECBlocksForLevel(ECLevel);
NumECBytes := ECBlocks.GetTotalECCodewords;
// getNumDataBytes = 196 - 130 = 66
NumDataBytes := NumBytes - NumECBytes;
TotalInputBytes := (NumInputBits 7) div 8;

if (numDataBytes >= totalInputBytes) then
begin
Result := Version;
Exit;
end else
begin
Version.Free;
end;
end;
end;

constructor TVersion.Create(VersionNumber: Integer;
AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3,
ECBlocks4: TECBlocks);
var
Total: Integer;
ECBlock: TECB;
ECBArray: TECBArray;
I: Integer;
begin
Self.VersionNumber := VersionNumber;
SetLength(Self.AlignmentPatternCenters, Length(AlignmentPatternCenters));
if (Length(AlignmentPatternCenters) > 0) then
begin
Move(AlignmentPatternCenters[0], Self.AlignmentPatternCenters[0],
Length(AlignmentPatternCenters) * SizeOf(Integer));
end;
SetLength(ECBlocks, 4);
ECBlocks[0] := ECBlocks1;
ECBlocks[1] := ECBlocks2;
ECBlocks[2] := ECBlocks3;
ECBlocks[3] := ECBlocks4;
Total := 0;
ECCodewords := ECBlocks1.GetECCodewordsPerBlock;
ECBArray := ECBlocks1.GetECBlocks;
for I := 0 to Length(ECBArray) - 1 do
begin
ECBlock := ECBArray[I];
Inc(Total, ECBlock.GetCount * (ECBlock.GetDataCodewords ECCodewords));
end;
TotalCodewords := Total;
end;

destructor TVersion.Destroy;
var
X: Integer;
begin
for X := 0 to Length(ECBlocks) - 1 do
begin
ECBlocks[X].Free;
end;
inherited;
end;

function TVersion.GetDimensionForVersion: Integer;
begin
Result := 17 4 * VersionNumber;
end;

function TVersion.GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
begin
Result := ECBlocks[ECLevel.Ordinal];
end;

function TVersion.GetTotalCodewords: Integer;
begin
Result := TotalCodewords;
end;

class function TVersion.GetVersionForNumber(VersionNum: Integer): TVersion;
begin
if (VersionNum = 1) then
begin
Result := TVersion.Create(1, [],
TECBlocks.Create(7, TECB.Create(1, 19)),
TECBlocks.Create(10, TECB.Create(1, 16)),
TECBlocks.Create(13, TECB.Create(1, 13)),
TECBlocks.Create(17, TECB.Create(1, 9)));
end else
if (VersionNum = 2) then
begin
Result := TVersion.Create(2, [6, 18],
TECBlocks.Create(10, TECB.Create(1, 34)),
TECBlocks.Create(16, TECB.Create(1, 28)),
TECBlocks.Create(22, TECB.Create(1, 22)),
TECBlocks.Create(28, TECB.Create(1, 16)));
end else
if (VersionNum = 3) then
begin
Result := TVersion.Create(3, [6, 22],
TECBlocks.Create(15, TECB.Create(1, 55)),
TECBlocks.Create(26, TECB.Create(1, 44)),
TECBlocks.Create(18, TECB.Create(2, 17)),
TECBlocks.Create(22, TECB.Create(2, 13)));
end else
if (VersionNum = 4) then
begin
Result := TVersion.Create(4, [6, 26],
TECBlocks.Create(20, TECB.Create(1, 80)),
TECBlocks.Create(18, TECB.Create(2, 32)),
TECBlocks.Create(26, TECB.Create(2, 24)),
TECBlocks.Create(16, TECB.Create(4, 9)));
end else
if (VersionNum = 5) then
begin
Result := TVersion.Create(5, [6, 30],
TECBlocks.Create(26, TECB.Create(1, 108)),
TECBlocks.Create(24, TECB.Create(2, 43)),
TECBlocks.Create(18, TECB.Create(2, 15),
TECB.Create(2, 16)),
TECBlocks.Create(22, TECB.Create(2, 11),
TECB.Create(2, 12)));
end else
if (VersionNum = 6) then
begin
Result := TVersion.Create(6, [6, 34],
TECBlocks.Create(18, TECB.Create(2, 68)),
TECBlocks.Create(16, TECB.Create(4, 27)),
TECBlocks.Create(24, TECB.Create(4, 19)),
TECBlocks.Create(28, TECB.Create(4, 15)));
end else
if (VersionNum = 7) then
begin
Result := TVersion.Create(7, [6, 22, 38],
TECBlocks.Create(20, TECB.Create(2, 78)),
TECBlocks.Create(18, TECB.Create(4, 31)),
TECBlocks.Create(18, TECB.Create(2, 14),
TECB.Create(4, 15)),
TECBlocks.Create(26, TECB.Create(4, 13),
TECB.Create(1, 14)));
end else
if (VersionNum = 8) then
begin
Result := TVersion.Create(8, [6, 24, 42],
TECBlocks.Create(24, TECB.Create(2, 97)),
TECBlocks.Create(22, TECB.Create(2, 38),
TECB.Create(2, 39)),
TECBlocks.Create(22, TECB.Create(4, 18),
TECB.Create(2, 19)),
TECBlocks.Create(26, TECB.Create(4, 14),
TECB.Create(2, 15)));
end else
if (VersionNum = 9) then
begin
Result := TVersion.Create(9, [6, 26, 46],
TECBlocks.Create(30, TECB.Create(2, 116)),
TECBlocks.Create(22, TECB.Create(3, 36),
TECB.Create(2, 37)),
TECBlocks.Create(20, TECB.Create(4, 16),
TECB.Create(4, 17)),
TECBlocks.Create(24, TECB.Create(4, 12),
TECB.Create(4, 13)));
end else
if (VersionNum = 10) then
begin
Result := TVersion.Create(10, [6, 28, 50],
TECBlocks.Create(18, TECB.Create(2, 68),
TECB.Create(2, 69)),
TECBlocks.Create(26, TECB.Create(4, 43),
TECB.Create(1, 44)),
TECBlocks.Create(24, TECB.Create(6, 19),
TECB.Create(2, 20)),
TECBlocks.Create(28, TECB.Create(6, 15),
TECB.Create(2, 16)));
end else
if (VersionNum = 11) then
begin
Result := TVersion.Create(11, [6, 30, 54],
TECBlocks.Create(20, TECB.Create(4, 81)),
TECBlocks.Create(30, TECB.Create(1, 50),
TECB.Create(4, 51)),
TECBlocks.Create(28, TECB.Create(4, 22),
TECB.Create(4, 23)),
TECBlocks.Create(24, TECB.Create(3, 12),
TECB.Create(8, 13)));
end else
if (VersionNum = 12) then
begin
Result := TVersion.Create(12, [6, 32, 58],
TECBlocks.Create(24, TECB.Create(2, 92),
TECB.Create(2, 93)),
TECBlocks.Create(22, TECB.Create(6, 36),
TECB.Create(2, 37)),
TECBlocks.Create(26, TECB.Create(4, 20),
TECB.Create(6, 21)),
TECBlocks.Create(28, TECB.Create(7, 14),
TECB.Create(4, 15)));
end else
if (VersionNum = 13) then
begin
Result := TVersion.Create(13, [6, 34, 62],
TECBlocks.Create(26, TECB.Create(4, 107)),
TECBlocks.Create(22, TECB.Create(8, 37),
TECB.Create(1, 38)),
TECBlocks.Create(24, TECB.Create(8, 20),
TECB.Create(4, 21)),
TECBlocks.Create(22, TECB.Create(12, 11),
TECB.Create(4, 12)));
end else
if (VersionNum = 14) then
begin
Result := TVersion.Create(14, [6, 26, 46, 66],
TECBlocks.Create(30, TECB.Create(3, 115),
TECB.Create(1, 116)),
TECBlocks.Create(24, TECB.Create(4, 40),
TECB.Create(5, 41)),
TECBlocks.Create(20, TECB.Create(11, 16),
TECB.Create(5, 17)),
TECBlocks.Create(24, TECB.Create(11, 12),
TECB.Create(5, 13)));
end else
if (VersionNum = 15) then
begin
Result := TVersion.Create(15, [6, 26, 48, 70],
TECBlocks.Create(22, TECB.Create(5, 87),
TECB.Create(1, 88)),
TECBlocks.Create(24, TECB.Create(5, 41),
TECB.Create(5, 42)),
TECBlocks.Create(30, TECB.Create(5, 24),
TECB.Create(7, 25)),
TECBlocks.Create(24, TECB.Create(11, 12),
TECB.Create(7, 13)));
end else
if (VersionNum = 16) then
begin
Result := TVersion.Create(16, [6, 26, 50, 74],
TECBlocks.Create(24, TECB.Create(5, 98),
TECB.Create(1, 99)),
TECBlocks.Create(28, TECB.Create(7, 45),
TECB.Create(3, 46)),
TECBlocks.Create(24, TECB.Create(15, 19),
TECB.Create(2, 20)),
TECBlocks.Create(30, TECB.Create(3, 15),
TECB.Create(13, 16)));
end else
if (VersionNum = 17) then
begin
Result := TVersion.Create(17, [6, 30, 54, 78],
TECBlocks.Create(28, TECB.Create(1, 107),
TECB.Create(5, 108)),
TECBlocks.Create(28, TECB.Create(10, 46),
TECB.Create(1, 47)),
TECBlocks.Create(28, TECB.Create(1, 22),
TECB.Create(15, 23)),
TECBlocks.Create(28, TECB.Create(2, 14),
TECB.Create(17, 15)));
end else
if (VersionNum = 18) then
begin
Result := TVersion.Create(18, [6, 30, 56, 82],
TECBlocks.Create(30, TECB.Create(5, 120),
TECB.Create(1, 121)),
TECBlocks.Create(26, TECB.Create(9, 43),
TECB.Create(4, 44)),
TECBlocks.Create(28, TECB.Create(17, 22),
TECB.Create(1, 23)),
TECBlocks.Create(28, TECB.Create(2, 14),
TECB.Create(19, 15)));
end else
if (VersionNum = 19) then
begin
Result := TVersion.Create(19, [6, 30, 58, 86],
TECBlocks.Create(28, TECB.Create(3, 113),
TECB.Create(4, 114)),
TECBlocks.Create(26, TECB.Create(3, 44),
TECB.Create(11, 45)),
TECBlocks.Create(26, TECB.Create(17, 21),
TECB.Create(4, 22)),
TECBlocks.Create(26, TECB.Create(9, 13),
TECB.Create(16, 14)));
end else
if (VersionNum = 20) then
begin
Result := TVersion.Create(20, [6, 34, 62, 90],
TECBlocks.Create(28, TECB.Create(3, 107),
TECB.Create(5, 108)),
TECBlocks.Create(26, TECB.Create(3, 41),
TECB.Create(13, 42)),
TECBlocks.Create(30, TECB.Create(15, 24),
TECB.Create(5, 25)),
TECBlocks.Create(28, TECB.Create(15, 15),
TECB.Create(10, 16)));
end else
if (VersionNum = 21) then
begin
Result := TVersion.Create(21, [6, 28, 50, 72, 94],
TECBlocks.Create(28, TECB.Create(4, 116),
TECB.Create(4, 117)),
TECBlocks.Create(26, TECB.Create(17, 42)),
TECBlocks.Create(28, TECB.Create(17, 22),
TECB.Create(6, 23)),
TECBlocks.Create(30, TECB.Create(19, 16),
TECB.Create(6, 17)));
end else
if (VersionNum = 22) then
begin
Result := TVersion.Create(22, [6, 26, 50, 74, 98],
TECBlocks.Create(28, TECB.Create(2, 111),
TECB.Create(7, 112)),
TECBlocks.Create(28, TECB.Create(17, 46)),
TECBlocks.Create(30, TECB.Create(7, 24),
TECB.Create(16, 25)),
TECBlocks.Create(24, TECB.Create(34, 13)));
end else
if (VersionNum = 23) then
begin
Result := TVersion.Create(23, [6, 30, 54, 78, 102],
TECBlocks.Create(30, TECB.Create(4, 121),
TECB.Create(5, 122)),
TECBlocks.Create(28, TECB.Create(4, 47),
TECB.Create(14, 48)),
TECBlocks.Create(30, TECB.Create(11, 24),
TECB.Create(14, 25)),
TECBlocks.Create(30, TECB.Create(16, 15),
TECB.Create(14, 16)));
end else
if (VersionNum = 24) then
begin
Result := TVersion.Create(24, [6, 28, 54, 80, 106],
TECBlocks.Create(30, TECB.Create(6, 117),
TECB.Create(4, 118)),
TECBlocks.Create(28, TECB.Create(6, 45),
TECB.Create(14, 46)),
TECBlocks.Create(30, TECB.Create(11, 24),
TECB.Create(16, 25)),
TECBlocks.Create(30, TECB.Create(30, 16),
TECB.Create(2, 17)));
end else
if (VersionNum = 25) then
begin
Result := TVersion.Create(25, [6, 32, 58, 84, 110],
TECBlocks.Create(26, TECB.Create(8, 106),
TECB.Create(4, 107)),
TECBlocks.Create(28, TECB.Create(8, 47),
TECB.Create(13, 48)),
TECBlocks.Create(30, TECB.Create(7, 24),
TECB.Create(22, 25)),
TECBlocks.Create(30, TECB.Create(22, 15),
TECB.Create(13, 16)));
end else
if (VersionNum = 26) then
begin
Result := TVersion.Create(26, [6, 30, 58, 86, 114],
TECBlocks.Create(28, TECB.Create(10, 114),
TECB.Create(2, 115)),
TECBlocks.Create(28, TECB.Create(19, 46),
TECB.Create(4, 47)),
TECBlocks.Create(28, TECB.Create(28, 22),
TECB.Create(6, 23)),
TECBlocks.Create(30, TECB.Create(33, 16),
TECB.Create(4, 17)));
end else
if (VersionNum = 27) then
begin
Result := TVersion.Create(27, [6, 34, 62, 90, 118],
TECBlocks.Create(30, TECB.Create(8, 122),
TECB.Create(4, 123)),
TECBlocks.Create(28, TECB.Create(22, 45),
TECB.Create(3, 46)),
TECBlocks.Create(30, TECB.Create(8, 23),
TECB.Create(26, 24)),
TECBlocks.Create(30, TECB.Create(12, 15),
TECB.Create(28, 16)));
end else
if (VersionNum = 28) then
begin
Result := TVersion.Create(28, [6, 26, 50, 74, 98, 122],
TECBlocks.Create(30, TECB.Create(3, 117),
TECB.Create(10, 118)),
TECBlocks.Create(28, TECB.Create(3, 45),
TECB.Create(23, 46)),
TECBlocks.Create(30, TECB.Create(4, 24),
TECB.Create(31, 25)),
TECBlocks.Create(30, TECB.Create(11, 15),
TECB.Create(31, 16)));
end else
if (VersionNum = 29) then
begin
Result := TVersion.Create(29, [6, 30, 54, 78, 102, 126],
TECBlocks.Create(30, TECB.Create(7, 116),
TECB.Create(7, 117)),
TECBlocks.Create(28, TECB.Create(21, 45),
TECB.Create(7, 46)),
TECBlocks.Create(30, TECB.Create(1, 23),
TECB.Create(37, 24)),
TECBlocks.Create(30, TECB.Create(19, 15),
TECB.Create(26, 16)));
end else
if (VersionNum = 30) then
begin
Result := TVersion.Create(30, [6, 26, 52, 78, 104, 130],
TECBlocks.Create(30, TECB.Create(5, 115),
TECB.Create(10, 116)),
TECBlocks.Create(28, TECB.Create(19, 47),
TECB.Create(10, 48)),
TECBlocks.Create(30, TECB.Create(15, 24),
TECB.Create(25, 25)),
TECBlocks.Create(30, TECB.Create(23, 15),
TECB.Create(25, 16)));
end else
if (VersionNum = 31) then
begin
Result := TVersion.Create(31, [6, 30, 56, 82, 108, 134],
TECBlocks.Create(30, TECB.Create(13, 115),
TECB.Create(3, 116)),
TECBlocks.Create(28, TECB.Create(2, 46),
TECB.Create(29, 47)),
TECBlocks.Create(30, TECB.Create(42, 24),
TECB.Create(1, 25)),
TECBlocks.Create(30, TECB.Create(23, 15),
TECB.Create(28, 16)));
end else
if (VersionNum = 32) then
begin
Result := TVersion.Create(32, [6, 34, 60, 86, 112, 138],
TECBlocks.Create(30, TECB.Create(17, 115)),
TECBlocks.Create(28, TECB.Create(10, 46),
TECB.Create(23, 47)),
TECBlocks.Create(30, TECB.Create(10, 24),
TECB.Create(35, 25)),
TECBlocks.Create(30, TECB.Create(19, 15),
TECB.Create(35, 16)));
end else
if (VersionNum = 33) then
begin
Result := TVersion.Create(33, [6, 30, 58, 86, 114, 142],
TECBlocks.Create(30, TECB.Create(17, 115),
TECB.Create(1, 116)),
TECBlocks.Create(28, TECB.Create(14, 46),
TECB.Create(21, 47)),
TECBlocks.Create(30, TECB.Create(29, 24),
TECB.Create(19, 25)),
TECBlocks.Create(30, TECB.Create(11, 15),
TECB.Create(46, 16)));
end else
if (VersionNum = 34) then
begin
Result := TVersion.Create(34, [6, 34, 62, 90, 118, 146],
TECBlocks.Create(30, TECB.Create(13, 115),
TECB.Create(6, 116)),
TECBlocks.Create(28, TECB.Create(14, 46),
TECB.Create(23, 47)),
TECBlocks.Create(30, TECB.Create(44, 24),
TECB.Create(7, 25)),
TECBlocks.Create(30, TECB.Create(59, 16),
TECB.Create(1, 17)));
end else
if (VersionNum = 35) then
begin
Result := TVersion.Create(35, [6, 30, 54, 78, 102, 126, 150],
TECBlocks.Create(30, TECB.Create(12, 121),
TECB.Create(7, 122)),
TECBlocks.Create(28, TECB.Create(12, 47),
TECB.Create(26, 48)),
TECBlocks.Create(30, TECB.Create(39, 24),
TECB.Create(14, 25)),
TECBlocks.Create(30, TECB.Create(22, 15),
TECB.Create(41, 16)));
end else
if (VersionNum = 36) then
begin
Result := TVersion.Create(36, [6, 24, 50, 76, 102, 128, 154],
TECBlocks.Create(30, TECB.Create(6, 121),
TECB.Create(14, 122)),
TECBlocks.Create(28, TECB.Create(6, 47),
TECB.Create(34, 48)),
TECBlocks.Create(30, TECB.Create(46, 24),
TECB.Create(10, 25)),
TECBlocks.Create(30, TECB.Create(2, 15),
TECB.Create(64, 16)));
end else
if (VersionNum = 37) then
begin
Result := TVersion.Create(37, [6, 28, 54, 80, 106, 132, 158],
TECBlocks.Create(30, TECB.Create(17, 122),
TECB.Create(4, 123)),
TECBlocks.Create(28, TECB.Create(29, 46),
TECB.Create(14, 47)),
TECBlocks.Create(30, TECB.Create(49, 24),
TECB.Create(10, 25)),
TECBlocks.Create(30, TECB.Create(24, 15),
TECB.Create(46, 16)));
end else
if (VersionNum = 38) then
begin
Result := TVersion.Create(38, [6, 32, 58, 84, 110, 136, 162],
TECBlocks.Create(30, TECB.Create(4, 122),
TECB.Create(18, 123)),
TECBlocks.Create(28, TECB.Create(13, 46),
TECB.Create(32, 47)),
TECBlocks.Create(30, TECB.Create(48, 24),
TECB.Create(14, 25)),
TECBlocks.Create(30, TECB.Create(42, 15),
TECB.Create(32, 16)));
end else
if (VersionNum = 39) then
begin
Result := TVersion.Create(39, [6, 26, 54, 82, 110, 138, 166],
TECBlocks.Create(30, TECB.Create(20, 117),
TECB.Create(4, 118)),
TECBlocks.Create(28, TECB.Create(40, 47),
TECB.Create(7, 48)),
TECBlocks.Create(30, TECB.Create(43, 24),
TECB.Create(22, 25)),
TECBlocks.Create(30, TECB.Create(10, 15),
TECB.Create(67, 16)));
end else
if (VersionNum = 40) then
begin
Result := TVersion.Create(40, [6, 30, 58, 86, 114, 142, 170],
TECBlocks.Create(30, TECB.Create(19, 118),
TECB.Create(6, 119)),
TECBlocks.Create(28, TECB.Create(18, 47),
TECB.Create(31, 48)),
TECBlocks.Create(30, TECB.Create(34, 24),
TECB.Create(34, 25)),
TECBlocks.Create(30, TECB.Create(20, 15),
TECB.Create(61, 16)));
end else
begin
Result := nil;
end;
end;

{ TMaskUtil }

// Return the mask bit for "getMaskPattern" at "x" and "y". See 8.8 of JISX0510:2004 for mask
// pattern conditions.
function TMaskUtil.GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
var
Intermediate: Integer;
Temp: Integer;
begin
Intermediate := 0;
if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then
begin
case (maskPattern) of
0: Intermediate := (Y X) and 1;
1: Intermediate := Y and 1;
2: Intermediate := X mod 3;
3: Intermediate := (Y X) mod 3;
4: Intermediate := ((y shr 1) (X div 3)) and 1;
5:
begin
Temp := Y * X;
Intermediate := (Temp and 1) (Temp mod 3);
end;
6:
begin
Temp := Y * X;
Intermediate := ((Temp and 1) (Temp mod 3)) and 1;
end;
7:
begin
Temp := Y * X;
Intermediate := ((temp mod 3) ((Y X) and 1)) and 1;
end;
end;
end;
Result := Intermediate = 0;
end;

{ TECBlocks }

constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB);
begin
Self.ECCodewordsPerBlock := ECCodewordsPerBlock;
SetLength(Self.ECBlocks, 1);
Self.ECBlocks[0] := ECBlocks;
end;

constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks1,
ECBlocks2: TECB);
begin
Self.ECCodewordsPerBlock := ECCodewordsPerBlock;
SetLength(Self.ECBlocks, 2);
ECBlocks[0] := ECBlocks1;
ECBlocks[1] := ECBlocks2;
end;

destructor TECBlocks.Destroy;
var
X: Integer;
begin
for X := 0 to Length(ECBlocks) - 1 do
begin
ECBlocks[X].Free;
end;
inherited;
end;

function TECBlocks.GetECBlocks: TECBArray;
begin
Result := ECBlocks;
end;

function TECBlocks.GetECCodewordsPerBlock: Integer;
begin
Result := ECCodewordsPerBlock;
end;

function TECBlocks.GetNumBlocks: Integer;
var
Total: Integer;
I: Integer;
begin
Total := 0;
for I := 0 to Length(ECBlocks) - 1 do
begin
Inc(Total, ECBlocks[I].GetCount);
end;
Result := Total;
end;

function TECBlocks.GetTotalECCodewords: Integer;
begin
Result := ECCodewordsPerBlock * GetNumBlocks;
end;

{ TBlockPair }

constructor TBlockPair.Create(BA1, BA2: TByteArray);
begin
FDataBytes := BA1;
FErrorCorrectionBytes := BA2;
end;

function TBlockPair.GetDataBytes: TByteArray;
begin
Result := FDataBytes;
end;

function TBlockPair.GetErrorCorrectionBytes: TByteArray;
begin
Result := FErrorCorrectionBytes;
end;

{ TReedSolomonEncoder }

function TReedSolomonEncoder.BuildGenerator(Degree: Integer): TGenericGFPoly;
var
LastGenerator: TGenericGFPoly;
NextGenerator: TGenericGFPoly;
Poly: TGenericGFPoly;
D: Integer;
CA: TIntegerArray;
begin
if (Degree >= FCachedGenerators.Count) then
begin
LastGenerator := TGenericGFPoly(FCachedGenerators[FCachedGenerators.Count - 1]);

for D := FCachedGenerators.Count to Degree do
begin
SetLength(CA, 2);
CA[0] := 1;
CA[1] := FField.Exp(D - 1 FField.GetGeneratorBase);
Poly := TGenericGFPoly.Create(FField, CA);
NextGenerator := LastGenerator.Multiply(Poly);
FCachedGenerators.Add(NextGenerator);
LastGenerator := NextGenerator;
end;
end;
Result := TGenericGFPoly(FCachedGenerators[Degree]);
end;

constructor TReedSolomonEncoder.Create(AField: TGenericGF);
var
GenericGFPoly: TGenericGFPoly;
IntArray: TIntegerArray;
begin
FField := AField;

// Contents of FCachedGenerators will be freed by FGenericGF.Destroy
FCachedGenerators := TObjectList.Create(False);

SetLength(IntArray, 1);
IntArray[0] := 1;
GenericGFPoly := TGenericGFPoly.Create(AField, IntArray);
FCachedGenerators.Add(GenericGFPoly);
end;

destructor TReedSolomonEncoder.Destroy;
begin
FCachedGenerators.Free;
inherited;
end;

procedure TReedSolomonEncoder.Encode(ToEncode: TIntegerArray; ECBytes: Integer);
var
DataBytes: Integer;
Generator: TGenericGFPoly;
InfoCoefficients: TIntegerArray;
Info: TGenericGFPoly;
Remainder: TGenericGFPoly;
Coefficients: TIntegerArray;
NumZeroCoefficients: Integer;
I: Integer;
begin
SetLength(Coefficients, 0);
if (ECBytes > 0) then
begin
DataBytes := Length(ToEncode) - ECBytes;
if (DataBytes > 0) then
begin
Generator := BuildGenerator(ECBytes);
SetLength(InfoCoefficients, DataBytes);
InfoCoefficients := Copy(ToEncode, 0, DataBytes);
Info := TGenericGFPoly.Create(FField, InfoCoefficients);
Info := Info.MultiplyByMonomial(ECBytes, 1);
Remainder := Info.Divide(Generator)[1];
Coefficients := Remainder.GetCoefficients;
NumZeroCoefficients := ECBytes - Length(Coefficients);
for I := 0 to NumZeroCoefficients - 1 do
begin
ToEncode[DataBytes I] := 0;
end;
Move(Coefficients[0], ToEncode[DataBytes NumZeroCoefficients], Length(Coefficients) * SizeOf(Integer));
end;
end;
end;

{ TECB }

constructor TECB.Create(Count, DataCodewords: Integer);
begin
Self.Count := Count;
Self.DataCodewords := DataCodewords;
end;

function TECB.GetCount: Integer;
begin
Result := Count;
end;

function TECB.GetDataCodewords: Integer;
begin
Result := DataCodewords;
end;

{ TGenericGFPoly }

function TGenericGFPoly.AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly;
var
SmallerCoefficients: TIntegerArray;
LargerCoefficients: TIntegerArray;
Temp: TIntegerArray;
SumDiff: TIntegerArray;
LengthDiff: Integer;
I: Integer;
begin
SetLength(SmallerCoefficients, 0);
SetLength(LargerCoefficients, 0);
SetLength(Temp, 0);
SetLength(SumDiff, 0);

Result := nil;
if (Assigned(Other)) then
begin
if (FField = Other.FField) then
begin
if (IsZero) then
begin
Result := Other;
Exit;
end;

if (Other.IsZero) then
begin
Result := Self;
Exit;
end;

SmallerCoefficients := FCoefficients;
LargerCoefficients := Other.Coefficients;
if (Length(SmallerCoefficients) > Length(LargerCoefficients)) then
begin
Temp := smallerCoefficients;
SmallerCoefficients := LargerCoefficients;
LargerCoefficients := temp;
end;
SetLength(SumDiff, Length(LargerCoefficients));
LengthDiff := Length(LargerCoefficients) - Length(SmallerCoefficients);

// Copy high-order terms only found in higher-degree polynomial's coefficients
if (LengthDiff > 0) then
begin
//SumDiff := Copy(LargerCoefficients, 0, LengthDiff);
Move(LargerCoefficients[0], SumDiff[0], LengthDiff * SizeOf(Integer));
end;

for I := LengthDiff to Length(LargerCoefficients) - 1 do
begin
SumDiff[I] := TGenericGF.AddOrSubtract(SmallerCoefficients[I - LengthDiff], LargerCoefficients[I]);
end;

Result := TGenericGFPoly.Create(FField, SumDiff);
end;
end;
end;

function TGenericGFPoly.Coefficients: TIntegerArray;
begin
Result := FCoefficients;
end;

constructor TGenericGFPoly.Create(AField: TGenericGF;
ACoefficients: TIntegerArray);
var
CoefficientsLength: Integer;
FirstNonZero: Integer;
begin
FField := AField;
SetLength(FField.FPolyList, Length(FField.FPolyList) 1);
FField.FPolyList[Length(FField.FPolyList) - 1] := Self;
CoefficientsLength := Length(ACoefficients);
if ((CoefficientsLength > 1) and (ACoefficients[0] = 0)) then
begin
// Leading term must be non-zero for anything except the constant polynomial "0"
FirstNonZero := 1;
while ((FirstNonZero < CoefficientsLength) and (ACoefficients[FirstNonZero] = 0)) do
begin
Inc(FirstNonZero);
end;

if (FirstNonZero = CoefficientsLength) then
begin
FCoefficients := AField.GetZero.Coefficients;
end else
begin
SetLength(FCoefficients, CoefficientsLength - FirstNonZero);
FCoefficients := Copy(ACoefficients, FirstNonZero, Length(FCoefficients));
end;
end else
begin
FCoefficients := ACoefficients;
end;
end;

destructor TGenericGFPoly.Destroy;
begin
Self.FField := FField;
inherited;
end;

function TGenericGFPoly.Divide(Other: TGenericGFPoly): TGenericGFPolyArray;
var
Quotient: TGenericGFPoly;
Remainder: TGenericGFPoly;
DenominatorLeadingTerm: Integer;
InverseDenominatorLeadingTerm: integer;
DegreeDifference: Integer;
Scale: Integer;
Term: TGenericGFPoly;
IterationQuotient: TGenericGFPoly;
begin
SetLength(Result, 0);
if ((FField = Other.FField) and (not Other.IsZero)) then
begin

Quotient := FField.GetZero;
Remainder := Self;

DenominatorLeadingTerm := Other.GetCoefficient(Other.GetDegree);
InverseDenominatorLeadingTerm := FField.Inverse(DenominatorLeadingTerm);

while ((Remainder.GetDegree >= Other.GetDegree) and (not Remainder.IsZero)) do
begin
DegreeDifference := Remainder.GetDegree - Other.GetDegree;
Scale := FField.Multiply(Remainder.GetCoefficient(Remainder.GetDegree), InverseDenominatorLeadingTerm);
Term := Other.MultiplyByMonomial(DegreeDifference, Scale);
IterationQuotient := FField.BuildMonomial(degreeDifference, scale);
Quotient := Quotient.AddOrSubtract(IterationQuotient);
Remainder := Remainder.AddOrSubtract(Term);
end;

SetLength(Result, 2);
Result[0] := Quotient;
Result[1] := Remainder;
end;
end;

function TGenericGFPoly.GetCoefficient(Degree: Integer): Integer;
begin
Result := FCoefficients[Length(FCoefficients) - 1 - Degree];
end;

function TGenericGFPoly.GetCoefficients: TIntegerArray;
begin
Result := FCoefficients;
end;

function TGenericGFPoly.GetDegree: Integer;
begin
Result := Length(FCoefficients) - 1;
end;

function TGenericGFPoly.IsZero: Boolean;
begin
Result := FCoefficients[0] = 0;
end;

function TGenericGFPoly.Multiply(Other: TGenericGFPoly): TGenericGFPoly;
var
ACoefficients: TIntegerArray;
BCoefficients: TIntegerArray;
Product: TIntegerArray;
ALength: Integer;
BLength: Integer;
I: Integer;
J: Integer;
ACoeff: Integer;
begin
SetLength(ACoefficients, 0);
SetLength(BCoefficients, 0);
Result := nil;

if (FField = Other.FField) then
begin
if (IsZero or Other.IsZero) then
begin
Result := FField.GetZero;
Exit;
end;

ACoefficients := FCoefficients;
ALength := Length(ACoefficients);
BCoefficients := Other.Coefficients;
BLength := Length(BCoefficients);
SetLength(Product, aLength bLength - 1);
for I := 0 to ALength - 1 do
begin
ACoeff := ACoefficients[I];
for J := 0 to BLength - 1 do
begin
Product[I J] := TGenericGF.AddOrSubtract(Product[I J],
FField.Multiply(ACoeff, BCoefficients[J]));
end;
end;
Result := TGenericGFPoly.Create(FField, Product);
end;
end;

function TGenericGFPoly.MultiplyByMonomial(Degree,
Coefficient: Integer): TGenericGFPoly;
var
I: Integer;
Size: Integer;
Product: TIntegerArray;
begin
Result := nil;
if (Degree >= 0) then
begin
if (Coefficient = 0) then
begin
Result := FField.GetZero;
Exit;
end;
Size := Length(Coefficients);
SetLength(Product, Size Degree);
for I := 0 to Size - 1 do
begin
Product[I] := FField.Multiply(FCoefficients[I], Coefficient);
end;
Result := TGenericGFPoly.Create(FField, Product);
end;
end;

{ TGenericGF }

class function TGenericGF.AddOrSubtract(A, B: Integer): Integer;
begin
Result := A xor B;
end;

function TGenericGF.BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
var
Coefficients: TIntegerArray;
begin
CheckInit();

if (Degree >= 0) then
begin
if (Coefficient = 0) then
begin
Result := FZero;
Exit;
end;
SetLength(Coefficients, Degree 1);
Coefficients[0] := Coefficient;
Result := TGenericGFPoly.Create(Self, Coefficients);
end else
begin
Result := nil;
end;
end;

procedure TGenericGF.CheckInit;
begin
if (not FInitialized) then
begin
Initialize;
end;
end;

constructor TGenericGF.Create(Primitive, Size, B: Integer);
begin
FInitialized := False;
FPrimitive := Primitive;
FSize := Size;
FGeneratorBase := B;
if (FSize < 0) then
begin
Initialize;
end;
end;

class function TGenericGF.CreateQRCodeField256: TGenericGF;
begin
Result := TGenericGF.Create($011D, 256, 0);
end;

destructor TGenericGF.Destroy;
var
X: Integer;
Y: Integer;
begin
for X := 0 to Length(FPolyList) - 1 do
begin
if (Assigned(FPolyList[X])) then
begin
for Y := X 1 to Length(FPolyList) - 1 do
begin
if (FPolyList[Y] = FPolyList[X]) then
begin
FPolyList[Y] := nil;
end;
end;
FPolyList[X].Free;
end;
end;
inherited;
end;

function TGenericGF.Exp(A: Integer): Integer;
begin
CheckInit;
Result := FExpTable[A];
end;

function TGenericGF.GetGeneratorBase: Integer;
begin
Result := FGeneratorBase;
end;

function TGenericGF.GetZero: TGenericGFPoly;
begin
CheckInit;
Result := FZero;
end;

procedure TGenericGF.Initialize;
var
X: Integer;
I: Integer;
CA: TIntegerArray;
begin
SetLength(FExpTable, FSize);
SetLength(FLogTable, FSize);
X := 1;
for I := 0 to FSize - 1 do
begin
FExpTable[I] := x;
X := X shl 1; // x = x * 2; we're assuming the generator alpha is 2
if (X >= FSize) then
begin
X := X xor FPrimitive;
X := X and (FSize - 1);
end;
end;

for I := 0 to FSize - 2 do
begin
FLogTable[FExpTable[I]] := I;
end;

// logTable[0] == 0 but this should never be used

SetLength(CA, 1);
CA[0] := 0;
FZero := TGenericGFPoly.Create(Self, CA);

SetLength(CA, 1);
CA[0] := 1;
FOne := TGenericGFPoly.Create(Self, CA);

FInitialized := True;
end;

function TGenericGF.Inverse(A: Integer): Integer;
begin
CheckInit;

if (a <> 0) then
begin
Result := FExpTable[FSize - FLogTable[A] - 1];
end else
begin
Result := 0;
end;
end;

function TGenericGF.Multiply(A, B: Integer): Integer;
begin
CheckInit;
if ((A <> 0) and (B <> 0)) then
begin
Result := FExpTable[(FLogTable[A] FLogTable[B]) mod (FSize - 1)];
end else
begin
Result := 0;
end;
end;

function GenerateQRCode(const Input: WideString; EncodeOptions: Integer): T2DBooleanArray;
var
Encoder: TEncoder;
Level: TErrorCorrectionLevel;
QRCode: TQRCode;
X: Integer;
Y: Integer;
begin
Level := TErrorCorrectionLevel.Create;
Level.FBits := 1;
Encoder := TEncoder.Create;
QRCode := TQRCode.Create;
try
Encoder.Encode(Input, EncodeOptions, Level, QRCode);
if (Assigned(QRCode.FMatrix)) then
begin
SetLength(Result, QRCode.FMatrix.FHeight);
for Y := 0 to QRCode.FMatrix.FHeight - 1 do
begin
SetLength(Result[Y], QRCode.FMatrix.FWidth);
for X := 0 to QRCode.FMatrix.FWidth - 1 do
begin
Result[Y][X] := QRCode.FMatrix.Get(Y, X) = 1;
end;
end;
end;
finally
QRCode.Free;
Encoder.Free;
Level.Free;
end;
end;

{ TDelphiZXingQRCode }

constructor TDelphiZXingQRCode.Create;
begin
FData := '';
FEncoding := qrAuto;
FQuietZone := 4;
FRows := 0;
FColumns := 0;
end;

function TDelphiZXingQRCode.GetIsBlack(Row, Column: Integer): Boolean;
begin
Dec(Row, FQuietZone);
Dec(Column, FQuietZone);
if ((Row >= 0) and (Column >= 0) and (Row < (FRows - FQuietZone * 2)) and (Column < (FColumns - FQuietZone * 2))) then
begin
Result := FElements[Column, Row];
end else
begin
Result := False;
end;
end;

procedure TDelphiZXingQRCode.SetData(const NewData: WideString);
begin
if (FData <> NewData) then
begin
FData := NewData;
Update;
end;
end;

procedure TDelphiZXingQRCode.SetEncoding(NewEncoding: TQRCodeEncoding);
begin
if (FEncoding <> NewEncoding) then
begin
FEncoding := NewEncoding;
Update;
end;
end;

procedure TDelphiZXingQRCode.SetQuietZone(NewQuietZone: Integer);
begin
if ((FQuietZone <> NewQuietZone) and (NewQuietZone >= 0) and (NewQuietZone <= 100)) then
begin
FQuietZone := NewQuietZone;
Update;
end;
end;

procedure TDelphiZXingQRCode.Update;
begin
FElements := GenerateQRCode(FData, Ord(FEncoding));
FRows := Length(FElements) FQuietZone * 2;
FColumns := FRows;
end;

end.
//********************

編輯記錄

感謝版主  我會去試試看
感激不盡

感謝 cmj1498 回復
我會去試試看
感激不盡

謝謝 cmj1498 和 PD 無私的分享！

你是要做電子發票吧!
我已經全部完成且上線了，有問題可問我