/[projects]/dao/DelphiScanner/Components/tpsystools_4.04/source/St2DBarC.pas
ViewVC logotype

Annotation of /dao/DelphiScanner/Components/tpsystools_4.04/source/St2DBarC.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2671 - (hide annotations) (download)
Tue Aug 25 18:15:15 2015 UTC (8 years, 10 months ago) by torben
File size: 198425 byte(s)
Added tpsystools component
1 torben 2671 // Upgraded to Delphi 2009: Sebastian Zierer
2    
3     (* ***** BEGIN LICENSE BLOCK *****
4     * Version: MPL 1.1
5     *
6     * The contents of this file are subject to the Mozilla Public License Version
7     * 1.1 (the "License"); you may not use this file except in compliance with
8     * the License. You may obtain a copy of the License at
9     * http://www.mozilla.org/MPL/
10     *
11     * Software distributed under the License is distributed on an "AS IS" basis,
12     * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13     * for the specific language governing rights and limitations under the
14     * License.
15     *
16     * The Original Code is TurboPower SysTools
17     *
18     * The Initial Developer of the Original Code is
19     * TurboPower Software
20     *
21     * Portions created by the Initial Developer are Copyright (C) 1996-2002
22     * the Initial Developer. All Rights Reserved.
23     *
24     * Contributor(s):
25     *
26     * ***** END LICENSE BLOCK ***** *)
27    
28     {*********************************************************}
29     {* SysTools: St2DBarC.pas 4.04 *}
30     {*********************************************************}
31     {* SysTools: Two-Dimensional Barcodes *}
32     {*********************************************************}
33    
34     {$I StDefine.inc}
35    
36     unit St2DBarC;
37    
38     interface
39    
40     uses
41     Windows,
42     Messages,
43     SysUtils,
44     Classes,
45     Controls,
46     Graphics,
47     StdCtrls,
48     Math,
49     ClipBrd,
50     StConst;
51    
52     resourcestring
53    
54     StEBadBarHeight = 'Bar Height cannot be less than one';
55     StEBadBarHeightToWidth = 'BarHeightToWidth cannot be less than one';
56     StEBadBarWidth = 'Bar Width cannot be less than one';
57     StEBadCountryCode = 'Invalid Country Code';
58     StEBadNumCols = 'Invalid Number of columns';
59     StEBadNumRows = 'Invalid number of rows';
60     StEBadPostalCode = 'Invalid Postal Code';
61     StEBadServiceClass = 'Invalid Service Class';
62     StEBadQuietZone = 'Invalid Quiet Zone';
63     StECodeTooLarge = 'Code too large for barcode';
64     StEGLIOutOfRange = 'GLI value out of range';
65     StEInvalidCodeword = 'Invalid Codeword';
66     StENeedBarHeight = 'Either BarHeight or BarHeightToWidth is required';
67     StENeedHorz = 'Horizontal size needs to be specified';
68     StENeedVert = 'Vertical size needs to be specified';
69    
70     type
71     { Generic 2D barcode types and constants }
72    
73     TStDataMode = (dmBinary, dmText, dmNumeric);
74    
75     { PDF417 types and constants }
76    
77     TStPDF417CodewordList = array [0..2700] of Word;
78     TStPDF417ECCLevels = (ecAuto, ecLevel0, ecLevel1, ecLevel2, ecLevel3,
79     ecLevel4, ecLevel5, ecLevel6, ecLevel7, ecLevel8);
80    
81     { MaxiCode types and constants }
82    
83     TStMaxiCodeMode = (cmMode2, cmMode3, cmMode4, cmMode5, cmMode6);
84    
85     const
86     StMaxiCodeGaloisField = 64; { Galois field to work in }
87     StMaxiCodeECCPoly = 67; { Primary polynomial - }
88     StMaxMaxiCodeECCDataSize = 144; { Max amount of data }
89    
90     type
91     TStMaxiCodeECCData = array [0..StMaxMaxiCodeECCDataSize] of Byte;
92     TStMaxiCodeECCPoly = (epPrimary, epStandard, epEnhanced);
93     TStMaxiCodeECCInterleave = (imNone, imEven, imOdd);
94    
95     { E2DBarcodeError }
96    
97     E2DBarcodeError = class (Exception);
98    
99     { TStCustom2DBarcode }
100    
101     TStCustom2DBarcode = class (TGraphicControl)
102     protected { private }
103     FCode : string;
104     FBarWidth : Integer;
105     FBackgroundColor : TColor;
106     FCaption : string;
107     FECCLevel : Integer;
108     FExtendedSyntax : Boolean;
109     FRelativeBarHeight : Boolean;
110     FBarHeightToWidth : Integer;
111     FBarHeight : Integer;
112    
113     FQuietZone : Integer;
114     FAlignment : TAlignment;
115     FCaptionLayout : TTextLayout;
116     FBarCodeRect : TRect;
117     FUsedCodewords : Integer;
118     FFreeCodewords : Integer;
119     FUsedECCCodewords : Integer;
120     FTotalCodewords : Integer;
121    
122     { protected }
123     FBitmap : TBitmap;
124    
125     function CalculateBarCodeWidth (PaintableWidth : Integer) : Integer;
126     virtual; abstract;
127     function CalculateBarCodeHeight (PaintableHeight : Integer) : Integer;
128     virtual; abstract;
129     procedure DrawBarcode; virtual; abstract;
130     procedure GenerateBarcodeBitmap (BCWidth : Integer;
131     BCHeight : Integer);
132     procedure GenerateCodewords; virtual; abstract;
133     function GetBarCodeHeight : Integer;
134     function GetBarCodeWidth : Integer;
135     procedure GetCurrentResolution (var ResX : Integer; var ResY : Integer);
136     function GetVersion : string;
137     procedure Paint; override;
138     procedure SetAlignment (const v : TAlignment);
139     procedure SetBackgroundColor (const v : TColor);
140     procedure SetBarHeight (const v : Integer); virtual;
141     procedure SetBarHeightToWidth (const v : Integer); virtual;
142     procedure SetBarWidth (const v : Integer); virtual;
143     procedure SetBitmap (const v : TBitmap);
144     procedure SetCaption (const v : string);
145     procedure SetCaptionLayout (const v : TTextLayout);
146     procedure SetCode (const v : string);
147     procedure SetECCLevel (const v : Integer);
148     procedure SetExtendedSyntax (const v : Boolean);
149     procedure SetRelativeBarHeight (const v : Boolean); virtual;
150     procedure SetQuietZone (const v : Integer);
151     procedure SetVersion(const Value : string);
152    
153     public
154     constructor Create (AOwner : TComponent); override;
155     destructor Destroy; override;
156    
157     procedure CopyToClipboard;
158     procedure CopyToClipboardRes (ResX : Integer; ResY : Integer);
159     procedure PaintToCanvas (ACanvas : TCanvas; Position : TPoint);
160     procedure PaintToCanvasRes (ACanvas : TCanvas; Position : TPoint;
161     ResX : Integer; ResY : Integer);
162     procedure PaintToCanvasSize (ACanvas : TCanvas; X, Y, H : Double);
163     procedure PaintToDC (DC : hDC; Position : TPoint);
164     procedure PaintToDCRes (DC : hDC; Position : TPoint;
165     ResX : Integer; ResY : Integer);
166     procedure PaintToPrinterCanvas (ACanvas : TCanvas; Position : TPoint);
167     procedure PaintToPrinterCanvasRes (ACanvas : TCanvas; Position : TPoint;
168     ResX : Integer; ResY : Integer);
169     procedure PaintToPrinterCanvasSize (ACanvas : TCanvas; X, Y, H : Double);
170     procedure PaintToPrinterDC (DC : hDC; Position : TPoint);
171     procedure PaintToPrinterDCRes (DC : hDC; Position : TPoint;
172     ResX : Integer; ResY : Integer);
173     procedure RenderToResolution (var OutBitmap : TBitmap;
174     ResX : Integer;
175     ResY : Integer;
176     var SizeX : Integer;
177     var SizeY : Integer); virtual; abstract;
178     procedure SaveToFile (const FileName : string);
179     procedure SaveToFileRes (const FileName : string;
180     ResX : Integer; ResY : Integer);
181    
182     property Alignment : TAlignment read FAlignment write SetAlignment
183     default taCenter;
184     property BackgroundColor : TColor
185     read FBackgroundColor write SetBackgroundColor default clWhite;
186     property BarCodeHeight : Integer read GetBarCodeHeight;
187     property BarCodeRect : TRect read FBarCodeRect;
188     property BarCodeWidth : Integer read GetBarCodeWidth;
189     property BarHeight : Integer read FBarHeight write SetBarHeight
190     default 2;
191     property BarHeightToWidth : Integer
192     read FBarHeightToWidth write SetBarHeightToWidth default 4;
193     property BarWidth : Integer read FBarWidth write SetBarWidth default 2;
194     property Bitmap : TBitmap read FBitmap write SetBitmap stored False;
195     property Caption : string read FCaption write SetCaption;
196     property CaptionLayout : TTextLayout
197     read FCaptionLayout write SetCaptionLayout
198     default tlBottom;
199     property Code : string read FCode write SetCode;
200     property ECCLevel : Integer read FECCLevel write SetECCLevel default 0;
201     property ExtendedSyntax : Boolean
202     read FExtendedSyntax write SetExtendedSyntax default True;
203     property FreeCodewords : Integer read FFreeCodewords;
204     property RelativeBarHeight : Boolean
205     read FRelativeBarHeight write SetRelativeBarHeight
206     default False;
207     property QuietZone : Integer read FQuietZone write SetQuietZone
208     default 8;
209     property TotalCodewords : Integer read FTotalCodewords;
210     property UsedCodewords : Integer read FUsedCodewords;
211     property UsedECCCodewords : Integer read FUsedECCCodewords;
212    
213     property Color default clBlack;
214    
215     published
216     property Version : string read GetVersion write SetVersion stored False;
217    
218     { Properties }
219     property Align;
220     property Cursor;
221     property Enabled;
222     property Font;
223     property ParentColor;
224     property ParentFont;
225     property ParentShowHint;
226     property ShowHint;
227     property Visible;
228    
229     { Events }
230     property OnClick;
231     property OnDblClick;
232     property OnMouseDown;
233     property OnMouseMove;
234     property OnMouseUp;
235     end;
236    
237     { TStPDF417Barcode }
238    
239     TStPDF417Barcode = class (TStCustom2DBarcode)
240     private
241     FTruncated : Boolean;
242     FCodewords : TStPDF417CodewordList;
243     FNumCodewords : Integer;
244     FNewTextCodeword : Boolean;
245     FHighlight : Boolean;
246     FNumRows : Integer;
247     FNumColumns : Integer;
248    
249     protected
250     procedure AddCodeword (Value : Word);
251     function CalculateBarCodeWidth (PaintableWidth : Integer) : Integer;
252     override;
253     function CalculateBarCodeHeight (PaintableHeight : Integer) : Integer;
254     override;
255     procedure CalculateECC (NumCodewords : Integer; ECCLen : Integer);
256     procedure CalculateSize (var XSize : Integer;
257     var YSize : Integer);
258     function CodewordToBitmask (RowNumber : Integer;
259     Codeword : Integer) : DWord;
260     procedure ConvertBytesToBase900 (const S : array of byte;
261     var A : array of integer);
262     procedure ConvertToBase900 (const S : string;
263     var A : array of integer;
264     var LenA : integer);
265     procedure DrawBarcode; override;
266     procedure DrawCodeword (RowNumber : Integer;
267     ColNumber : Integer;
268     WorkBarHeight : Integer;
269     Pattern : string);
270     procedure DrawCodewordBitmask (RowNumber : Integer;
271     ColNumber : Integer;
272     WorkBarHeight : Integer;
273     Bitmask : DWord);
274     procedure DrawLeftRowIndicator (RowNumber : Integer;
275     WorkBarHeight : Integer;
276     NumRows : Integer;
277     NumCols : Integer);
278     procedure DrawRightRowIndicator (RowNumber : Integer;
279     ColNumber : Integer;
280     WorkBarHeight : Integer;
281     NumRows : Integer;
282     NumCols : Integer);
283     procedure DrawStartPattern (RowNumber : Integer;
284     WorkBarHeight : Integer);
285     procedure DrawStopPattern (RowNumber : Integer;
286     ColNumber : Integer;
287     WorkBarHeight : Integer);
288     procedure EncodeBinary (var Position : Integer; CodeLen : Integer);
289     procedure EncodeNumeric (var Position : Integer; CodeLen : Integer);
290     procedure EncodeText (var Position : Integer; CodeLen : Integer);
291     procedure GenerateCodewords; override;
292     procedure GetNextCharacter (var NewChar : Integer;
293     var Codeword : Boolean;
294     var Position : Integer;
295     CodeLen : Integer);
296     function GetPDF417ECCLevel : TStPDF417ECCLevels;
297     function GetRealErrorLevel : Integer;
298     function GoodForNumericCompaction (Position : Integer;
299     CodeLen : Integer;
300     var Count : Integer) : Boolean;
301     function GoodForTextCompaction (Position : Integer;
302     CodeLen : Integer;
303     var Count : Integer) : Boolean;
304     function IsNumericString (const S : string) : boolean;
305     procedure SetBarHeight (const v : Integer); override;
306     procedure SetBarHeightToWidth (const v : Integer); override;
307     procedure SetBarWidth (const v : Integer); override;
308     procedure SetNumColumns (const v : Integer);
309     procedure SetNumRows (const v : Integer);
310     procedure SetPDF417ECCLevel (const v : TStPDF417ECCLevels);
311     procedure SetRelativeBarHeight (const v : Boolean); override;
312     procedure SetTruncated (const v : Boolean);
313     procedure TextToCodewords;
314    
315     public
316     constructor Create (AOwner : TComponent); override;
317    
318     procedure RenderToResolution (var OutBitmap : TBitmap;
319     ResX : Integer;
320     ResY : Integer;
321     var SizeX : Integer;
322     var SizeY : Integer); override;
323    
324     published
325     property ECCLevel : TStPDF417ECCLevels
326     read GetPDF417ECCLevel write SetPDF417ECCLevel default ecAuto;
327     property NumColumns : Integer read FNumColumns write SetNumColumns
328     default 0;
329     property NumRows : Integer read FNumRows write SetNumRows
330     default 0;
331     property Truncated : Boolean read FTruncated write SetTruncated
332     default False;
333    
334     property Alignment;
335     property BackgroundColor;
336     property BarCodeHeight;
337     property BarCodeWidth;
338     property BarHeight;
339     property BarHeightToWidth;
340     property BarWidth;
341     property Bitmap;
342     property CaptionLayout;
343     property Code;
344     property ExtendedSyntax;
345     property Height default 81;
346     property RelativeBarHeight;
347     property QuietZone;
348     property Width default 273;
349    
350     property Caption;
351     property Color;
352     property Font;
353     end;
354    
355     { TStMaxiCodeBarcode }
356    
357     TStMaxiCodeBarcode = class (TStCustom2DBarcode)
358     private
359     FMode : TStMaxiCodeMode;
360     FCodewords : TStMaxiCodeECCData;
361     FNumCodewords : Integer;
362     FHighlight : Boolean;
363     FShowCodewords : Boolean;
364     FShowAll : Boolean;
365     FMessage : TStMaxiCodeECCData;
366     FCarrierCountryCode : Integer;
367     FCarrierPostalCode : string;
368     FCarrierServiceClass : Integer;
369     FAutoScale : Boolean;
370     FHorPixelsPerMM : Extended;
371     FVerPixelsPerMM : Extended;
372     FMaxiHexWidth : Extended;
373     FMaxiHexHeight : Extended;
374     FMaxiHexVOffset : Extended;
375     FMaxiHexHOffset : Extended;
376    
377     { Log and AnitLog data for Galois field arithmetic }
378     FLog : array [0..StMaxiCodeGaloisField] of Integer;
379     FAntiLog : array [0..StMaxiCodeGaloisField] of Integer;
380    
381     protected
382     procedure AddCodeword (Value : Integer);
383     function CalculateBarCodeWidth (PaintableWidth : Integer) : Integer;
384     override;
385     function CalculateBarCodeHeight (PaintableHeight : Integer) : Integer;
386     override;
387     procedure DrawBarcode; override;
388     procedure DrawFinder;
389     procedure DrawHex (XPos, YPos : Integer);
390     procedure GenerateCodewords; override;
391     procedure GenerateECC;
392     procedure GetNextCharacter (var NewChar : Integer;
393     var Codeword : Boolean;
394     var Position : Integer;
395     CodeLen : Integer);
396     procedure GetSizes;
397     procedure GetSizesEx (ResX : Integer; ResY : Integer);
398     procedure PlotCell (Row : Integer; Col : Integer);
399     procedure SetAutoScale (const v : Boolean);
400     procedure SetBarHeight (const v : Integer); override;
401     procedure SetBarWidth (const v : Integer); override;
402     procedure SetCarrierCountryCode (const v : Integer);
403     procedure SetCarrierPostalCode (const v : string);
404     procedure SetCarrierServiceClass (const v : Integer);
405     procedure SetMode (const v : TStMaxiCodeMode);
406     procedure SetHorPixelsPerMM (const v : Extended);
407     procedure SetVerPixelsPerMM (const v : Extended);
408     procedure TextToCodewords;
409    
410     public
411     constructor Create (AOwner : TComponent); override;
412    
413     procedure RenderToResolution (var OutBitmap : TBitmap;
414     ResX : Integer;
415     ResY : Integer;
416     var SizeX : Integer;
417     var SizeY : Integer); override;
418    
419     published
420     property AutoScale : Boolean
421     read FAutoScale write SetAutoScale default True;
422     property CarrierCountryCode : Integer
423     read FCarrierCountryCode write SetCarrierCountryCode default 0;
424     property CarrierPostalCode : string
425     read FCarrierPostalCode write SetCarrierPostalCode;
426     property CarrierServiceClass : Integer
427     read FCarrierServiceClass write SetCarrierServiceClass
428     default 0;
429     property HorPixelsPerMM : Extended
430     read FHorPixelsPerMM write SetHorPixelsPerMM;
431    
432     property Mode : TStMaxiCodeMode
433     read FMode write SetMode default cmMode4;
434     property VerPixelsPerMM : Extended
435     read FVerPixelsPerMM write SetVerPixelsPerMM;
436    
437     property Alignment;
438     property BackgroundColor;
439     property BarCodeHeight;
440     property BarCodeWidth;
441     property BarHeight default 0;
442     property BarWidth default 0;
443     property Bitmap;
444     property CaptionLayout;
445     property Code;
446     property ExtendedSyntax;
447     property Height default 129;
448     property QuietZone;
449     property Width default 121;
450    
451     property Caption;
452     property Color;
453     property Font;
454     end;
455    
456    
457     implementation
458     { PDF417 types and constants }
459    
460     type
461     TStPDF417CodewordArray = array [0..2] of array [0..928] of Longint;
462    
463     const
464    
465     StPDF417CellWidth = 17;
466    
467     StPDF417Codewords : TstPDF417CodewordArray =
468     (($1d5c0, $1eaf0, $1f57c, $1d4e0, $1ea78, $1f53e, $1a8c0, $1d470, $1a860,
469     $15040, $1a830, $15020, $1adc0, $1d6f0, $1eb7c, $1ace0, $1d678, $1eb3e,
470     $158c0, $1ac70, $15860, $15dc0, $1aef0, $1d77c, $15ce0, $1ae78, $1d73e,
471     $15c70, $1ae3c, $15ef0, $1af7c, $15e78, $1af3e, $15f7c, $1f5fa, $1d2e0,
472     $1e978, $1f4be, $1a4c0, $1d270, $1e93c, $1a460, $1d238, $14840, $1a430,
473     $1d21c, $14820, $1a418, $14810, $1a6e0, $1d378, $1e9be, $14cc0, $1a670,
474     $1d33c, $14c60, $1a638, $1d31e, $14c30, $1a61c, $14ee0, $1a778, $1d3be,
475     $14e70, $1a73c, $14e38, $1a71e, $14f78, $1a7be, $14f3c, $14f1e, $1a2c0,
476     $1d170, $1e8bc, $1a260, $1d138, $1e89e, $14440, $1a230, $1d11c, $14420,
477     $1a218, $14410, $14408, $146c0, $1a370, $1d1bc, $14660, $1a338, $1d19e,
478     $14630, $1a31c, $14618, $1460c, $14770, $1a3bc, $14738, $1a39e, $1471c,
479     $147bc, $1a160, $1d0b8, $1e85e, $14240, $1a130, $1d09c, $14220, $1a118,
480     $1d08e, $14210, $1a10c, $14208, $1a106, $14360, $1a1b8, $1d0de, $14330,
481     $1a19c, $14318, $1a18e, $1430c, $14306, $1a1de, $1438e, $14140, $1a0b0,
482     $1d05c, $14120, $1a098, $1d04e, $14110, $1a08c, $14108, $1a086, $14104,
483     $141b0, $14198, $1418c, $140a0, $1d02e, $1a04c, $1a046, $14082, $1cae0,
484     $1e578, $1f2be, $194c0, $1ca70, $1e53c, $19460, $1ca38, $1e51e, $12840,
485     $19430, $12820, $196e0, $1cb78, $1e5be, $12cc0, $19670, $1cb3c, $12c60,
486     $19638, $12c30, $12c18, $12ee0, $19778, $1cbbe, $12e70, $1973c, $12e38,
487     $12e1c, $12f78, $197be, $12f3c, $12fbe, $1dac0, $1ed70, $1f6bc, $1da60,
488     $1ed38, $1f69e, $1b440, $1da30, $1ed1c, $1b420, $1da18, $1ed0e, $1b410,
489     $1da0c, $192c0, $1c970, $1e4bc, $1b6c0, $19260, $1c938, $1e49e, $1b660,
490     $1db38, $1ed9e, $16c40, $12420, $19218, $1c90e, $16c20, $1b618, $16c10,
491     $126c0, $19370, $1c9bc, $16ec0, $12660, $19338, $1c99e, $16e60, $1b738,
492     $1db9e, $16e30, $12618, $16e18, $12770, $193bc, $16f70, $12738, $1939e,
493     $16f38, $1b79e, $16f1c, $127bc, $16fbc, $1279e, $16f9e, $1d960, $1ecb8,
494     $1f65e, $1b240, $1d930, $1ec9c, $1b220, $1d918, $1ec8e, $1b210, $1d90c,
495     $1b208, $1b204, $19160, $1c8b8, $1e45e, $1b360, $19130, $1c89c, $16640,
496     $12220, $1d99c, $1c88e, $16620, $12210, $1910c, $16610, $1b30c, $19106,
497     $12204, $12360, $191b8, $1c8de, $16760, $12330, $1919c, $16730, $1b39c,
498     $1918e, $16718, $1230c, $12306, $123b8, $191de, $167b8, $1239c, $1679c,
499     $1238e, $1678e, $167de, $1b140, $1d8b0, $1ec5c, $1b120, $1d898, $1ec4e,
500     $1b110, $1d88c, $1b108, $1d886, $1b104, $1b102, $12140, $190b0, $1c85c,
501     $16340, $12120, $19098, $1c84e, $16320, $1b198, $1d8ce, $16310, $12108,
502     $19086, $16308, $1b186, $16304, $121b0, $190dc, $163b0, $12198, $190ce,
503     $16398, $1b1ce, $1638c, $12186, $16386, $163dc, $163ce, $1b0a0, $1d858,
504     $1ec2e, $1b090, $1d84c, $1b088, $1d846, $1b084, $1b082, $120a0, $19058,
505     $1c82e, $161a0, $12090, $1904c, $16190, $1b0cc, $19046, $16188, $12084,
506     $16184, $12082, $120d8, $161d8, $161cc, $161c6, $1d82c, $1d826, $1b042,
507     $1902c, $12048, $160c8, $160c4, $160c2, $18ac0, $1c570, $1e2bc, $18a60,
508     $1c538, $11440, $18a30, $1c51c, $11420, $18a18, $11410, $11408, $116c0,
509     $18b70, $1c5bc, $11660, $18b38, $1c59e, $11630, $18b1c, $11618, $1160c,
510     $11770, $18bbc, $11738, $18b9e, $1171c, $117bc, $1179e, $1cd60, $1e6b8,
511     $1f35e, $19a40, $1cd30, $1e69c, $19a20, $1cd18, $1e68e, $19a10, $1cd0c,
512     $19a08, $1cd06, $18960, $1c4b8, $1e25e, $19b60, $18930, $1c49c, $13640,
513     $11220, $1cd9c, $1c48e, $13620, $19b18, $1890c, $13610, $11208, $13608,
514     $11360, $189b8, $1c4de, $13760, $11330, $1cdde, $13730, $19b9c, $1898e,
515     $13718, $1130c, $1370c, $113b8, $189de, $137b8, $1139c, $1379c, $1138e,
516     $113de, $137de, $1dd40, $1eeb0, $1f75c, $1dd20, $1ee98, $1f74e, $1dd10,
517     $1ee8c, $1dd08, $1ee86, $1dd04, $19940, $1ccb0, $1e65c, $1bb40, $19920,
518     $1eedc, $1e64e, $1bb20, $1dd98, $1eece, $1bb10, $19908, $1cc86, $1bb08,
519     $1dd86, $19902, $11140, $188b0, $1c45c, $13340, $11120, $18898, $1c44e,
520     $17740, $13320, $19998, $1ccce, $17720, $1bb98, $1ddce, $18886, $17710,
521     $13308, $19986, $17708, $11102, $111b0, $188dc, $133b0, $11198, $188ce,
522     $177b0, $13398, $199ce, $17798, $1bbce, $11186, $13386, $111dc, $133dc,
523     $111ce, $177dc, $133ce, $1dca0, $1ee58, $1f72e, $1dc90, $1ee4c, $1dc88,
524     $1ee46, $1dc84, $1dc82, $198a0, $1cc58, $1e62e, $1b9a0, $19890, $1ee6e,
525     $1b990, $1dccc, $1cc46, $1b988, $19884, $1b984, $19882, $1b982, $110a0,
526     $18858, $1c42e, $131a0, $11090, $1884c, $173a0, $13190, $198cc, $18846,
527     $17390, $1b9cc, $11084, $17388, $13184, $11082, $13182, $110d8, $1886e,
528     $131d8, $110cc, $173d8, $131cc, $110c6, $173cc, $131c6, $110ee, $173ee,
529     $1dc50, $1ee2c, $1dc48, $1ee26, $1dc44, $1dc42, $19850, $1cc2c, $1b8d0,
530     $19848, $1cc26, $1b8c8, $1dc66, $1b8c4, $19842, $1b8c2, $11050, $1882c,
531     $130d0, $11048, $18826, $171d0, $130c8, $19866, $171c8, $1b8e6, $11042,
532     $171c4, $130c2, $171c2, $130ec, $171ec, $171e6, $1ee16, $1dc22, $1cc16,
533     $19824, $19822, $11028, $13068, $170e8, $11022, $13062, $18560, $10a40,
534     $18530, $10a20, $18518, $1c28e, $10a10, $1850c, $10a08, $18506, $10b60,
535     $185b8, $1c2de, $10b30, $1859c, $10b18, $1858e, $10b0c, $10b06, $10bb8,
536     $185de, $10b9c, $10b8e, $10bde, $18d40, $1c6b0, $1e35c, $18d20, $1c698,
537     $18d10, $1c68c, $18d08, $1c686, $18d04, $10940, $184b0, $1c25c, $11b40,
538     $10920, $1c6dc, $1c24e, $11b20, $18d98, $1c6ce, $11b10, $10908, $18486,
539     $11b08, $18d86, $10902, $109b0, $184dc, $11bb0, $10998, $184ce, $11b98,
540     $18dce, $11b8c, $10986, $109dc, $11bdc, $109ce, $11bce, $1cea0, $1e758,
541     $1f3ae, $1ce90, $1e74c, $1ce88, $1e746, $1ce84, $1ce82, $18ca0, $1c658,
542     $19da0, $18c90, $1c64c, $19d90, $1cecc, $1c646, $19d88, $18c84, $19d84,
543     $18c82, $19d82, $108a0, $18458, $119a0, $10890, $1c66e, $13ba0, $11990,
544     $18ccc, $18446, $13b90, $19dcc, $10884, $13b88, $11984, $10882, $11982,
545     $108d8, $1846e, $119d8, $108cc, $13bd8, $119cc, $108c6, $13bcc, $119c6,
546     $108ee, $119ee, $13bee, $1ef50, $1f7ac, $1ef48, $1f7a6, $1ef44, $1ef42,
547     $1ce50, $1e72c, $1ded0, $1ef6c, $1e726, $1dec8, $1ef66, $1dec4, $1ce42,
548     $1dec2, $18c50, $1c62c, $19cd0, $18c48, $1c626, $1bdd0, $19cc8, $1ce66,
549     $1bdc8, $1dee6, $18c42, $1bdc4, $19cc2, $1bdc2, $10850, $1842c, $118d0,
550     $10848, $18426, $139d0, $118c8, $18c66, $17bd0, $139c8, $19ce6, $10842,
551     $17bc8, $1bde6, $118c2, $17bc4, $1086c, $118ec, $10866, $139ec, $118e6,
552     $17bec, $139e6, $17be6, $1ef28, $1f796, $1ef24, $1ef22, $1ce28, $1e716,
553     $1de68, $1ef36, $1de64, $1ce22, $1de62, $18c28, $1c616, $19c68, $18c24,
554     $1bce8, $19c64, $18c22, $1bce4, $19c62, $1bce2, $10828, $18416, $11868,
555     $18c36, $138e8, $11864, $10822, $179e8, $138e4, $11862, $179e4, $138e2,
556     $179e2, $11876, $179f6, $1ef12, $1de34, $1de32, $19c34, $1bc74, $1bc72,
557     $11834, $13874, $178f4, $178f2, $10540, $10520, $18298, $10510, $10508,
558     $10504, $105b0, $10598, $1058c, $10586, $105dc, $105ce, $186a0, $18690,
559     $1c34c, $18688, $1c346, $18684, $18682, $104a0, $18258, $10da0, $186d8,
560     $1824c, $10d90, $186cc, $10d88, $186c6, $10d84, $10482, $10d82, $104d8,
561     $1826e, $10dd8, $186ee, $10dcc, $104c6, $10dc6, $104ee, $10dee, $1c750,
562     $1c748, $1c744, $1c742, $18650, $18ed0, $1c76c, $1c326, $18ec8, $1c766,
563     $18ec4, $18642, $18ec2, $10450, $10cd0, $10448, $18226, $11dd0, $10cc8,
564     $10444, $11dc8, $10cc4, $10442, $11dc4, $10cc2, $1046c, $10cec, $10466,
565     $11dec, $10ce6, $11de6, $1e7a8, $1e7a4, $1e7a2, $1c728, $1cf68, $1e7b6,
566     $1cf64, $1c722, $1cf62, $18628, $1c316, $18e68, $1c736, $19ee8, $18e64,
567     $18622, $19ee4, $18e62, $19ee2, $10428, $18216, $10c68, $18636, $11ce8,
568     $10c64, $10422, $13de8, $11ce4, $10c62, $13de4, $11ce2, $10436, $10c76,
569     $11cf6, $13df6, $1f7d4, $1f7d2, $1e794, $1efb4, $1e792, $1efb2, $1c714,
570     $1cf34, $1c712, $1df74, $1cf32, $1df72, $18614, $18e34, $18612, $19e74,
571     $18e32, $1bef4),
572     ($1f560, $1fab8, $1ea40, $1f530, $1fa9c, $1ea20, $1f518, $1fa8e, $1ea10,
573     $1f50c, $1ea08, $1f506, $1ea04, $1eb60, $1f5b8, $1fade, $1d640, $1eb30,
574     $1f59c, $1d620, $1eb18, $1f58e, $1d610, $1eb0c, $1d608, $1eb06, $1d604,
575     $1d760, $1ebb8, $1f5de, $1ae40, $1d730, $1eb9c, $1ae20, $1d718, $1eb8e,
576     $1ae10, $1d70c, $1ae08, $1d706, $1ae04, $1af60, $1d7b8, $1ebde, $15e40,
577     $1af30, $1d79c, $15e20, $1af18, $1d78e, $15e10, $1af0c, $15e08, $1af06,
578     $15f60, $1afb8, $1d7de, $15f30, $1af9c, $15f18, $1af8e, $15f0c, $15fb8,
579     $1afde, $15f9c, $15f8e, $1e940, $1f4b0, $1fa5c, $1e920, $1f498, $1fa4e,
580     $1e910, $1f48c, $1e908, $1f486, $1e904, $1e902, $1d340, $1e9b0, $1f4dc,
581     $1d320, $1e998, $1f4ce, $1d310, $1e98c, $1d308, $1e986, $1d304, $1d302,
582     $1a740, $1d3b0, $1e9dc, $1a720, $1d398, $1e9ce, $1a710, $1d38c, $1a708,
583     $1d386, $1a704, $1a702, $14f40, $1a7b0, $1d3dc, $14f20, $1a798, $1d3ce,
584     $14f10, $1a78c, $14f08, $1a786, $14f04, $14fb0, $1a7dc, $14f98, $1a7ce,
585     $14f8c, $14f86, $14fdc, $14fce, $1e8a0, $1f458, $1fa2e, $1e890, $1f44c,
586     $1e888, $1f446, $1e884, $1e882, $1d1a0, $1e8d8, $1f46e, $1d190, $1e8cc,
587     $1d188, $1e8c6, $1d184, $1d182, $1a3a0, $1d1d8, $1e8ee, $1a390, $1d1cc,
588     $1a388, $1d1c6, $1a384, $1a382, $147a0, $1a3d8, $1d1ee, $14790, $1a3cc,
589     $14788, $1a3c6, $14784, $14782, $147d8, $1a3ee, $147cc, $147c6, $147ee,
590     $1e850, $1f42c, $1e848, $1f426, $1e844, $1e842, $1d0d0, $1e86c, $1d0c8,
591     $1e866, $1d0c4, $1d0c2, $1a1d0, $1d0ec, $1a1c8, $1d0e6, $1a1c4, $1a1c2,
592     $143d0, $1a1ec, $143c8, $1a1e6, $143c4, $143c2, $143ec, $143e6, $1e828,
593     $1f416, $1e824, $1e822, $1d068, $1e836, $1d064, $1d062, $1a0e8, $1d076,
594     $1a0e4, $1a0e2, $141e8, $1a0f6, $141e4, $141e2, $1e814, $1e812, $1d034,
595     $1d032, $1a074, $1a072, $1e540, $1f2b0, $1f95c, $1e520, $1f298, $1f94e,
596     $1e510, $1f28c, $1e508, $1f286, $1e504, $1e502, $1cb40, $1e5b0, $1f2dc,
597     $1cb20, $1e598, $1f2ce, $1cb10, $1e58c, $1cb08, $1e586, $1cb04, $1cb02,
598     $19740, $1cbb0, $1e5dc, $19720, $1cb98, $1e5ce, $19710, $1cb8c, $19708,
599     $1cb86, $19704, $19702, $12f40, $197b0, $1cbdc, $12f20, $19798, $1cbce,
600     $12f10, $1978c, $12f08, $19786, $12f04, $12fb0, $197dc, $12f98, $197ce,
601     $12f8c, $12f86, $12fdc, $12fce, $1f6a0, $1fb58, $16bf0, $1f690, $1fb4c,
602     $169f8, $1f688, $1fb46, $168fc, $1f684, $1f682, $1e4a0, $1f258, $1f92e,
603     $1eda0, $1e490, $1fb6e, $1ed90, $1f6cc, $1f246, $1ed88, $1e484, $1ed84,
604     $1e482, $1ed82, $1c9a0, $1e4d8, $1f26e, $1dba0, $1c990, $1e4cc, $1db90,
605     $1edcc, $1e4c6, $1db88, $1c984, $1db84, $1c982, $1db82, $193a0, $1c9d8,
606     $1e4ee, $1b7a0, $19390, $1c9cc, $1b790, $1dbcc, $1c9c6, $1b788, $19384,
607     $1b784, $19382, $1b782, $127a0, $193d8, $1c9ee, $16fa0, $12790, $193cc,
608     $16f90, $1b7cc, $193c6, $16f88, $12784, $16f84, $12782, $127d8, $193ee,
609     $16fd8, $127cc, $16fcc, $127c6, $16fc6, $127ee, $1f650, $1fb2c, $165f8,
610     $1f648, $1fb26, $164fc, $1f644, $1647e, $1f642, $1e450, $1f22c, $1ecd0,
611     $1e448, $1f226, $1ecc8, $1f666, $1ecc4, $1e442, $1ecc2, $1c8d0, $1e46c,
612     $1d9d0, $1c8c8, $1e466, $1d9c8, $1ece6, $1d9c4, $1c8c2, $1d9c2, $191d0,
613     $1c8ec, $1b3d0, $191c8, $1c8e6, $1b3c8, $1d9e6, $1b3c4, $191c2, $1b3c2,
614     $123d0, $191ec, $167d0, $123c8, $191e6, $167c8, $1b3e6, $167c4, $123c2,
615     $167c2, $123ec, $167ec, $123e6, $167e6, $1f628, $1fb16, $162fc, $1f624,
616     $1627e, $1f622, $1e428, $1f216, $1ec68, $1f636, $1ec64, $1e422, $1ec62,
617     $1c868, $1e436, $1d8e8, $1c864, $1d8e4, $1c862, $1d8e2, $190e8, $1c876,
618     $1b1e8, $1d8f6, $1b1e4, $190e2, $1b1e2, $121e8, $190f6, $163e8, $121e4,
619     $163e4, $121e2, $163e2, $121f6, $163f6, $1f614, $1617e, $1f612, $1e414,
620     $1ec34, $1e412, $1ec32, $1c834, $1d874, $1c832, $1d872, $19074, $1b0f4,
621     $19072, $1b0f2, $120f4, $161f4, $120f2, $161f2, $1f60a, $1e40a, $1ec1a,
622     $1c81a, $1d83a, $1903a, $1b07a, $1e2a0, $1f158, $1f8ae, $1e290, $1f14c,
623     $1e288, $1f146, $1e284, $1e282, $1c5a0, $1e2d8, $1f16e, $1c590, $1e2cc,
624     $1c588, $1e2c6, $1c584, $1c582, $18ba0, $1c5d8, $1e2ee, $18b90, $1c5cc,
625     $18b88, $1c5c6, $18b84, $18b82, $117a0, $18bd8, $1c5ee, $11790, $18bcc,
626     $11788, $18bc6, $11784, $11782, $117d8, $18bee, $117cc, $117c6, $117ee,
627     $1f350, $1f9ac, $135f8, $1f348, $1f9a6, $134fc, $1f344, $1347e, $1f342,
628     $1e250, $1f12c, $1e6d0, $1e248, $1f126, $1e6c8, $1f366, $1e6c4, $1e242,
629     $1e6c2, $1c4d0, $1e26c, $1cdd0, $1c4c8, $1e266, $1cdc8, $1e6e6, $1cdc4,
630     $1c4c2, $1cdc2, $189d0, $1c4ec, $19bd0, $189c8, $1c4e6, $19bc8, $1cde6,
631     $19bc4, $189c2, $19bc2, $113d0, $189ec, $137d0, $113c8, $189e6, $137c8,
632     $19be6, $137c4, $113c2, $137c2, $113ec, $137ec, $113e6, $137e6, $1fba8,
633     $175f0, $1bafc, $1fba4, $174f8, $1ba7e, $1fba2, $1747c, $1743e, $1f328,
634     $1f996, $132fc, $1f768, $1fbb6, $176fc, $1327e, $1f764, $1f322, $1767e,
635     $1f762, $1e228, $1f116, $1e668, $1e224, $1eee8, $1f776, $1e222, $1eee4,
636     $1e662, $1eee2, $1c468, $1e236, $1cce8, $1c464, $1dde8, $1cce4, $1c462,
637     $1dde4, $1cce2, $1dde2, $188e8, $1c476, $199e8, $188e4, $1bbe8, $199e4,
638     $188e2, $1bbe4, $199e2, $1bbe2, $111e8, $188f6, $133e8, $111e4, $177e8,
639     $133e4, $111e2, $177e4, $133e2, $177e2, $111f6, $133f6, $1fb94, $172f8,
640     $1b97e, $1fb92, $1727c, $1723e, $1f314, $1317e, $1f734, $1f312, $1737e,
641     $1f732, $1e214, $1e634, $1e212, $1ee74, $1e632, $1ee72, $1c434, $1cc74,
642     $1c432, $1dcf4, $1cc72, $1dcf2, $18874, $198f4, $18872, $1b9f4, $198f2,
643     $1b9f2, $110f4, $131f4, $110f2, $173f4, $131f2, $173f2, $1fb8a, $1717c,
644     $1713e, $1f30a, $1f71a, $1e20a, $1e61a, $1ee3a, $1c41a, $1cc3a, $1dc7a,
645     $1883a, $1987a, $1b8fa, $1107a, $130fa, $171fa, $170be, $1e150, $1f0ac,
646     $1e148, $1f0a6, $1e144, $1e142, $1c2d0, $1e16c, $1c2c8, $1e166, $1c2c4,
647     $1c2c2, $185d0, $1c2ec, $185c8, $1c2e6, $185c4, $185c2, $10bd0, $185ec,
648     $10bc8, $185e6, $10bc4, $10bc2, $10bec, $10be6, $1f1a8, $1f8d6, $11afc,
649     $1f1a4, $11a7e, $1f1a2, $1e128, $1f096, $1e368, $1e124, $1e364, $1e122,
650     $1e362, $1c268, $1e136, $1c6e8, $1c264, $1c6e4, $1c262, $1c6e2, $184e8,
651     $1c276, $18de8, $184e4, $18de4, $184e2, $18de2, $109e8, $184f6, $11be8,
652     $109e4, $11be4, $109e2, $11be2, $109f6, $11bf6, $1f9d4, $13af8, $19d7e,
653     $1f9d2, $13a7c, $13a3e, $1f194, $1197e, $1f3b4, $1f192, $13b7e, $1f3b2,
654     $1e114, $1e334, $1e112, $1e774, $1e332, $1e772, $1c234, $1c674, $1c232,
655     $1cef4, $1c672, $1cef2, $18474, $18cf4, $18472, $19df4, $18cf2, $19df2,
656     $108f4, $119f4, $108f2, $13bf4, $119f2, $13bf2, $17af0, $1bd7c, $17a78,
657     $1bd3e, $17a3c, $17a1e, $1f9ca, $1397c, $1fbda, $17b7c, $1393e, $17b3e,
658     $1f18a, $1f39a, $1f7ba, $1e10a, $1e31a, $1e73a, $1ef7a, $1c21a, $1c63a,
659     $1ce7a, $1defa, $1843a, $18c7a, $19cfa, $1bdfa, $1087a, $118fa, $139fa,
660     $17978, $1bcbe, $1793c, $1791e, $138be, $179be, $178bc, $1789e, $1785e,
661     $1e0a8, $1e0a4, $1e0a2, $1c168, $1e0b6, $1c164, $1c162, $182e8, $1c176,
662     $182e4, $182e2, $105e8, $182f6, $105e4, $105e2, $105f6, $1f0d4, $10d7e,
663     $1f0d2, $1e094, $1e1b4, $1e092, $1e1b2, $1c134, $1c374, $1c132, $1c372,
664     $18274, $186f4, $18272, $186f2, $104f4, $10df4, $104f2, $10df2, $1f8ea,
665     $11d7c, $11d3e, $1f0ca, $1f1da, $1e08a, $1e19a, $1e3ba, $1c11a, $1c33a,
666     $1c77a, $1823a, $1867a, $18efa, $1047a, $10cfa, $11dfa, $13d78, $19ebe,
667     $13d3c, $13d1e, $11cbe, $13dbe, $17d70, $1bebc, $17d38, $1be9e, $17d1c,
668     $17d0e, $13cbc, $17dbc, $13c9e, $17d9e, $17cb8, $1be5e, $17c9c, $17c8e,
669     $13c5e, $17cde, $17c5c, $17c4e, $17c2e, $1c0b4, $1c0b2, $18174, $18172,
670     $102f4, $102f2, $1e0da, $1c09a, $1c1ba, $1813a, $1837a, $1027a, $106fa,
671     $10ebe, $11ebc, $11e9e, $13eb8, $19f5e, $13e9c, $13e8e, $11e5e, $13ede,
672     $17eb0, $1bf5c, $17e98, $1bf4e, $17e8c, $17e86, $13e5c, $17edc, $13e4e,
673     $17ece, $17e58, $1bf2e, $17e4c, $17e46, $13e2e, $17e6e, $17e2c, $17e26,
674     $10f5e, $11f5c, $11f4e, $13f58, $19fae, $13f4c, $13f46, $11f2e, $13f6e,
675     $13f2c, $13f26),
676     ($1abe0, $1d5f8, $153c0, $1a9f0, $1d4fc, $151e0, $1a8f8, $1d47e, $150f0,
677     $1a87c, $15078, $1fad0, $15be0, $1adf8, $1fac8, $159f0, $1acfc, $1fac4,
678     $158f8, $1ac7e, $1fac2, $1587c, $1f5d0, $1faec, $15df8, $1f5c8, $1fae6,
679     $15cfc, $1f5c4, $15c7e, $1f5c2, $1ebd0, $1f5ec, $1ebc8, $1f5e6, $1ebc4,
680     $1ebc2, $1d7d0, $1ebec, $1d7c8, $1ebe6, $1d7c4, $1d7c2, $1afd0, $1d7ec,
681     $1afc8, $1d7e6, $1afc4, $14bc0, $1a5f0, $1d2fc, $149e0, $1a4f8, $1d27e,
682     $148f0, $1a47c, $14878, $1a43e, $1483c, $1fa68, $14df0, $1a6fc, $1fa64,
683     $14cf8, $1a67e, $1fa62, $14c7c, $14c3e, $1f4e8, $1fa76, $14efc, $1f4e4,
684     $14e7e, $1f4e2, $1e9e8, $1f4f6, $1e9e4, $1e9e2, $1d3e8, $1e9f6, $1d3e4,
685     $1d3e2, $1a7e8, $1d3f6, $1a7e4, $1a7e2, $145e0, $1a2f8, $1d17e, $144f0,
686     $1a27c, $14478, $1a23e, $1443c, $1441e, $1fa34, $146f8, $1a37e, $1fa32,
687     $1467c, $1463e, $1f474, $1477e, $1f472, $1e8f4, $1e8f2, $1d1f4, $1d1f2,
688     $1a3f4, $1a3f2, $142f0, $1a17c, $14278, $1a13e, $1423c, $1421e, $1fa1a,
689     $1437c, $1433e, $1f43a, $1e87a, $1d0fa, $14178, $1a0be, $1413c, $1411e,
690     $141be, $140bc, $1409e, $12bc0, $195f0, $1cafc, $129e0, $194f8, $1ca7e,
691     $128f0, $1947c, $12878, $1943e, $1283c, $1f968, $12df0, $196fc, $1f964,
692     $12cf8, $1967e, $1f962, $12c7c, $12c3e, $1f2e8, $1f976, $12efc, $1f2e4,
693     $12e7e, $1f2e2, $1e5e8, $1f2f6, $1e5e4, $1e5e2, $1cbe8, $1e5f6, $1cbe4,
694     $1cbe2, $197e8, $1cbf6, $197e4, $197e2, $1b5e0, $1daf8, $1ed7e, $169c0,
695     $1b4f0, $1da7c, $168e0, $1b478, $1da3e, $16870, $1b43c, $16838, $1b41e,
696     $1681c, $125e0, $192f8, $1c97e, $16de0, $124f0, $1927c, $16cf0, $1b67c,
697     $1923e, $16c78, $1243c, $16c3c, $1241e, $16c1e, $1f934, $126f8, $1937e,
698     $1fb74, $1f932, $16ef8, $1267c, $1fb72, $16e7c, $1263e, $16e3e, $1f274,
699     $1277e, $1f6f4, $1f272, $16f7e, $1f6f2, $1e4f4, $1edf4, $1e4f2, $1edf2,
700     $1c9f4, $1dbf4, $1c9f2, $1dbf2, $193f4, $193f2, $165c0, $1b2f0, $1d97c,
701     $164e0, $1b278, $1d93e, $16470, $1b23c, $16438, $1b21e, $1641c, $1640e,
702     $122f0, $1917c, $166f0, $12278, $1913e, $16678, $1b33e, $1663c, $1221e,
703     $1661e, $1f91a, $1237c, $1fb3a, $1677c, $1233e, $1673e, $1f23a, $1f67a,
704     $1e47a, $1ecfa, $1c8fa, $1d9fa, $191fa, $162e0, $1b178, $1d8be, $16270,
705     $1b13c, $16238, $1b11e, $1621c, $1620e, $12178, $190be, $16378, $1213c,
706     $1633c, $1211e, $1631e, $121be, $163be, $16170, $1b0bc, $16138, $1b09e,
707     $1611c, $1610e, $120bc, $161bc, $1209e, $1619e, $160b8, $1b05e, $1609c,
708     $1608e, $1205e, $160de, $1605c, $1604e, $115e0, $18af8, $1c57e, $114f0,
709     $18a7c, $11478, $18a3e, $1143c, $1141e, $1f8b4, $116f8, $18b7e, $1f8b2,
710     $1167c, $1163e, $1f174, $1177e, $1f172, $1e2f4, $1e2f2, $1c5f4, $1c5f2,
711     $18bf4, $18bf2, $135c0, $19af0, $1cd7c, $134e0, $19a78, $1cd3e, $13470,
712     $19a3c, $13438, $19a1e, $1341c, $1340e, $112f0, $1897c, $136f0, $11278,
713     $1893e, $13678, $19b3e, $1363c, $1121e, $1361e, $1f89a, $1137c, $1f9ba,
714     $1377c, $1133e, $1373e, $1f13a, $1f37a, $1e27a, $1e6fa, $1c4fa, $1cdfa,
715     $189fa, $1bae0, $1dd78, $1eebe, $174c0, $1ba70, $1dd3c, $17460, $1ba38,
716     $1dd1e, $17430, $1ba1c, $17418, $1ba0e, $1740c, $132e0, $19978, $1ccbe,
717     $176e0, $13270, $1993c, $17670, $1bb3c, $1991e, $17638, $1321c, $1761c,
718     $1320e, $1760e, $11178, $188be, $13378, $1113c, $17778, $1333c, $1111e,
719     $1773c, $1331e, $1771e, $111be, $133be, $177be, $172c0, $1b970, $1dcbc,
720     $17260, $1b938, $1dc9e, $17230, $1b91c, $17218, $1b90e, $1720c, $17206,
721     $13170, $198bc, $17370, $13138, $1989e, $17338, $1b99e, $1731c, $1310e,
722     $1730e, $110bc, $131bc, $1109e, $173bc, $1319e, $1739e, $17160, $1b8b8,
723     $1dc5e, $17130, $1b89c, $17118, $1b88e, $1710c, $17106, $130b8, $1985e,
724     $171b8, $1309c, $1719c, $1308e, $1718e, $1105e, $130de, $171de, $170b0,
725     $1b85c, $17098, $1b84e, $1708c, $17086, $1305c, $170dc, $1304e, $170ce,
726     $17058, $1b82e, $1704c, $17046, $1302e, $1706e, $1702c, $17026, $10af0,
727     $1857c, $10a78, $1853e, $10a3c, $10a1e, $10b7c, $10b3e, $1f0ba, $1e17a,
728     $1c2fa, $185fa, $11ae0, $18d78, $1c6be, $11a70, $18d3c, $11a38, $18d1e,
729     $11a1c, $11a0e, $10978, $184be, $11b78, $1093c, $11b3c, $1091e, $11b1e,
730     $109be, $11bbe, $13ac0, $19d70, $1cebc, $13a60, $19d38, $1ce9e, $13a30,
731     $19d1c, $13a18, $19d0e, $13a0c, $13a06, $11970, $18cbc, $13b70, $11938,
732     $18c9e, $13b38, $1191c, $13b1c, $1190e, $13b0e, $108bc, $119bc, $1089e,
733     $13bbc, $1199e, $13b9e, $1bd60, $1deb8, $1ef5e, $17a40, $1bd30, $1de9c,
734     $17a20, $1bd18, $1de8e, $17a10, $1bd0c, $17a08, $1bd06, $17a04, $13960,
735     $19cb8, $1ce5e, $17b60, $13930, $19c9c, $17b30, $1bd9c, $19c8e, $17b18,
736     $1390c, $17b0c, $13906, $17b06, $118b8, $18c5e, $139b8, $1189c, $17bb8,
737     $1399c, $1188e, $17b9c, $1398e, $17b8e, $1085e, $118de, $139de, $17bde,
738     $17940, $1bcb0, $1de5c, $17920, $1bc98, $1de4e, $17910, $1bc8c, $17908,
739     $1bc86, $17904, $17902, $138b0, $19c5c, $179b0, $13898, $19c4e, $17998,
740     $1bcce, $1798c, $13886, $17986, $1185c, $138dc, $1184e, $179dc, $138ce,
741     $179ce, $178a0, $1bc58, $1de2e, $17890, $1bc4c, $17888, $1bc46, $17884,
742     $17882, $13858, $19c2e, $178d8, $1384c, $178cc, $13846, $178c6, $1182e,
743     $1386e, $178ee, $17850, $1bc2c, $17848, $1bc26, $17844, $17842, $1382c,
744     $1786c, $13826, $17866, $17828, $1bc16, $17824, $17822, $13816, $17836,
745     $10578, $182be, $1053c, $1051e, $105be, $10d70, $186bc, $10d38, $1869e,
746     $10d1c, $10d0e, $104bc, $10dbc, $1049e, $10d9e, $11d60, $18eb8, $1c75e,
747     $11d30, $18e9c, $11d18, $18e8e, $11d0c, $11d06, $10cb8, $1865e, $11db8,
748     $10c9c, $11d9c, $10c8e, $11d8e, $1045e, $10cde, $11dde, $13d40, $19eb0,
749     $1cf5c, $13d20, $19e98, $1cf4e, $13d10, $19e8c, $13d08, $19e86, $13d04,
750     $13d02, $11cb0, $18e5c, $13db0, $11c98, $18e4e, $13d98, $19ece, $13d8c,
751     $11c86, $13d86, $10c5c, $11cdc, $10c4e, $13ddc, $11cce, $13dce, $1bea0,
752     $1df58, $1efae, $1be90, $1df4c, $1be88, $1df46, $1be84, $1be82, $13ca0,
753     $19e58, $1cf2e, $17da0, $13c90, $19e4c, $17d90, $1becc, $19e46, $17d88,
754     $13c84, $17d84, $13c82, $17d82, $11c58, $18e2e, $13cd8, $11c4c, $17dd8,
755     $13ccc, $11c46, $17dcc, $13cc6, $17dc6, $10c2e, $11c6e, $13cee, $17dee,
756     $1be50, $1df2c, $1be48, $1df26, $1be44, $1be42, $13c50, $19e2c, $17cd0,
757     $13c48, $19e26, $17cc8, $1be66, $17cc4, $13c42, $17cc2, $11c2c, $13c6c,
758     $11c26, $17cec, $13c66, $17ce6, $1be28, $1df16, $1be24, $1be22, $13c28,
759     $19e16, $17c68, $13c24, $17c64, $13c22, $17c62, $11c16, $13c36, $17c76,
760     $1be14, $1be12, $13c14, $17c34, $13c12, $17c32, $102bc, $1029e, $106b8,
761     $1835e, $1069c, $1068e, $1025e, $106de, $10eb0, $1875c, $10e98, $1874e,
762     $10e8c, $10e86, $1065c, $10edc, $1064e, $10ece, $11ea0, $18f58, $1c7ae,
763     $11e90, $18f4c, $11e88, $18f46, $11e84, $11e82, $10e58, $1872e, $11ed8,
764     $18f6e, $11ecc, $10e46, $11ec6, $1062e, $10e6e, $11eee, $19f50, $1cfac,
765     $19f48, $1cfa6, $19f44, $19f42, $11e50, $18f2c, $13ed0, $19f6c, $18f26,
766     $13ec8, $11e44, $13ec4, $11e42, $13ec2, $10e2c, $11e6c, $10e26, $13eec,
767     $11e66, $13ee6, $1dfa8, $1efd6, $1dfa4, $1dfa2, $19f28, $1cf96, $1bf68,
768     $19f24, $1bf64, $19f22, $1bf62, $11e28, $18f16, $13e68, $11e24, $17ee8,
769     $13e64, $11e22, $17ee4, $13e62, $17ee2, $10e16, $11e36, $13e76, $17ef6,
770     $1df94, $1df92, $19f14, $1bf34, $19f12, $1bf32, $11e14, $13e34, $11e12,
771     $17e74, $13e32, $17e72, $1df8a, $19f0a, $1bf1a, $11e0a, $13e1a, $17e3a,
772     $1035c, $1034e, $10758, $183ae, $1074c, $10746, $1032e, $1076e, $10f50,
773     $187ac, $10f48, $187a6, $10f44, $10f42, $1072c, $10f6c, $10726, $10f66,
774     $18fa8, $1c7d6, $18fa4, $18fa2, $10f28, $18796, $11f68, $18fb6, $11f64,
775     $10f22, $11f62, $10716, $10f36, $11f76, $1cfd4, $1cfd2, $18f94, $19fb4,
776     $18f92, $19fb2, $10f14, $11f34, $10f12, $13f74, $11f32, $13f72, $1cfca,
777     $18f8a, $19f9a, $10f0a, $11f1a, $13f3a, $103ac, $103a6, $107a8, $183d6,
778     $107a4, $107a2, $10396, $107b6, $187d4, $187d2, $10794, $10fb4, $10792,
779     $10fb2, $1c7ea));
780    
781     type
782     TStPDF417TextCompactionMode = (cmAlpha, cmLower, cmMixed, cmPunctuation,
783     cmNone);
784     TStPDF417TextCompactionModes = set of TStPDF417TextCompactionMode;
785    
786     TStPDF417TextCompactionData = record
787     Value : Integer;
788     Mode : TStPDF417TextCompactionModes;
789     end;
790    
791     const
792     TStPDF417TextCompaction : array [0..127] of TStPDF417TextCompactionData =
793     ((Value : -1; Mode : []), { 000 }
794     (Value : -1; Mode : []), { 001 }
795     (Value : -1; Mode : []), { 002 }
796     (Value : -1; Mode : []), { 003 }
797     (Value : -1; Mode : []), { 004 }
798     (Value : -1; Mode : []), { 005 }
799     (Value : -1; Mode : []), { 006 }
800     (Value : -1; Mode : []), { 007 }
801     (Value : -1; Mode : []), { 008 }
802     (Value : 12; Mode : [cmMixed, cmPunctuation]), { 009 }
803     (Value : 15; Mode : [cmPunctuation]), { 010 }
804     (Value : -1; Mode : []), { 011 }
805     (Value : -1; Mode : []), { 012 }
806     (Value : 11; Mode : [cmMixed, cmPunctuation]), { 013 }
807     (Value : -1; Mode : []), { 014 }
808     (Value : -1; Mode : []), { 015 }
809     (Value : -1; Mode : []), { 016 }
810     (Value : -1; Mode : []), { 017 }
811     (Value : -1; Mode : []), { 018 }
812     (Value : -1; Mode : []), { 019 }
813     (Value : -1; Mode : []), { 020 }
814     (Value : -1; Mode : []), { 021 }
815     (Value : -1; Mode : []), { 022 }
816     (Value : -1; Mode : []), { 023 }
817     (Value : -1; Mode : []), { 024 }
818     (Value : -1; Mode : []), { 025 }
819     (Value : -1; Mode : []), { 026 }
820     (Value : -1; Mode : []), { 027 }
821     (Value : -1; Mode : []), { 028 }
822     (Value : -1; Mode : []), { 029 }
823     (Value : -1; Mode : []), { 030 }
824     (Value : -1; Mode : []), { 031 }
825     (Value : 26; Mode : [cmAlpha, cmLower, cmMixed]), { 032 }
826     (Value : 10; Mode : [cmPunctuation]), { 033 }
827     (Value : 20; Mode : [cmPunctuation]), { 034 }
828     (Value : 15; Mode : [cmMixed]), { 035 }
829     (Value : 18; Mode : [cmMixed, cmPunctuation]), { 036 }
830     (Value : 21; Mode : [cmMixed]), { 037 }
831     (Value : 10; Mode : [cmMixed]), { 038 }
832     (Value : 28; Mode : [cmPunctuation]), { 039 }
833     (Value : 23; Mode : [cmPunctuation]), { 040 }
834     (Value : 24; Mode : [cmPunctuation]), { 041 }
835     (Value : 22; Mode : [cmMixed, cmPunctuation]), { 042 }
836     (Value : 20; Mode : [cmMixed]), { 043 }
837     (Value : 13; Mode : [cmMixed, cmPunctuation]), { 044 }
838     (Value : 16; Mode : [cmMixed, cmPunctuation]), { 045 }
839     (Value : 17; Mode : [cmMixed, cmPunctuation]), { 046 }
840     (Value : 19; Mode : [cmMixed, cmPunctuation]), { 047 }
841     (Value : 0; Mode : [cmMixed]), { 048 }
842     (Value : 1; Mode : [cmMixed]), { 049 }
843     (Value : 2; Mode : [cmMixed]), { 050 }
844     (Value : 3; Mode : [cmMixed]), { 051 }
845     (Value : 4; Mode : [cmMixed]), { 052 }
846     (Value : 5; Mode : [cmMixed]), { 053 }
847     (Value : 6; Mode : [cmMixed]), { 054 }
848     (Value : 7; Mode : [cmMixed]), { 055 }
849     (Value : 8; Mode : [cmMixed]), { 056 }
850     (Value : 9; Mode : [cmMixed]), { 057 }
851     (Value : 14; Mode : [cmMixed, cmPunctuation]), { 058 }
852     (Value : 0; Mode : [cmPunctuation]), { 059 }
853     (Value : 1; Mode : [cmPunctuation]), { 060 }
854     (Value : 23; Mode : [cmMixed]), { 061 }
855     (Value : 2; Mode : [cmPunctuation]), { 062 }
856     (Value : 25; Mode : [cmPunctuation]), { 063 }
857     (Value : 3; Mode : [cmPunctuation]), { 064 }
858     (Value : 0; Mode : [cmAlpha]), { 065 }
859     (Value : 1; Mode : [cmAlpha]), { 066 }
860     (Value : 2; Mode : [cmAlpha]), { 067 }
861     (Value : 3; Mode : [cmAlpha]), { 068 }
862     (Value : 4; Mode : [cmAlpha]), { 069 }
863     (Value : 5; Mode : [cmAlpha]), { 070 }
864     (Value : 6; Mode : [cmAlpha]), { 071 }
865     (Value : 7; Mode : [cmAlpha]), { 072 }
866     (Value : 8; Mode : [cmAlpha]), { 073 }
867     (Value : 9; Mode : [cmAlpha]), { 074 }
868     (Value : 10; Mode : [cmAlpha]), { 075 }
869     (Value : 11; Mode : [cmAlpha]), { 076 }
870     (Value : 12; Mode : [cmAlpha]), { 077 }
871     (Value : 13; Mode : [cmAlpha]), { 078 }
872     (Value : 14; Mode : [cmAlpha]), { 079 }
873     (Value : 15; Mode : [cmAlpha]), { 080 }
874     (Value : 16; Mode : [cmAlpha]), { 081 }
875     (Value : 17; Mode : [cmAlpha]), { 082 }
876     (Value : 18; Mode : [cmAlpha]), { 083 }
877     (Value : 19; Mode : [cmAlpha]), { 084 }
878     (Value : 20; Mode : [cmAlpha]), { 085 }
879     (Value : 21; Mode : [cmAlpha]), { 086 }
880     (Value : 22; Mode : [cmAlpha]), { 087 }
881     (Value : 23; Mode : [cmAlpha]), { 088 }
882     (Value : 24; Mode : [cmAlpha]), { 089 }
883     (Value : 25; Mode : [cmAlpha]), { 090 }
884     (Value : 4; Mode : [cmPunctuation]), { 091 }
885     (Value : 5; Mode : [cmPunctuation]), { 092 }
886     (Value : 6; Mode : [cmPunctuation]), { 093 }
887     (Value : 24; Mode : [cmMixed]), { 094 }
888     (Value : 7; Mode : [cmPunctuation]), { 095 }
889     (Value : 8; Mode : [cmPunctuation]), { 096 }
890     (Value : 0; Mode : [cmLower]), { 097 }
891     (Value : 1; Mode : [cmLower]), { 098 }
892     (Value : 2; Mode : [cmLower]), { 099 }
893     (Value : 3; Mode : [cmLower]), { 100 }
894     (Value : 4; Mode : [cmLower]), { 101 }
895     (Value : 5; Mode : [cmLower]), { 102 }
896     (Value : 6; Mode : [cmLower]), { 103 }
897     (Value : 7; Mode : [cmLower]), { 104 }
898     (Value : 8; Mode : [cmLower]), { 105 }
899     (Value : 9; Mode : [cmLower]), { 106 }
900     (Value : 10; Mode : [cmLower]), { 107 }
901     (Value : 11; Mode : [cmLower]), { 108 }
902     (Value : 12; Mode : [cmLower]), { 109 }
903     (Value : 13; Mode : [cmLower]), { 110 }
904     (Value : 14; Mode : [cmLower]), { 111 }
905     (Value : 15; Mode : [cmLower]), { 112 }
906     (Value : 16; Mode : [cmLower]), { 113 }
907     (Value : 17; Mode : [cmLower]), { 114 }
908     (Value : 18; Mode : [cmLower]), { 115 }
909     (Value : 19; Mode : [cmLower]), { 116 }
910     (Value : 20; Mode : [cmLower]), { 117 }
911     (Value : 21; Mode : [cmLower]), { 118 }
912     (Value : 22; Mode : [cmLower]), { 119 }
913     (Value : 23; Mode : [cmLower]), { 120 }
914     (Value : 24; Mode : [cmLower]), { 121 }
915     (Value : 25; Mode : [cmLower]), { 122 }
916     (Value : 26; Mode : [cmPunctuation]), { 123 }
917     (Value : 21; Mode : [cmPunctuation]), { 124 }
918     (Value : 27; Mode : [cmPunctuation]), { 125 }
919     (Value : 9; Mode : [cmPunctuation]), { 126 }
920     (Value : -1; Mode : [])); { 127 }
921    
922     { TStMaxiCode types and constants }
923    
924     type
925     TStMaxiCodeCodeSet = (csCodeSetA, csCodeSetB, csCodeSetC, csCodeSetD,
926     csCodeSetE, csNone);
927    
928     const
929     StMaxiCodeCodeSets : array [csCodeSetA..csCodeSetE] of
930     array [0..255] of ShortInt =
931     { csCodeSetA }
932     {0} {1} {2} {3} {4} {5} {6} {7} {8} {9}
933     ((-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {000}
934     -1, -1, -1, 0, -1, -1, -1, -1, -1, -1, {010}
935     -1, -1, -1, -1, -1, -1, -1, -1, 28, 29, {020}
936     30, -1, 32, 33, 34, 35, 36, 37, 38, 39, {030}
937     40, 41, 42, 43, 44, 45, 46, 47, 48, 49, {040}
938     50, 51, 52, 53, 54, 55, 56, 57, 58, -1, {050}
939     -1, -1, -1, -1, -1, 1, 2, 3, 4, 5, {060}
940     6, 7, 8, 9, 10, 11, 12, 13, 14, 15, {070}
941     16, 17, 18, 19, 20, 21, 22, 23, 24, 25, {080}
942     26, -1, -1, -1, -1, -1, -1, -1, -1, -1, {090}
943     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {100}
944     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {110}
945     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {120}
946     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {130}
947     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {140}
948     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {150}
949     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {160}
950     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {170}
951     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {180}
952     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {190}
953     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {200}
954     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {210}
955     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {220}
956     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {230}
957     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {240}
958     -1, -1, -1, -1, -1, -1), {250}
959     { csCodeSetB }
960     {0} {1} {2} {3} {4} {5} {6} {7} {8} {9}
961     (-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {000}
962     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {010}
963     -1, -1, -1, -1, -1, -1, -1, -1, 28, 29, {020}
964     30, -1, 47, 53, -1, -1, -1, -1, -1, -1, {030}
965     -1, -1, -1, -1, 48, 49, 50, -1, -1, -1, {040}
966     -1, -1, -1, -1, -1, -1, -1, -1, 51, 37, {050}
967     38, 39, 40, 41, 52, -1, -1, -1, -1, -1, {060}
968     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {070}
969     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {080}
970     -1, 42, 43, 44, 45, 46, 0, 1, 2, 3, {090}
971     4, 5, 6, 7, 8, 9, 10, 11, 12, 13, {100}
972     14, 15, 16, 17, 18, 19, 20, 21, 22, 23, {110}
973     24, 25, 26, 32, 54, 34, 35, 36, -1, -1, {120}
974     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {130}
975     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {140}
976     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {150}
977     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {160}
978     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {170}
979     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {180}
980     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {190}
981     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {200}
982     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {210}
983     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {220}
984     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {230}
985     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {240}
986     -1, -1, -1, -1, -1, -1), {250}
987     { csCodeSetC }
988     {0} {1} {2} {3} {4} {5} {6} {7} {8} {9}
989     (-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {000}
990     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {010}
991     -1, -1, -1, -1, -1, -1, -1, -1, 28, 29, {020}
992     30, -1, 59, -1, -1, -1, -1, -1, -1, -1, {030}
993     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {040}
994     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {050}
995     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {060}
996     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {070}
997     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {080}
998     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {090}
999     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {100}
1000     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {110}
1001     -1, -1, -1, -1, -1, -1, -1, -1, 48, 49, {120}
1002     50, 51, 52, 53, 54, 55, 56, 57, -1, -1, {130}
1003     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {140}
1004     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {150}
1005     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {160}
1006     37, -1, 38, -1, -1, -1, -1, 39, 40, 41, {170}
1007     -1, 42, -1, -1, -1, 43, 44, -1, 45, 46, {180}
1008     47, -1, 0, 1, 2, 3, 4, 5, 6, 7, {190}
1009     8, 9, 10, 11, 12, 13, 14, 15, 16, 17, {200}
1010     18, 19, 20, 21, 22, 23, 24, 25, 26, 32, {210}
1011     33, 34, 35, 36, -1, -1, -1, -1, -1, -1, {220}
1012     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {230}
1013     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {240}
1014     -1, -1, -1, -1, -1, -1), {250}
1015     { csCodeSetD }
1016     {0} {1} {2} {3} {4} {5} {6} {7} {8} {9}
1017     (-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {000}
1018     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {010}
1019     -1, -1, -1, -1, -1, -1, -1, -1, 28, 29, {020}
1020     30, -1, 59, -1, -1, -1, -1, -1, -1, -1, {030}
1021     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {040}
1022     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {050}
1023     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {060}
1024     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {070}
1025     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {080}
1026     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {090}
1027     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {100}
1028     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {110}
1029     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {120}
1030     -1, -1, -1, -1, -1, -1, -1, -1, 47, 48, {130}
1031     49, 50, 51, 52, 53, 54, 55, 56, 57, -1, {140}
1032     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {150}
1033     -1, 37, -1, -1, -1, -1, -1, -1, 38, -1, {160}
1034     -1, 39, -1, -1, -1, 40, 41, -1, -1, -1, {170}
1035     42, -1, -1, 43, 44, -1, -1, 45, -1, -1, {180}
1036     -1, 46, -1, -1, -1, -1, -1, -1, -1, -1, {190}
1037     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {200}
1038     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {210}
1039     -1, -1, -1, -1, 0, 1, 2, 3, 4, 5, {220}
1040     6, 7, 8, 9, 10, 11, 12, 13, 14, 15, {230}
1041     16, 17, 18, 19, 20, 21, 22, 23, 24, 25, {240}
1042     26, 32, 33, 34, 35, 36), {250}
1043     { csCodeSetE }
1044     {0} {1} {2} {3} {4} {5} {6} {7} {8} {9}
1045     ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, {000}
1046     10, 11, 12, 13, 14, 15, 16, 17, 18, 19, {010}
1047     20, 21, 22, 23, 24, 25, 26, 30, 32, 33, {020}
1048     34, 35, 59, -1, -1, -1, -1, -1, -1, -1, {030}
1049     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {040}
1050     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {050}
1051     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {060}
1052     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {070}
1053     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {080}
1054     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {090}
1055     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {100}
1056     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {110}
1057     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {120}
1058     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {130}
1059     -1, -1, -1, -1, -1, -1, -1, -1, -1, 48, {140}
1060     49, 50, 51, 52, 53, 54, 55, 56, 57, 36, {150}
1061     37, -1, 38, 39, 40, 41, 42, 43, -1, 44, {160}
1062     -1, -1, -1, 45, 46, -1, -1, -1, -1, -1, {170}
1063     -1, -1, 47, -1, -1, -1, -1, -1, -1, -1, {180}
1064     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {190}
1065     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {200}
1066     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {210}
1067     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {220}
1068     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {230}
1069     -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {240}
1070     -1, -1, -1, -1, -1, -1)); {250}
1071    
1072     { TStCustom2DBarcode }
1073    
1074     constructor TStCustom2DBarcode.Create (AOwner : TComponent);
1075     begin
1076     inherited Create (AOwner);
1077    
1078     FBitmap := TBitmap.Create;
1079    
1080     FBarWidth := 2;
1081     FBarHeight := 0;
1082     FBackgroundColor := clWhite;
1083     FExtendedSyntax := True;
1084     FQuietZone := 8;
1085     FAlignment := taCenter;
1086     FCaptionLayout := tlBottom;
1087     Width := 329;
1088     Height := 50;
1089     Color := clBlack;
1090     FECCLevel := 2;
1091     FRelativeBarHeight := False;
1092     FBarHeightToWidth := 4;
1093     FBarHeight := 2;
1094     FCaption := '';
1095     FCode := '';
1096     FECCLevel := 0;
1097     end;
1098    
1099     destructor TStCustom2DBarcode.Destroy;
1100     begin
1101     FBitmap.Free;
1102    
1103     inherited Destroy;
1104     end;
1105    
1106     procedure TStCustom2DBarcode.CopyToClipboard;
1107     begin
1108     CopyToClipboardRes (0, 0);
1109     end;
1110    
1111     procedure TStCustom2DBarcode.CopyToClipboardRes (ResX : Integer;
1112     ResY : Integer);
1113     var
1114     MetaFile : TMetaFile;
1115     MetaFileCanvas : TMetaFileCanvas;
1116     RenderBMP : TBitmap;
1117     SizeX : Integer;
1118     SizeY : Integer;
1119    
1120     begin
1121     Clipboard.Clear;
1122     Clipboard.Open;
1123     try
1124     RenderBmp := TBitmap.Create;
1125     try
1126     RenderToResolution (RenderBmp, ResX, ResY, SizeX, SizeY);
1127     Clipboard.Assign (RenderBmp);
1128    
1129     {metafile}
1130     MetaFile := TMetaFile.Create;
1131     try
1132     MetaFileCanvas := TMetaFileCanvas.Create (MetaFile, 0);
1133     try
1134     MetaFile.Enhanced := True;
1135     MetaFile.Width := ClientWidth;
1136     MetaFile.Height := ClientHeight;
1137     MetaFileCanvas.Draw (0, 0, RenderBmp);
1138     finally
1139     MetaFileCanvas.Free;
1140     end;
1141     Clipboard.Assign (MetaFile);
1142     finally
1143     MetaFile.Free;
1144     end;
1145     finally
1146     RenderBmp.Free;
1147     end;
1148     finally
1149     Clipboard.Close;
1150     end;
1151     end;
1152    
1153     procedure TStCustom2DBarcode.GenerateBarcodeBitmap (BCWidth : Integer;
1154     BCHeight : Integer);
1155     var
1156     TextHeight : Integer;
1157     TextWidth : Integer;
1158     XPos : Integer;
1159     YPos : Integer;
1160     TopOffset : Integer;
1161     BottomOffset : Integer;
1162     BarCodeHeight : Integer;
1163     BarCodeWidth : Integer;
1164     RWidthOffset : Integer;
1165     LWidthOffset : Integer;
1166     PaintHeight : Integer;
1167    
1168     begin
1169     { Initialize the canvas }
1170     FBitmap.Width := BCWidth;
1171     FBitmap.Height := BCHeight;
1172     FBitmap.Canvas.Pen.Color := Color;
1173     FBitmap.Canvas.Brush.Color := BackgroundColor;
1174     FBitmap.Canvas.FillRect (Rect (0, 0, BCWidth, BCHeight));
1175     FBitmap.Canvas.Brush.Color := Color;
1176    
1177     { Calculate the size of the caption }
1178     FBitmap.Canvas.Font.Assign (Font);
1179     TextHeight := FBitmap.Canvas.TextHeight ('Yg0');
1180     TextWidth := FBitmap.Canvas.TextWidth (Caption);
1181    
1182     { determine x position of the caption }
1183     XPos := 0;
1184     case FAlignment of
1185     taLeftJustify :
1186     XPos := 0;
1187     taRightJustify :
1188     if BCWidth - TextWidth > 0 then
1189     XPos := BCWidth - TextWidth
1190     else
1191     XPos := 0;
1192     taCenter :
1193     if BCWidth - TextWidth > 0 then
1194     XPos := BCWidth div 2 - TextWidth div 2
1195     else
1196     XPos := 0;
1197     end;
1198    
1199     { determine the y position of the caption. In addition, determine offsets
1200     for the barcode painting. }
1201     TopOffset := 0;
1202     BottomOffset := 0;
1203     YPos := 0;
1204     case FCaptionLayout of
1205     tlBottom :
1206     begin
1207     if BCHeight - 2 - TextHeight > 0 then
1208     YPos := BCHeight - 2 - TextHeight
1209     else
1210     YPos := 0;
1211     if Caption <> '' then
1212     BottomOffset := TextHeight + 4;
1213     end;
1214     tlTop :
1215     begin
1216     YPos := 0;
1217     if Caption <> '' then
1218     TopOffset := TextHeight + 4;
1219     end;
1220     tlCenter :
1221     if BCHeight - TextHeight > 0 then
1222     YPos := BCHeight div 2 - TextHeight div 2
1223     else
1224     YPos := 0;
1225     end;
1226    
1227     { determine the size of the barcode and calculate the rectangle the
1228     barcode should be painted in. Take into account the size of the
1229     caption (and it's existance), and the quiet zone.}
1230     PaintHeight := BCHeight - QuietZone * 2 - BottomOffset - TopOffset;
1231     BarCodeHeight := CalculateBarCodeHeight (PaintHeight);
1232     BarCodeWidth := CalculateBarCodeWidth (BCWidth);
1233     if BarCodeHeight < PaintHeight then begin
1234     Inc (BottomOffset, (PaintHeight - BarCodeHeight) div 2);
1235     Inc (TopOffset, (PaintHeight - BarCodeHeight) div 2);
1236     end;
1237    
1238     { Position the barcode horizontally }
1239     LWidthOffset := QuietZone;
1240     RWidthOffset := QuietZone;
1241     if BarCodeWidth < BCWidth - QuietZone * 2 then
1242     case Alignment of
1243     taLeftJustify :
1244     begin
1245     LWidthOffset := QuietZone;
1246     RWidthOffset := BCWidth - BarCodeWidth - QuietZone;
1247     end;
1248     taRightJustify :
1249     begin
1250     RWidthOffset := QuietZone;
1251     LWidthOffset := BCWidth - BarCodeWidth - QuietZone;
1252     end;
1253     taCenter :
1254     begin
1255     LWidthOffset := (BCWidth - BarCodeWidth) div 2;
1256     RWidthOffset := (BCWidth - BarCodeWidth) div 2;
1257     end;
1258     end;
1259    
1260     { Save the barcode rectangle }
1261     FBarCodeRect := Rect (LWidthOffset,
1262     QuietZone + TopOffset,
1263     BCWidth - RWidthOffset,
1264     BCHeight - QuietZone - BottomOffset);
1265     { Draw the barcode }
1266     DrawBarcode;
1267    
1268     FBitmap.Canvas.Brush.Color := BackgroundColor;
1269     { Draw the caption }
1270     FBitmap.Canvas.TextOut (XPos, YPos, Caption);
1271     end;
1272    
1273     function TStCustom2DBarcode.GetBarCodeHeight : Integer;
1274     begin
1275     Result := CalculateBarCodeHeight (Height);
1276     end;
1277    
1278     function TStCustom2DBarcode.GetBarCodeWidth : Integer;
1279     begin
1280     Result := CalculateBarCodeWidth (Width);
1281     end;
1282    
1283     procedure TStCustom2DBarcode.GetCurrentResolution (var ResX : Integer;
1284     var ResY : Integer);
1285     begin
1286     ResX := GetDeviceCaps (FBitmap.Canvas.Handle, LOGPIXELSX);
1287     ResY := GetDeviceCaps (FBitmap.Canvas.Handle, LOGPIXELSY);
1288     end;
1289    
1290     function TStCustom2DBarcode.GetVersion : string;
1291     begin
1292     Result := StVersionStr;
1293     end;
1294    
1295     procedure TStCustom2DBarcode.Paint;
1296     begin
1297     GenerateBarcodeBitmap (Width, Height);
1298     Canvas.CopyRect (Rect (0, 0, Width, Height),
1299     FBitmap.Canvas,
1300     Rect (0, 0, Width, Height));
1301     end;
1302    
1303     procedure TStCustom2DBarcode.PaintToCanvas (ACanvas : TCanvas;
1304     Position : TPoint);
1305     begin
1306     PaintToDC (ACanvas.Handle, Position);
1307     end;
1308    
1309     procedure TStCustom2DBarcode.PaintToCanvasRes (ACanvas : TCanvas;
1310     Position : TPoint;
1311     ResX : Integer;
1312     ResY : Integer);
1313     begin
1314     PaintToDCRes (ACanvas.Handle, Position, ResX, ResY);
1315     end;
1316    
1317     procedure TStCustom2DBarcode.PaintToCanvasSize (ACanvas : TCanvas;
1318     X, Y, H : Double);
1319     var
1320     PixelsPerInchX : Integer;
1321     PixelsPerInchY : Integer;
1322    
1323     begin
1324     {get some information about this device context}
1325     PixelsPerInchX := GetDeviceCaps (ACanvas.Handle, LOGPIXELSX);
1326     PixelsPerInchY := GetDeviceCaps (ACanvas.Handle, LOGPIXELSY);
1327    
1328     PaintToCanvasRes (ACanvas,
1329     Point (Round (PixelsPerInchX * X),
1330     Round (PixelsPerInchY * Y)),
1331     Round (PixelsPerInchX * H),
1332     Round (PixelsPerInchY * H));
1333     end;
1334    
1335     procedure TStCustom2DBarcode.PaintToDC (DC : hDC; Position : TPoint);
1336     var
1337     NewResX : Integer;
1338     NewResY : Integer;
1339    
1340     begin
1341     NewResX := GetDeviceCaps (DC, LOGPIXELSX);
1342     NewResY := GetDeviceCaps (DC, LOGPIXELSY);
1343     PaintToDCRes (DC, Position, NewResX, NewResY);
1344     end;
1345    
1346     procedure TStCustom2DBarcode.PaintToDCRes (DC : hDC; Position : TPoint;
1347     ResX : Integer; ResY : Integer);
1348     var
1349     ACanvas : TCanvas;
1350     R1 : TRect;
1351     R2 : TRect;
1352     RenderBmp : TBitmap;
1353     SizeX : Integer;
1354     SizeY : Integer;
1355    
1356     begin
1357     ACanvas := TCanvas.Create;
1358     ACanvas.Handle := DC;
1359     try
1360     RenderBmp := TBitmap.Create;
1361     try
1362     {this is necessary because of a Delphi buglet}
1363     RenderBmp.Canvas.Font.PixelsPerInch := ResY;
1364     {use our font}
1365     RenderBmp.Canvas.Font := Font;
1366    
1367     RenderToResolution (RenderBmp, ResX, ResY, SizeX, SizeY);
1368     R1 := Rect (0, 0, RenderBmp.Width, RenderBmp.Height);
1369     R2 := Rect (Position.X, Position.Y,
1370     RenderBmp.Width + Position.X,
1371     RenderBmp.Height + Position.Y);
1372    
1373     ACanvas.CopyRect (R2, RenderBmp.Canvas, R1);
1374     finally
1375     RenderBmp.Free;
1376     end;
1377     finally
1378     ACanvas.Free;
1379     end;
1380     end;
1381    
1382     procedure TStCustom2DBarcode.PaintToPrinterCanvas (ACanvas : TCanvas;
1383     Position : TPoint);
1384     begin
1385     PaintToPrinterDC (ACanvas.Handle, Position);
1386     end;
1387    
1388     procedure TStCustom2DBarcode.PaintToPrinterCanvasRes (ACanvas : TCanvas;
1389     Position : TPoint;
1390     ResX : Integer;
1391     ResY : Integer);
1392     begin
1393     PaintToPrinterDCRes (ACanvas.Handle, Position, ResX, ResY);
1394     end;
1395    
1396     procedure TStCustom2DBarcode.PaintToPrinterCanvasSize (ACanvas : TCanvas;
1397     X, Y, H : Double);
1398     var
1399     PixelsPerInchX : Integer;
1400     PixelsPerInchY : Integer;
1401    
1402     begin
1403     {get some information about this device context}
1404     PixelsPerInchX := GetDeviceCaps (ACanvas.Handle, LOGPIXELSX);
1405     PixelsPerInchY := GetDeviceCaps (ACanvas.Handle, LOGPIXELSY);
1406    
1407     PaintToPrinterCanvasRes (ACanvas,
1408     Point (Round (PixelsPerInchX * X),
1409     Round (PixelsPerInchY * Y)),
1410     Round (PixelsPerInchX * H),
1411     Round (PixelsPerInchY * H));
1412     end;
1413    
1414     procedure TStCustom2DBarcode.PaintToPrinterDC (DC : hDC; Position : TPoint);
1415     var
1416     NewResX : Integer;
1417     NewResY : Integer;
1418    
1419     begin
1420     NewResX := GetDeviceCaps (DC, LOGPIXELSX);
1421     NewResY := GetDeviceCaps (DC, LOGPIXELSY);
1422     PaintToPrinterDCRes (DC, Position, NewResX, NewResY);
1423     end;
1424    
1425     procedure TStCustom2DBarcode.PaintToPrinterDCRes (DC : hDC;
1426     Position : TPoint;
1427     ResX : Integer;
1428     ResY : Integer);
1429     var
1430     ACanvas : TCanvas;
1431     R2 : TRect;
1432     Info : PBitMapInfo;
1433     InfoSize : DWORD;
1434     ImageSize : DWORD;
1435     Image : Pointer;
1436     RenderBmp : TBitmap;
1437     SizeX : Integer;
1438     SizeY : Integer;
1439    
1440     begin
1441     ACanvas := TCanvas.Create;
1442     ACanvas.Handle := DC;
1443     try
1444     RenderBmp := TBitmap.Create;
1445     try
1446     {this is necessary because of a Delphi buglet}
1447     RenderBmp.Canvas.Font.PixelsPerInch := ResY;
1448     {use our font}
1449     RenderBmp.Canvas.Font.Assign (Font);
1450    
1451     RenderToResolution (RenderBmp, ResX, ResY, SizeX, SizeY);
1452     R2 := Rect (Position.X, Position.Y,
1453     SizeX + Position.X,
1454     SizeY + Position.Y);
1455    
1456     {Delphi does not allow a simple Canvas.CopyRect to the printer Canvas}
1457     with RenderBmp do begin
1458     GetDIBSizes (Handle, InfoSize, ImageSize);
1459     GetMem (Info, InfoSize);
1460     try
1461     GetMem (Image, ImageSize);
1462     try
1463     GetDIB (Handle, Palette, Info^, Image^);
1464     with Info^.bmiHeader do begin
1465     StretchDIBits (ACanvas.Handle,
1466     R2.Left, R2.Top, SizeX, SizeY,
1467     0, 0, biWidth, biHeight,
1468     Image, Info^, DIB_RGB_COLORS, SRCCOPY);
1469     end;
1470     finally
1471     FreeMem (Image, ImageSize)
1472     end;
1473     finally
1474     FreeMem (Info, InfoSize);
1475     end;
1476     end;
1477     finally
1478     RenderBmp.Free;
1479     end;
1480     finally
1481     ACanvas.Free;
1482     end;
1483     end;
1484    
1485     procedure TStCustom2DBarcode.SaveToFile (const FileName : string);
1486     begin
1487     GenerateBarcodeBitmap (Width, Height);
1488     FBitmap.SaveToFile (FileName);
1489     end;
1490    
1491     procedure TStCustom2DBarcode.SaveToFileRes (const FileName : string;
1492     ResX : Integer; ResY : Integer);
1493     var
1494     RenderBmp : TBitmap;
1495     SizeX : Integer;
1496     SizeY : Integer;
1497    
1498     begin
1499     RenderBmp := TBitmap.Create;
1500     try
1501     RenderToResolution (RenderBmp, ResX, ResY, SizeX, SizeY);
1502     RenderBmp.SaveToFile (FileName);
1503     finally
1504     RenderBmp.Free;
1505     end;
1506     end;
1507    
1508     procedure TStCustom2DBarcode.SetAlignment (const v : TAlignment);
1509     var
1510     OldAlignment : TAlignment;
1511    
1512     begin
1513     if v <> FAlignment then begin
1514     OldAlignment := FAlignment;
1515     try
1516     FAlignment := v;
1517     GenerateBarcodeBitmap (Width, Height);
1518     Invalidate;
1519     except
1520     on E2DBarcodeError do begin
1521     FAlignment := OldAlignment;
1522     try
1523     GenerateBarcodeBitmap (Width, Height);
1524     Invalidate;
1525     except
1526     on E2DBarcodeError do begin
1527     end;
1528     end;
1529     raise
1530     end;
1531     end;
1532     end;
1533     end;
1534    
1535     procedure TStCustom2DBarcode.SetBackgroundColor (const v : TColor);
1536     var
1537     OldBackgroundColor : TColor;
1538    
1539     begin
1540     if v <> FBackgroundColor then begin
1541     OldBackgroundColor := FBackgroundColor;
1542     try
1543     FBackgroundColor := v;
1544     GenerateBarcodeBitmap (Width, Height);
1545     Invalidate;
1546     except
1547     on E2DBarcodeError do begin
1548     FBackgroundColor := OldBackgroundColor;
1549     try
1550     GenerateBarcodeBitmap (Width, Height);
1551     Invalidate;
1552     except
1553     on E2DBarcodeError do begin
1554     end;
1555     end;
1556     raise
1557     end;
1558     end;
1559     end;
1560     end;
1561    
1562     procedure TStCustom2DBarcode.SetBarHeight (const v : Integer);
1563     var
1564     OldBarHeight : Integer;
1565    
1566     begin
1567     if v <> FBarHeight then begin
1568     OldBarHeight := FBarHeight;
1569     try
1570     FBarHeight := v;
1571     GenerateBarcodeBitmap (Width, Height);
1572     Invalidate;
1573     except
1574     on E2DBarcodeError do begin
1575     FBarHeight := OldBarHeight;
1576     try
1577     GenerateBarcodeBitmap (Width, Height);
1578     Invalidate;
1579     except
1580     on E2DBarcodeError do begin
1581     end;
1582     end;
1583     raise
1584     end;
1585     end;
1586     end;
1587     end;
1588    
1589     procedure TStCustom2DBarcode.SetBarHeightToWidth (const v : Integer);
1590     var
1591     OldBarHeightToWidth : Integer;
1592    
1593     begin
1594     if v <> FBarHeightToWidth then begin
1595     if v < 0 then
1596     raise E2DBarcodeError.Create (StEBadBarHeightToWidth);
1597     OldBarHeightToWidth := FBarHeightToWidth;
1598     try
1599     FBarHeightToWidth := v;
1600     GenerateBarcodeBitmap (Width, Height);
1601     Invalidate;
1602     except
1603     on E2DBarcodeError do begin
1604     FBarHeightToWidth := OldBarHeightToWidth;
1605     try
1606     GenerateBarcodeBitmap (Width, Height);
1607     Invalidate;
1608     except
1609     on E2DBarcodeError do begin
1610     end;
1611     end;
1612     raise
1613     end;
1614     end;
1615     end;
1616     end;
1617    
1618     procedure TStCustom2DBarcode.SetBarWidth (const v : Integer);
1619     var
1620     OldBarWidth : Integer;
1621    
1622     begin
1623     if v <> FBarWidth then begin
1624     OldBarWidth := FBarWidth;
1625     try
1626     FBarWidth := v;
1627     GenerateBarcodeBitmap (Width, Height);
1628     Invalidate;
1629     except
1630     on E2DBarcodeError do begin
1631     FBarWidth := OldBarWidth;
1632     try
1633     GenerateBarcodeBitmap (Width, Height);
1634     Invalidate;
1635     except
1636     on E2DBarcodeError do begin
1637     end;
1638     end;
1639     raise
1640     end;
1641     end;
1642     end;
1643     end;
1644    
1645     procedure TStCustom2DBarcode.SetBitmap (const v : TBitmap);
1646     begin
1647     FBitmap.Assign (v);
1648     Invalidate;
1649     end;
1650    
1651     procedure TStCustom2DBarcode.SetCaption (const v : string);
1652     var
1653     OldCaption : string;
1654    
1655     begin
1656     if v <> FCaption then begin
1657     OldCaption := FCaption;
1658     try
1659     FCaption := v;
1660     GenerateBarcodeBitmap (Width, Height);
1661     Invalidate;
1662     except
1663     on E2DBarcodeError do begin
1664     FCaption := OldCaption;
1665     try
1666     GenerateBarcodeBitmap (Width, Height);
1667     Invalidate;
1668     except
1669     on E2DBarcodeError do begin
1670     end;
1671     end;
1672     raise
1673     end;
1674     end;
1675     end;
1676     end;
1677    
1678     procedure TStCustom2DBarcode.SetCaptionLayout (const v : TTextLayout);
1679     var
1680     OldCaptionLayout : TTextLayout;
1681    
1682     begin
1683     if v <> FCaptionLayout then begin
1684     OldCaptionLayout := FCaptionLayout;
1685     try
1686     FCaptionLayout := v;
1687     GenerateBarcodeBitmap (Width, Height);
1688     Invalidate;
1689     except
1690     on E2DBarcodeError do begin
1691     FCaptionLayout := OldCaptionLayout;
1692     try
1693     GenerateBarcodeBitmap (Width, Height);
1694     Invalidate;
1695     except
1696     on E2DBarcodeError do begin
1697     end;
1698     end;
1699     raise
1700     end;
1701     end;
1702     end;
1703     end;
1704    
1705     procedure TStCustom2DBarcode.SetCode (const v : string);
1706     var
1707     OldCode : string;
1708    
1709     begin
1710     if v <> FCode then begin
1711     OldCode := FCode;
1712     try
1713     FCode := v;
1714     GenerateCodewords;
1715     GenerateBarcodeBitmap (Width, Height);
1716     Invalidate;
1717     except
1718     on E2DBarcodeError do begin
1719     FCode := OldCode;
1720     try
1721     GenerateCodewords;
1722     GenerateBarcodeBitmap (Width, Height);
1723     Invalidate;
1724     except
1725     on E2DBarcodeError do begin
1726     end;
1727     end;
1728     raise
1729     end;
1730     end;
1731     end;
1732     end;
1733    
1734     procedure TStCustom2DBarcode.SetECCLevel (const v : Integer);
1735     var
1736     OldECCLevel : Integer;
1737    
1738     begin
1739     if v <> FECCLevel then begin
1740     OldECCLevel := FECCLevel;
1741     try
1742     FECCLevel := v;
1743     GenerateCodewords;
1744     GenerateBarcodeBitmap (Width, Height);
1745     Invalidate;
1746     except
1747     on E2DBarcodeError do begin
1748     FECCLevel := OldECCLevel;
1749     try
1750     GenerateCodewords;
1751     GenerateBarcodeBitmap (Width, Height);
1752     Invalidate;
1753     except
1754     on E2DBarcodeError do begin
1755     end;
1756     end;
1757     raise
1758     end;
1759     end;
1760     end;
1761     end;
1762    
1763     procedure TStCustom2DBarcode.SetExtendedSyntax (const v : Boolean);
1764     var
1765     OldExtendedSyntax : Boolean;
1766    
1767     begin
1768     if v <> FExtendedSyntax then begin
1769     OldExtendedSyntax := FExtendedSyntax;
1770     try
1771     FExtendedSyntax := v;
1772     GenerateCodewords;
1773     GenerateBarcodeBitmap (Width, Height);
1774     Invalidate;
1775     except
1776     on E2DBarcodeError do begin
1777     FExtendedSyntax := OldExtendedSyntax;
1778     try
1779     GenerateCodewords;
1780     GenerateBarcodeBitmap (Width, Height);
1781     Invalidate;
1782     except
1783     on E2DBarcodeError do begin
1784     end;
1785     end;
1786     raise
1787     end;
1788     end;
1789     end;
1790     end;
1791    
1792     procedure TStCustom2DBarcode.SetQuietZone (const v : Integer);
1793     var
1794     OldQuietZone : Integer;
1795    
1796     begin
1797     if v <> FQuietZone then begin
1798     if (v < 0) then
1799     raise E2DBarcodeError.Create (StEBadQuietZone);
1800     OldQuietZone := FQuietZone;
1801     try
1802     FQuietZone := v;
1803     GenerateBarcodeBitmap (Width, Height);
1804     Invalidate;
1805     except
1806     on E2DBarcodeError do begin
1807     FQuietZone := OldQuietZone;
1808     try
1809     GenerateBarcodeBitmap (Width, Height);
1810     Invalidate;
1811     except
1812     on E2DBarcodeError do begin
1813     end;
1814     end;
1815     raise
1816     end;
1817     end;
1818     end;
1819     end;
1820    
1821     procedure TStCustom2DBarcode.SetRelativeBarHeight (const v : Boolean);
1822     var
1823     OldRelativeBarHeight : Boolean;
1824    
1825     begin
1826     if v <> FRelativeBarHeight then begin
1827     OldRelativeBarHeight := FRelativeBarHeight;
1828     try
1829     FRelativeBarHeight := v;
1830     GenerateBarcodeBitmap (Width, Height);
1831     Invalidate;
1832     except
1833     on E2DBarcodeError do begin
1834     FRelativeBarHeight := OldRelativeBarHeight;
1835     try
1836     GenerateBarcodeBitmap (Width, Height);
1837     Invalidate;
1838     except
1839     on E2DBarcodeError do begin
1840     end;
1841     end;
1842     raise
1843     end;
1844     end;
1845     end;
1846     end;
1847    
1848     procedure TStCustom2DBarcode.SetVersion(const Value : string);
1849     begin
1850     end;
1851    
1852     { TStPDF417Barcode }
1853    
1854     constructor TStPDF417Barcode.Create (AOwner : TComponent);
1855     begin
1856     inherited Create (AOwner);
1857    
1858     FNumCodewords := 1;
1859     FTruncated := False;
1860     FHighlight := False;
1861     FECCLevel := -1;
1862     FNumRows := 0;
1863     FNumColumns := 0;
1864     FTotalCodewords := FNumRows * FNumColumns;
1865     FUsedCodewords := 0;
1866     FUsedECCCodewords := 0;
1867     FFreeCodewords := FTotalCodewords;
1868     Width := 273;
1869     Height := 81;
1870    
1871     GenerateCodewords;
1872     GenerateBarcodeBitmap (Width, Height);
1873     end;
1874    
1875     procedure TStPDF417Barcode.AddCodeword (Value : Word);
1876     begin
1877     FCodewords[FNumCodewords] := Value;
1878     Inc (FNumCodewords);
1879     end;
1880    
1881     function TStPDF417Barcode.CalculateBarCodeWidth (
1882     PaintableWidth : Integer) : Integer;
1883     var
1884     XSize : Integer;
1885     YSize : Integer;
1886    
1887     begin
1888     CalculateSize (XSize, YSize);
1889     if Truncated then
1890     Result := (XSize + 2) * 17 * BarWidth + BarWidth
1891     else
1892     Result := (XSize + 4) * 17 * BarWidth + BarWidth;
1893     end;
1894    
1895     function TStPDF417Barcode.CalculateBarCodeHeight (
1896     PaintableHeight : Integer) : Integer;
1897     var
1898     XSize : Integer;
1899     YSize : Integer;
1900    
1901     begin
1902     CalculateSize (XSize, YSize);
1903     if RelativeBarHeight then
1904     Result := PaintableHeight
1905     else if BarHeightToWidth <> 0 then
1906     Result := (BarHeightToWidth * BarWidth) * YSize
1907     else
1908     Result := BarHeight * YSize;
1909     end;
1910    
1911     procedure TStPDF417Barcode.CalculateECC (NumCodewords : Integer;
1912     ECCLen : Integer);
1913    
1914     const
1915     StMods : array [0..64] of array [0..64] of Integer =
1916     (( 0, 0, 0, 0, 0, 0, 0, 0,
1917     0, 0, 0, 0, 0, 0, 0, 0,
1918     0, 0, 0, 0, 0, 0, 0, 0,
1919     0, 0, 0, 0, 0, 0, 0, 0,
1920     0, 0, 0, 0, 0, 0, 0, 0,
1921     0, 0, 0, 0, 0, 0, 0, 0,
1922     0, 0, 0, 0, 0, 0, 0, 0,
1923     0, 0, 0, 0, 0, 0, 0, 0, 0),
1924     ( 0, 0, 0, 0, 0, 0, 0, 0,
1925     0, 0, 0, 0, 0, 0, 0, 0,
1926     0, 0, 0, 0, 0, 0, 0, 0,
1927     0, 0, 0, 0, 0, 0, 0, 0,
1928     0, 0, 0, 0, 0, 0, 0, 0,
1929     0, 0, 0, 0, 0, 0, 0, 0,
1930     0, 0, 0, 0, 0, 0, 0, 0,
1931     0, 0, 0, 0, 0, 0, 0, 0, 0),
1932     (917, 27, 0, 0, 0, 0, 0, 0,
1933     0, 0, 0, 0, 0, 0, 0, 0,
1934     0, 0, 0, 0, 0, 0, 0, 0,
1935     0, 0, 0, 0, 0, 0, 0, 0,
1936     0, 0, 0, 0, 0, 0, 0, 0,
1937     0, 0, 0, 0, 0, 0, 0, 0,
1938     0, 0, 0, 0, 0, 0, 0, 0,
1939     0, 0, 0, 0, 0, 0, 0, 0, 0),
1940     (890, 351, 200, 0, 0, 0, 0, 0,
1941     0, 0, 0, 0, 0, 0, 0, 0,
1942     0, 0, 0, 0, 0, 0, 0, 0,
1943     0, 0, 0, 0, 0, 0, 0, 0,
1944     0, 0, 0, 0, 0, 0, 0, 0,
1945     0, 0, 0, 0, 0, 0, 0, 0,
1946     0, 0, 0, 0, 0, 0, 0, 0,
1947     0, 0, 0, 0, 0, 0, 0, 0, 0),
1948     (809, 723, 568, 522, 0, 0, 0, 0,
1949     0, 0, 0, 0, 0, 0, 0, 0,
1950     0, 0, 0, 0, 0, 0, 0, 0,
1951     0, 0, 0, 0, 0, 0, 0, 0,
1952     0, 0, 0, 0, 0, 0, 0, 0,
1953     0, 0, 0, 0, 0, 0, 0, 0,
1954     0, 0, 0, 0, 0, 0, 0, 0,
1955     0, 0, 0, 0, 0, 0, 0, 0, 0),
1956     (566, 155, 460, 919, 427, 0, 0, 0,
1957     0, 0, 0, 0, 0, 0, 0, 0,
1958     0, 0, 0, 0, 0, 0, 0, 0,
1959     0, 0, 0, 0, 0, 0, 0, 0,
1960     0, 0, 0, 0, 0, 0, 0, 0,
1961     0, 0, 0, 0, 0, 0, 0, 0,
1962     0, 0, 0, 0, 0, 0, 0, 0,
1963     0, 0, 0, 0, 0, 0, 0, 0, 0),
1964     (766, 17, 803, 19, 285, 861, 0, 0,
1965     0, 0, 0, 0, 0, 0, 0, 0,
1966     0, 0, 0, 0, 0, 0, 0, 0,
1967     0, 0, 0, 0, 0, 0, 0, 0,
1968     0, 0, 0, 0, 0, 0, 0, 0,
1969     0, 0, 0, 0, 0, 0, 0, 0,
1970     0, 0, 0, 0, 0, 0, 0, 0,
1971     0, 0, 0, 0, 0, 0, 0, 0, 0),
1972     (437, 691, 784, 597, 537, 925, 76, 0,
1973     0, 0, 0, 0, 0, 0, 0, 0,
1974     0, 0, 0, 0, 0, 0, 0, 0,
1975     0, 0, 0, 0, 0, 0, 0, 0,
1976     0, 0, 0, 0, 0, 0, 0, 0,
1977     0, 0, 0, 0, 0, 0, 0, 0,
1978     0, 0, 0, 0, 0, 0, 0, 0,
1979     0, 0, 0, 0, 0, 0, 0, 0, 0),
1980     (379, 428, 653, 646, 284, 436, 308, 237,
1981     0, 0, 0, 0, 0, 0, 0, 0,
1982     0, 0, 0, 0, 0, 0, 0, 0,
1983     0, 0, 0, 0, 0, 0, 0, 0,
1984     0, 0, 0, 0, 0, 0, 0, 0,
1985     0, 0, 0, 0, 0, 0, 0, 0,
1986     0, 0, 0, 0, 0, 0, 0, 0,
1987     0, 0, 0, 0, 0, 0, 0, 0, 0),
1988     (205, 441, 501, 362, 289, 257, 622, 527,
1989     567, 0, 0, 0, 0, 0, 0, 0,
1990     0, 0, 0, 0, 0, 0, 0, 0,
1991     0, 0, 0, 0, 0, 0, 0, 0,
1992     0, 0, 0, 0, 0, 0, 0, 0,
1993     0, 0, 0, 0, 0, 0, 0, 0,
1994     0, 0, 0, 0, 0, 0, 0, 0,
1995     0, 0, 0, 0, 0, 0, 0, 0, 0),
1996     (612, 266, 691, 818, 841, 826, 244, 64,
1997     457, 377, 0, 0, 0, 0, 0, 0,
1998     0, 0, 0, 0, 0, 0, 0, 0,
1999     0, 0, 0, 0, 0, 0, 0, 0,
2000     0, 0, 0, 0, 0, 0, 0, 0,
2001     0, 0, 0, 0, 0, 0, 0, 0,
2002     0, 0, 0, 0, 0, 0, 0, 0,
2003     0, 0, 0, 0, 0, 0, 0, 0, 0),
2004     (904, 602, 327, 68, 15, 213, 825, 708,
2005     565, 45, 462, 0, 0, 0, 0, 0,
2006     0, 0, 0, 0, 0, 0, 0, 0,
2007     0, 0, 0, 0, 0, 0, 0, 0,
2008     0, 0, 0, 0, 0, 0, 0, 0,
2009     0, 0, 0, 0, 0, 0, 0, 0,
2010     0, 0, 0, 0, 0, 0, 0, 0,
2011     0, 0, 0, 0, 0, 0, 0, 0, 0),
2012     (851, 69, 7, 388, 127, 347, 684, 646,
2013     201, 757, 864, 597, 0, 0, 0, 0,
2014     0, 0, 0, 0, 0, 0, 0, 0,
2015     0, 0, 0, 0, 0, 0, 0, 0,
2016     0, 0, 0, 0, 0, 0, 0, 0,
2017     0, 0, 0, 0, 0, 0, 0, 0,
2018     0, 0, 0, 0, 0, 0, 0, 0,
2019     0, 0, 0, 0, 0, 0, 0, 0, 0),
2020     (692, 394, 184, 204, 678, 592, 322, 583,
2021     606, 384, 342, 713, 764, 0, 0, 0,
2022     0, 0, 0, 0, 0, 0, 0, 0,
2023     0, 0, 0, 0, 0, 0, 0, 0,
2024     0, 0, 0, 0, 0, 0, 0, 0,
2025     0, 0, 0, 0, 0, 0, 0, 0,
2026     0, 0, 0, 0, 0, 0, 0, 0,
2027     0, 0, 0, 0, 0, 0, 0, 0, 0),
2028     (215, 105, 833, 691, 915, 478, 354, 274,
2029     286, 241, 187, 154, 677, 669, 0, 0,
2030     0, 0, 0, 0, 0, 0, 0, 0,
2031     0, 0, 0, 0, 0, 0, 0, 0,
2032     0, 0, 0, 0, 0, 0, 0, 0,
2033     0, 0, 0, 0, 0, 0, 0, 0,
2034     0, 0, 0, 0, 0, 0, 0, 0,
2035     0, 0, 0, 0, 0, 0, 0, 0, 0),
2036     (642, 868, 147, 575, 550, 74, 80, 5,
2037     230, 664, 904, 109, 476, 829, 460, 0,
2038     0, 0, 0, 0, 0, 0, 0, 0,
2039     0, 0, 0, 0, 0, 0, 0, 0,
2040     0, 0, 0, 0, 0, 0, 0, 0,
2041     0, 0, 0, 0, 0, 0, 0, 0,
2042     0, 0, 0, 0, 0, 0, 0, 0,
2043     0, 0, 0, 0, 0, 0, 0, 0, 0),
2044     ( 65, 176, 42, 295, 428, 442, 116, 295,
2045     132, 801, 524, 599, 755, 232, 562, 274,
2046     0, 0, 0, 0, 0, 0, 0, 0,
2047     0, 0, 0, 0, 0, 0, 0, 0,
2048     0, 0, 0, 0, 0, 0, 0, 0,
2049     0, 0, 0, 0, 0, 0, 0, 0,
2050     0, 0, 0, 0, 0, 0, 0, 0,
2051     0, 0, 0, 0, 0, 0, 0, 0, 0),
2052     (192, 70, 98, 55, 733, 916, 510, 163,
2053     437, 843, 61, 259, 650, 430, 298, 115,
2054     425, 0, 0, 0, 0, 0, 0, 0,
2055     0, 0, 0, 0, 0, 0, 0, 0,
2056     0, 0, 0, 0, 0, 0, 0, 0,
2057     0, 0, 0, 0, 0, 0, 0, 0,
2058     0, 0, 0, 0, 0, 0, 0, 0,
2059     0, 0, 0, 0, 0, 0, 0, 0, 0),
2060     (573, 760, 756, 233, 321, 560, 202, 312,
2061     297, 120, 739, 275, 855, 37, 624, 315,
2062     577, 279, 0, 0, 0, 0, 0, 0,
2063     0, 0, 0, 0, 0, 0, 0, 0,
2064     0, 0, 0, 0, 0, 0, 0, 0,
2065     0, 0, 0, 0, 0, 0, 0, 0,
2066     0, 0, 0, 0, 0, 0, 0, 0,
2067     0, 0, 0, 0, 0, 0, 0, 0, 0),
2068     (787, 754, 821, 371, 17, 508, 201, 806,
2069     177, 506, 407, 491, 249, 923, 181, 75,
2070     170, 200, 250, 0, 0, 0, 0, 0,
2071     0, 0, 0, 0, 0, 0, 0, 0,
2072     0, 0, 0, 0, 0, 0, 0, 0,
2073     0, 0, 0, 0, 0, 0, 0, 0,
2074     0, 0, 0, 0, 0, 0, 0, 0,
2075     0, 0, 0, 0, 0, 0, 0, 0, 0),
2076     (500, 632, 880, 710, 375, 274, 258, 717,
2077     176, 802, 109, 736, 540, 64, 45, 152,
2078     12, 647, 448, 712, 0, 0, 0, 0,
2079     0, 0, 0, 0, 0, 0, 0, 0,
2080     0, 0, 0, 0, 0, 0, 0, 0,
2081     0, 0, 0, 0, 0, 0, 0, 0,
2082     0, 0, 0, 0, 0, 0, 0, 0,
2083     0, 0, 0, 0, 0, 0, 0, 0, 0),
2084     (568, 259, 193, 165, 347, 691, 310, 610,
2085     624, 693, 763, 716, 422, 553, 681, 425,
2086     129, 534, 781, 519, 108, 0, 0, 0,
2087     0, 0, 0, 0, 0, 0, 0, 0,
2088     0, 0, 0, 0, 0, 0, 0, 0,
2089     0, 0, 0, 0, 0, 0, 0, 0,
2090     0, 0, 0, 0, 0, 0, 0, 0,
2091     0, 0, 0, 0, 0, 0, 0, 0, 0),
2092     (772, 6, 76, 519, 563, 875, 66, 678,
2093     578, 716, 927, 296, 633, 244, 155, 928,
2094     432, 838, 95, 55, 78, 665, 0, 0,
2095     0, 0, 0, 0, 0, 0, 0, 0,
2096     0, 0, 0, 0, 0, 0, 0, 0,
2097     0, 0, 0, 0, 0, 0, 0, 0,
2098     0, 0, 0, 0, 0, 0, 0, 0,
2099     0, 0, 0, 0, 0, 0, 0, 0, 0),
2100     (455, 538, 32, 581, 473, 772, 462, 194,
2101     251, 503, 631, 1, 630, 247, 843, 101,
2102     749, 457, 143, 597, 294, 93, 78, 0,
2103     0, 0, 0, 0, 0, 0, 0, 0,
2104     0, 0, 0, 0, 0, 0, 0, 0,
2105     0, 0, 0, 0, 0, 0, 0, 0,
2106     0, 0, 0, 0, 0, 0, 0, 0,
2107     0, 0, 0, 0, 0, 0, 0, 0, 0),
2108     (433, 747, 273, 806, 697, 585, 200, 249,
2109     628, 555, 713, 54, 608, 322, 54, 135,
2110     385, 701, 308, 238, 166, 128, 819, 142,
2111     0, 0, 0, 0, 0, 0, 0, 0,
2112     0, 0, 0, 0, 0, 0, 0, 0,
2113     0, 0, 0, 0, 0, 0, 0, 0,
2114     0, 0, 0, 0, 0, 0, 0, 0,
2115     0, 0, 0, 0, 0, 0, 0, 0, 0),
2116     (367, 39, 208, 439, 454, 104, 608, 55,
2117     916, 912, 314, 375, 760, 141, 169, 287,
2118     765, 374, 492, 348, 251, 320, 732, 899,
2119     847, 0, 0, 0, 0, 0, 0, 0,
2120     0, 0, 0, 0, 0, 0, 0, 0,
2121     0, 0, 0, 0, 0, 0, 0, 0,
2122     0, 0, 0, 0, 0, 0, 0, 0,
2123     0, 0, 0, 0, 0, 0, 0, 0, 0),
2124     (169, 764, 847, 131, 858, 325, 454, 441,
2125     245, 699, 893, 446, 830, 159, 121, 269,
2126     608, 331, 760, 477, 93, 788, 544, 887,
2127     284, 443, 0, 0, 0, 0, 0, 0,
2128     0, 0, 0, 0, 0, 0, 0, 0,
2129     0, 0, 0, 0, 0, 0, 0, 0,
2130     0, 0, 0, 0, 0, 0, 0, 0,
2131     0, 0, 0, 0, 0, 0, 0, 0, 0),
2132     (504, 710, 383, 531, 151, 694, 636, 175,
2133     269, 93, 21, 463, 671, 438, 433, 857,
2134     610, 560, 165, 531, 100, 357, 688, 114,
2135     149, 825, 694, 0, 0, 0, 0, 0,
2136     0, 0, 0, 0, 0, 0, 0, 0,
2137     0, 0, 0, 0, 0, 0, 0, 0,
2138     0, 0, 0, 0, 0, 0, 0, 0,
2139     0, 0, 0, 0, 0, 0, 0, 0, 0),
2140     (580, 925, 461, 840, 560, 93, 427, 203,
2141     563, 99, 586, 201, 557, 339, 277, 321,
2142     712, 470, 920, 65, 509, 525, 879, 378,
2143     452, 72, 222, 720, 0, 0, 0, 0,
2144     0, 0, 0, 0, 0, 0, 0, 0,
2145     0, 0, 0, 0, 0, 0, 0, 0,
2146     0, 0, 0, 0, 0, 0, 0, 0,
2147     0, 0, 0, 0, 0, 0, 0, 0, 0),
2148     (808, 318, 478, 42, 706, 500, 264, 14,
2149     397, 261, 862, 33, 864, 62, 462, 305,
2150     509, 231, 316, 800, 465, 452, 738, 126,
2151     239, 9, 845, 241, 656, 0, 0, 0,
2152     0, 0, 0, 0, 0, 0, 0, 0,
2153     0, 0, 0, 0, 0, 0, 0, 0,
2154     0, 0, 0, 0, 0, 0, 0, 0,
2155     0, 0, 0, 0, 0, 0, 0, 0, 0),
2156     (563, 235, 604, 915, 635, 324, 392, 364,
2157     683, 541, 89, 655, 211, 194, 136, 453,
2158     104, 12, 390, 487, 484, 794, 549, 471,
2159     26, 910, 498, 383, 138, 926, 0, 0,
2160     0, 0, 0, 0, 0, 0, 0, 0,
2161     0, 0, 0, 0, 0, 0, 0, 0,
2162     0, 0, 0, 0, 0, 0, 0, 0,
2163     0, 0, 0, 0, 0, 0, 0, 0, 0),
2164     (757, 764, 673, 108, 706, 886, 76, 234,
2165     695, 196, 66, 270, 8, 252, 612, 825,
2166     660, 679, 860, 898, 204, 861, 371, 142,
2167     358, 380, 528, 379, 120, 757, 347, 0,
2168     0, 0, 0, 0, 0, 0, 0, 0,
2169     0, 0, 0, 0, 0, 0, 0, 0,
2170     0, 0, 0, 0, 0, 0, 0, 0,
2171     0, 0, 0, 0, 0, 0, 0, 0, 0),
2172     (410, 63, 330, 685, 390, 231, 133, 803,
2173     320, 571, 800, 593, 147, 263, 494, 273,
2174     517, 193, 284, 687, 742, 677, 742, 536,
2175     321, 640, 586, 176, 525, 922, 575, 361,
2176     0, 0, 0, 0, 0, 0, 0, 0,
2177     0, 0, 0, 0, 0, 0, 0, 0,
2178     0, 0, 0, 0, 0, 0, 0, 0,
2179     0, 0, 0, 0, 0, 0, 0, 0, 0),
2180     ( 0, 0, 0, 0, 0, 0, 0, 0,
2181     0, 0, 0, 0, 0, 0, 0, 0,
2182     0, 0, 0, 0, 0, 0, 0, 0,
2183     0, 0, 0, 0, 0, 0, 0, 0,
2184     0, 0, 0, 0, 0, 0, 0, 0,
2185     0, 0, 0, 0, 0, 0, 0, 0,
2186     0, 0, 0, 0, 0, 0, 0, 0,
2187     0, 0, 0, 0, 0, 0, 0, 0, 0),
2188     ( 0, 0, 0, 0, 0, 0, 0, 0,
2189     0, 0, 0, 0, 0, 0, 0, 0,
2190     0, 0, 0, 0, 0, 0, 0, 0,
2191     0, 0, 0, 0, 0, 0, 0, 0,
2192     0, 0, 0, 0, 0, 0, 0, 0,
2193     0, 0, 0, 0, 0, 0, 0, 0,
2194     0, 0, 0, 0, 0, 0, 0, 0,
2195     0, 0, 0, 0, 0, 0, 0, 0, 0),
2196     ( 0, 0, 0, 0, 0, 0, 0, 0,
2197     0, 0, 0, 0, 0, 0, 0, 0,
2198     0, 0, 0, 0, 0, 0, 0, 0,
2199     0, 0, 0, 0, 0, 0, 0, 0,
2200     0, 0, 0, 0, 0, 0, 0, 0,
2201     0, 0, 0, 0, 0, 0, 0, 0,
2202     0, 0, 0, 0, 0, 0, 0, 0,
2203     0, 0, 0, 0, 0, 0, 0, 0, 0),
2204     (575, 871, 311, 454, 504, 870, 199, 768,
2205     634, 362, 548, 855, 529, 384, 830, 923,
2206     222, 85, 841, 59, 518, 590, 358, 110,
2207     695, 864, 699, 581, 642, 175, 836, 855,
2208     709, 274, 686, 244, 0, 0, 0, 0,
2209     0, 0, 0, 0, 0, 0, 0, 0,
2210     0, 0, 0, 0, 0, 0, 0, 0,
2211     0, 0, 0, 0, 0, 0, 0, 0, 0),
2212     ( 0, 0, 0, 0, 0, 0, 0, 0,
2213     0, 0, 0, 0, 0, 0, 0, 0,
2214     0, 0, 0, 0, 0, 0, 0, 0,
2215     0, 0, 0, 0, 0, 0, 0, 0,
2216     0, 0, 0, 0, 0, 0, 0, 0,
2217     0, 0, 0, 0, 0, 0, 0, 0,
2218     0, 0, 0, 0, 0, 0, 0, 0,
2219     0, 0, 0, 0, 0, 0, 0, 0, 0),
2220     ( 0, 0, 0, 0, 0, 0, 0, 0,
2221     0, 0, 0, 0, 0, 0, 0, 0,
2222     0, 0, 0, 0, 0, 0, 0, 0,
2223     0, 0, 0, 0, 0, 0, 0, 0,
2224     0, 0, 0, 0, 0, 0, 0, 0,
2225     0, 0, 0, 0, 0, 0, 0, 0,
2226     0, 0, 0, 0, 0, 0, 0, 0,
2227     0, 0, 0, 0, 0, 0, 0, 0, 0),
2228     ( 0, 0, 0, 0, 0, 0, 0, 0,
2229     0, 0, 0, 0, 0, 0, 0, 0,
2230     0, 0, 0, 0, 0, 0, 0, 0,
2231     0, 0, 0, 0, 0, 0, 0, 0,
2232     0, 0, 0, 0, 0, 0, 0, 0,
2233     0, 0, 0, 0, 0, 0, 0, 0,
2234     0, 0, 0, 0, 0, 0, 0, 0,
2235     0, 0, 0, 0, 0, 0, 0, 0, 0),
2236     ( 5, 10, 156, 729, 684, 324, 60, 264,
2237     99, 261, 89, 460, 742, 208, 699, 670,
2238     512, 404, 726, 389, 492, 287, 894, 571,
2239     41, 203, 353, 256, 243, 784, 385, 555,
2240     595, 734, 714, 565, 205, 706, 316, 115,
2241     0, 0, 0, 0, 0, 0, 0, 0,
2242     0, 0, 0, 0, 0, 0, 0, 0,
2243     0, 0, 0, 0, 0, 0, 0, 0, 0),
2244     ( 0, 0, 0, 0, 0, 0, 0, 0,
2245     0, 0, 0, 0, 0, 0, 0, 0,
2246     0, 0, 0, 0, 0, 0, 0, 0,
2247     0, 0, 0, 0, 0, 0, 0, 0,
2248     0, 0, 0, 0, 0, 0, 0, 0,
2249     0, 0, 0, 0, 0, 0, 0, 0,
2250     0, 0, 0, 0, 0, 0, 0, 0,
2251     0, 0, 0, 0, 0, 0, 0, 0, 0),
2252     ( 0, 0, 0, 0, 0, 0, 0, 0,
2253     0, 0, 0, 0, 0, 0, 0, 0,
2254     0, 0, 0, 0, 0, 0, 0, 0,
2255     0, 0, 0, 0, 0, 0, 0, 0,
2256     0, 0, 0, 0, 0, 0, 0, 0,
2257     0, 0, 0, 0, 0, 0, 0, 0,
2258     0, 0, 0, 0, 0, 0, 0, 0,
2259     0, 0, 0, 0, 0, 0, 0, 0, 0),
2260     ( 0, 0, 0, 0, 0, 0, 0, 0,
2261     0, 0, 0, 0, 0, 0, 0, 0,
2262     0, 0, 0, 0, 0, 0, 0, 0,
2263     0, 0, 0, 0, 0, 0, 0, 0,
2264     0, 0, 0, 0, 0, 0, 0, 0,
2265     0, 0, 0, 0, 0, 0, 0, 0,
2266     0, 0, 0, 0, 0, 0, 0, 0,
2267     0, 0, 0, 0, 0, 0, 0, 0, 0),
2268     (285, 82, 730, 339, 436, 572, 271, 103,
2269     758, 231, 560, 31, 213, 272, 267, 569,
2270     773, 3, 21, 446, 706, 413, 97, 376,
2271     60, 714, 436, 417, 405, 632, 25, 109,
2272     876, 470, 915, 157, 840, 764, 64, 678,
2273     848, 659, 36, 476, 0, 0, 0, 0,
2274     0, 0, 0, 0, 0, 0, 0, 0,
2275     0, 0, 0, 0, 0, 0, 0, 0, 0),
2276     ( 0, 0, 0, 0, 0, 0, 0, 0,
2277     0, 0, 0, 0, 0, 0, 0, 0,
2278     0, 0, 0, 0, 0, 0, 0, 0,
2279     0, 0, 0, 0, 0, 0, 0, 0,
2280     0, 0, 0, 0, 0, 0, 0, 0,
2281     0, 0, 0, 0, 0, 0, 0, 0,
2282     0, 0, 0, 0, 0, 0, 0, 0,
2283     0, 0, 0, 0, 0, 0, 0, 0, 0),
2284     ( 0, 0, 0, 0, 0, 0, 0, 0,
2285     0, 0, 0, 0, 0, 0, 0, 0,
2286     0, 0, 0, 0, 0, 0, 0, 0,
2287     0, 0, 0, 0, 0, 0, 0, 0,
2288     0, 0, 0, 0, 0, 0, 0, 0,
2289     0, 0, 0, 0, 0, 0, 0, 0,
2290     0, 0, 0, 0, 0, 0, 0, 0,
2291     0, 0, 0, 0, 0, 0, 0, 0, 0),
2292     ( 0, 0, 0, 0, 0, 0, 0, 0,
2293     0, 0, 0, 0, 0, 0, 0, 0,
2294     0, 0, 0, 0, 0, 0, 0, 0,
2295     0, 0, 0, 0, 0, 0, 0, 0,
2296     0, 0, 0, 0, 0, 0, 0, 0,
2297     0, 0, 0, 0, 0, 0, 0, 0,
2298     0, 0, 0, 0, 0, 0, 0, 0,
2299     0, 0, 0, 0, 0, 0, 0, 0, 0),
2300     (669, 912, 896, 252, 338, 162, 414, 632,
2301     626, 252, 869, 185, 444, 82, 920, 783,
2302     565, 875, 126, 877, 524, 603, 189, 136,
2303     373, 540, 649, 271, 836, 540, 199, 323,
2304     888, 486, 92, 849, 162, 701, 178, 926,
2305     498, 575, 765, 422, 450, 302, 354, 710,
2306     0, 0, 0, 0, 0, 0, 0, 0,
2307     0, 0, 0, 0, 0, 0, 0, 0, 0),
2308     ( 0, 0, 0, 0, 0, 0, 0, 0,
2309     0, 0, 0, 0, 0, 0, 0, 0,
2310     0, 0, 0, 0, 0, 0, 0, 0,
2311     0, 0, 0, 0, 0, 0, 0, 0,
2312     0, 0, 0, 0, 0, 0, 0, 0,
2313     0, 0, 0, 0, 0, 0, 0, 0,
2314     0, 0, 0, 0, 0, 0, 0, 0,
2315     0, 0, 0, 0, 0, 0, 0, 0, 0),
2316     ( 0, 0, 0, 0, 0, 0, 0, 0,
2317     0, 0, 0, 0, 0, 0, 0, 0,
2318     0, 0, 0, 0, 0, 0, 0, 0,
2319     0, 0, 0, 0, 0, 0, 0, 0,
2320     0, 0, 0, 0, 0, 0, 0, 0,
2321     0, 0, 0, 0, 0, 0, 0, 0,
2322     0, 0, 0, 0, 0, 0, 0, 0,
2323     0, 0, 0, 0, 0, 0, 0, 0, 0),
2324     ( 0, 0, 0, 0, 0, 0, 0, 0,
2325     0, 0, 0, 0, 0, 0, 0, 0,
2326     0, 0, 0, 0, 0, 0, 0, 0,
2327     0, 0, 0, 0, 0, 0, 0, 0,
2328     0, 0, 0, 0, 0, 0, 0, 0,
2329     0, 0, 0, 0, 0, 0, 0, 0,
2330     0, 0, 0, 0, 0, 0, 0, 0,
2331     0, 0, 0, 0, 0, 0, 0, 0, 0),
2332     (187, 57, 15, 317, 835, 593, 8, 158,
2333     95, 145, 37, 659, 576, 386, 884, 913,
2334     495, 869, 908, 296, 437, 215, 33, 883,
2335     877, 477, 712, 578, 349, 13, 174, 839,
2336     914, 107, 260, 40, 532, 210, 395, 905,
2337     163, 785, 693, 627, 393, 687, 112, 481,
2338     717, 297, 37, 483, 0, 0, 0, 0,
2339     0, 0, 0, 0, 0, 0, 0, 0, 0),
2340     ( 0, 0, 0, 0, 0, 0, 0, 0,
2341     0, 0, 0, 0, 0, 0, 0, 0,
2342     0, 0, 0, 0, 0, 0, 0, 0,
2343     0, 0, 0, 0, 0, 0, 0, 0,
2344     0, 0, 0, 0, 0, 0, 0, 0,
2345     0, 0, 0, 0, 0, 0, 0, 0,
2346     0, 0, 0, 0, 0, 0, 0, 0,
2347     0, 0, 0, 0, 0, 0, 0, 0, 0),
2348     ( 0, 0, 0, 0, 0, 0, 0, 0,
2349     0, 0, 0, 0, 0, 0, 0, 0,
2350     0, 0, 0, 0, 0, 0, 0, 0,
2351     0, 0, 0, 0, 0, 0, 0, 0,
2352     0, 0, 0, 0, 0, 0, 0, 0,
2353     0, 0, 0, 0, 0, 0, 0, 0,
2354     0, 0, 0, 0, 0, 0, 0, 0,
2355     0, 0, 0, 0, 0, 0, 0, 0, 0),
2356     ( 0, 0, 0, 0, 0, 0, 0, 0,
2357     0, 0, 0, 0, 0, 0, 0, 0,
2358     0, 0, 0, 0, 0, 0, 0, 0,
2359     0, 0, 0, 0, 0, 0, 0, 0,
2360     0, 0, 0, 0, 0, 0, 0, 0,
2361     0, 0, 0, 0, 0, 0, 0, 0,
2362     0, 0, 0, 0, 0, 0, 0, 0,
2363     0, 0, 0, 0, 0, 0, 0, 0, 0),
2364     (163, 726, 626, 653, 414, 537, 467, 579,
2365     729, 396, 142, 598, 860, 774, 518, 461,
2366     136, 687, 827, 614, 841, 468, 207, 481,
2367     649, 910, 497, 686, 186, 235, 845, 863,
2368     821, 711, 663, 534, 393, 756, 467, 224,
2369     442, 520, 210, 732, 864, 729, 433, 735,
2370     70, 184, 278, 97, 492, 17, 2, 338,
2371     0, 0, 0, 0, 0, 0, 0, 0, 0),
2372     ( 0, 0, 0, 0, 0, 0, 0, 0,
2373     0, 0, 0, 0, 0, 0, 0, 0,
2374     0, 0, 0, 0, 0, 0, 0, 0,
2375     0, 0, 0, 0, 0, 0, 0, 0,
2376     0, 0, 0, 0, 0, 0, 0, 0,
2377     0, 0, 0, 0, 0, 0, 0, 0,
2378     0, 0, 0, 0, 0, 0, 0, 0,
2379     0, 0, 0, 0, 0, 0, 0, 0, 0),
2380     ( 0, 0, 0, 0, 0, 0, 0, 0,
2381     0, 0, 0, 0, 0, 0, 0, 0,
2382     0, 0, 0, 0, 0, 0, 0, 0,
2383     0, 0, 0, 0, 0, 0, 0, 0,
2384     0, 0, 0, 0, 0, 0, 0, 0,
2385     0, 0, 0, 0, 0, 0, 0, 0,
2386     0, 0, 0, 0, 0, 0, 0, 0,
2387     0, 0, 0, 0, 0, 0, 0, 0, 0),
2388     ( 0, 0, 0, 0, 0, 0, 0, 0,
2389     0, 0, 0, 0, 0, 0, 0, 0,
2390     0, 0, 0, 0, 0, 0, 0, 0,
2391     0, 0, 0, 0, 0, 0, 0, 0,
2392     0, 0, 0, 0, 0, 0, 0, 0,
2393     0, 0, 0, 0, 0, 0, 0, 0,
2394     0, 0, 0, 0, 0, 0, 0, 0,
2395     0, 0, 0, 0, 0, 0, 0, 0, 0),
2396     ( 77, 611, 467, 704, 555, 579, 802, 773,
2397     303, 518, 560, 196, 314, 102, 5, 845,
2398     248, 125, 836, 923, 88, 630, 886, 619,
2399     37, 141, 409, 229, 77, 658, 450, 449,
2400     93, 651, 276, 501, 166, 75, 630, 701,
2401     388, 72, 830, 166, 187, 131, 711, 577,
2402     834, 147, 361, 517, 76, 581, 45, 495,
2403     366, 278, 781, 61, 0, 0, 0, 0, 0),
2404     ( 0, 0, 0, 0, 0, 0, 0, 0,
2405     0, 0, 0, 0, 0, 0, 0, 0,
2406     0, 0, 0, 0, 0, 0, 0, 0,
2407     0, 0, 0, 0, 0, 0, 0, 0,
2408     0, 0, 0, 0, 0, 0, 0, 0,
2409     0, 0, 0, 0, 0, 0, 0, 0,
2410     0, 0, 0, 0, 0, 0, 0, 0,
2411     0, 0, 0, 0, 0, 0, 0, 0, 0),
2412     ( 0, 0, 0, 0, 0, 0, 0, 0,
2413     0, 0, 0, 0, 0, 0, 0, 0,
2414     0, 0, 0, 0, 0, 0, 0, 0,
2415     0, 0, 0, 0, 0, 0, 0, 0,
2416     0, 0, 0, 0, 0, 0, 0, 0,
2417     0, 0, 0, 0, 0, 0, 0, 0,
2418     0, 0, 0, 0, 0, 0, 0, 0,
2419     0, 0, 0, 0, 0, 0, 0, 0, 0),
2420     ( 0, 0, 0, 0, 0, 0, 0, 0,
2421     0, 0, 0, 0, 0, 0, 0, 0,
2422     0, 0, 0, 0, 0, 0, 0, 0,
2423     0, 0, 0, 0, 0, 0, 0, 0,
2424     0, 0, 0, 0, 0, 0, 0, 0,
2425     0, 0, 0, 0, 0, 0, 0, 0,
2426     0, 0, 0, 0, 0, 0, 0, 0,
2427     0, 0, 0, 0, 0, 0, 0, 0, 0),
2428     (543, 264, 623, 843, 381, 4, 629, 840,
2429     771, 280, 97, 404, 83, 717, 733, 648,
2430     502, 488, 201, 651, 158, 605, 352, 517,
2431     535, 225, 594, 460, 31, 519, 35, 440,
2432     184, 283, 762, 672, 400, 511, 376, 543,
2433     822, 858, 609, 430, 172, 462, 476, 723,
2434     612, 381, 877, 733, 505, 107, 287, 610,
2435     106, 453, 771, 862, 93, 6, 422, 539, 0));
2436    
2437     StMods128 : array [0..127] of Integer =
2438     (521, 310, 864, 547, 858, 580, 296, 379,
2439     53, 779, 897, 444, 400, 925, 749, 415,
2440     822, 93, 217, 208, 928, 244, 583, 620,
2441     246, 148, 447, 631, 292, 908, 490, 704,
2442     516, 258, 457, 907, 594, 723, 674, 292,
2443     272, 96, 684, 432, 686, 606, 860, 569,
2444     193, 219, 129, 186, 236, 287, 192, 775,
2445     278, 173, 40, 379, 712, 463, 646, 776,
2446     171, 491, 297, 763, 156, 732, 95, 270,
2447     447, 90, 507, 48, 228, 821, 808, 898,
2448     784, 663, 627, 378, 382, 262, 380, 602,
2449     754, 336, 89, 614, 87, 432, 670, 616,
2450     157, 374, 242, 726, 600, 269, 375, 898,
2451     845, 454, 354, 130, 814, 587, 804, 34,
2452     211, 330, 539, 297, 827, 865, 37, 517,
2453     834, 315, 550, 86, 801, 4, 108, 539);
2454    
2455     StMods256 : array [0..255] of Integer =
2456     (524, 894, 75, 766, 882, 857, 74, 204,
2457     82, 586, 708, 250, 905, 786, 138, 720,
2458     858, 194, 311, 913, 275, 190, 375, 850,
2459     438, 733, 194, 280, 201, 280, 828, 757,
2460     710, 814, 919, 89, 68, 569, 11, 204,
2461     796, 605, 540, 913, 801, 700, 799, 137,
2462     439, 418, 592, 668, 353, 859, 370, 694,
2463     325, 240, 216, 257, 284, 549, 209, 884,
2464     315, 70, 329, 793, 490, 274, 877, 162,
2465     749, 812, 684, 461, 334, 376, 849, 521,
2466     307, 291, 803, 712, 19, 358, 399, 908,
2467     103, 511, 51, 8, 517, 225, 289, 470,
2468     637, 731, 66, 255, 917, 269, 463, 830,
2469     730, 433, 848, 585, 136, 538, 906, 90,
2470     2, 290, 743, 199, 655, 903, 329, 49,
2471     802, 580, 355, 588, 188, 462, 10, 134,
2472     628, 320, 479, 130, 739, 71, 263, 318,
2473     374, 601, 192, 605, 142, 673, 687, 234,
2474     722, 384, 177, 752, 607, 640, 455, 193,
2475     689, 707, 805, 641, 48, 60, 732, 621,
2476     895, 544, 261, 852, 655, 309, 697, 755,
2477     756, 60, 231, 773, 434, 421, 726, 528,
2478     503, 118, 49, 795, 32, 144, 500, 238,
2479     836, 394, 280, 566, 319, 9, 647, 550,
2480     73, 914, 342, 126, 32, 681, 331, 792,
2481     620, 60, 609, 441, 180, 791, 893, 754,
2482     605, 383, 228, 749, 760, 213, 54, 297,
2483     134, 54, 834, 299, 922, 191, 910, 532,
2484     609, 829, 189, 20, 167, 29, 872, 449,
2485     83, 402, 41, 656, 505, 579, 481, 173,
2486     404, 251, 688, 95, 497, 555, 642, 543,
2487     307, 159, 924, 558, 648, 55, 497, 10);
2488    
2489     StMods512 : array [0..511] of Integer =
2490     (352, 77, 373, 504, 35, 599, 428, 207,
2491     409, 574, 118, 498, 285, 380, 350, 492,
2492     197, 265, 920, 155, 914, 299, 229, 643,
2493     294, 871, 306, 88, 87, 193, 352, 781,
2494     846, 75, 327, 520, 435, 543, 203, 666,
2495     249, 346, 781, 621, 640, 268, 794, 534,
2496     539, 781, 408, 390, 644, 102, 476, 499,
2497     290, 632, 545, 37, 858, 916, 552, 41,
2498     542, 289, 122, 272, 383, 800, 485, 98,
2499     752, 472, 761, 107, 784, 860, 658, 741,
2500     290, 204, 681, 407, 855, 85, 99, 62,
2501     482, 180, 20, 297, 451, 593, 913, 142,
2502     808, 684, 287, 536, 561, 76, 653, 899,
2503     729, 567, 744, 390, 513, 192, 516, 258,
2504     240, 518, 794, 395, 768, 848, 51, 610,
2505     384, 168, 190, 826, 328, 596, 786, 303,
2506     570, 381, 415, 641, 156, 237, 151, 429,
2507     531, 207, 676, 710, 89, 168, 304, 402,
2508     40, 708, 575, 162, 864, 229, 65, 861,
2509     841, 512, 164, 477, 221, 92, 358, 785,
2510     288, 357, 850, 836, 827, 736, 707, 94,
2511     8, 494, 114, 521, 2, 499, 851, 543,
2512     152, 729, 771, 95, 248, 361, 578, 323,
2513     856, 797, 289, 51, 684, 466, 533, 820,
2514     669, 45, 902, 452, 167, 342, 244, 173,
2515     35, 463, 651, 51, 699, 591, 452, 578,
2516     37, 124, 298, 332, 552, 43, 427, 119,
2517     662, 777, 475, 850, 764, 364, 578, 911,
2518     283, 711, 472, 420, 245, 288, 594, 394,
2519     511, 327, 589, 777, 699, 688, 43, 408,
2520     842, 383, 721, 521, 560, 644, 714, 559,
2521     62, 145, 873, 663, 713, 159, 672, 729,
2522     624, 59, 193, 417, 158, 209, 563, 564,
2523     343, 693, 109, 608, 563, 365, 181, 772,
2524     677, 310, 248, 353, 708, 410, 579, 870,
2525     617, 841, 632, 860, 289, 536, 35, 777,
2526     618, 586, 424, 833, 77, 597, 346, 269,
2527     757, 632, 695, 751, 331, 247, 184, 45,
2528     787, 680, 18, 66, 407, 369, 54, 492,
2529     228, 613, 830, 922, 437, 519, 644, 905,
2530     789, 420, 305, 441, 207, 300, 892, 827,
2531     141, 537, 381, 662, 513, 56, 252, 341,
2532     242, 797, 838, 837, 720, 224, 307, 631,
2533     61, 87, 560, 310, 756, 665, 397, 808,
2534     851, 309, 473, 795, 378, 31, 647, 915,
2535     459, 806, 590, 731, 425, 216, 548, 249,
2536     321, 881, 699, 535, 673, 782, 210, 815,
2537     905, 303, 843, 922, 281, 73, 469, 791,
2538     660, 162, 498, 308, 155, 422, 907, 817,
2539     187, 62, 16, 425, 535, 336, 286, 437,
2540     375, 273, 610, 296, 183, 923, 116, 667,
2541     751, 353, 62, 366, 691, 379, 687, 842,
2542     37, 357, 720, 742, 330, 5, 39, 923,
2543     311, 424, 242, 749, 321, 54, 669, 316,
2544     342, 299, 534, 105, 667, 488, 640, 672,
2545     576, 540, 316, 486, 721, 610, 46, 656,
2546     447, 171, 616, 464, 190, 531, 297, 321,
2547     762, 752, 533, 175, 134, 14, 381, 433,
2548     717, 45, 111, 20, 596, 284, 736, 138,
2549     646, 411, 877, 669, 141, 919, 45, 780,
2550     407, 164, 332, 899, 165, 726, 600, 325,
2551     498, 655, 357, 752, 768, 223, 849, 647,
2552     63, 310, 863, 251, 366, 304, 282, 738,
2553     675, 410, 389, 244, 31, 121, 303, 263);
2554    
2555     var
2556     BaseReg : array [0..800] of DWord;
2557     CoeffReg : array [0..800] of DWord;
2558     i : Integer;
2559     j : Integer;
2560     TInt : Integer;
2561     Temp : DWord;
2562     Wrap : DWord;
2563    
2564     begin
2565     if ECClen < 128 then
2566     for i := 0 to ECCLen - 1 do
2567     CoeffReg[i] := StMods[ECClen][i]
2568     else begin
2569     if ECClen = 128 then
2570     for i := 0 to ECCLen - 1 do
2571     CoeffReg[i] := StMods128[i]
2572     else if ECClen = 256 then
2573     for i := 0 to ECCLen - 1 do
2574     CoeffReg[i] := StMods256[i]
2575     else if ECClen = 512 then
2576     for i := 0 to ECCLen - 1 do
2577     CoeffReg[i] := StMods512[i];
2578     end;
2579    
2580     for i := 0 to ECCLen - 1 do
2581     BaseReg[i] := 0;
2582    
2583     for i := NumCodewords to NumCodewords + ECCLen - 1 do
2584     FCodewords[i] := 0;
2585    
2586     for i := 0 to NumCodewords - 1 do begin
2587     wrap := (BaseReg[ECClen - 1] + FCodewords[i]) mod 929;
2588     for j := ECCLen - 1 downto 1 do begin
2589     temp := (CoeffReg[ECClen - 1 - j] * wrap) mod 929;
2590     temp := (929 - temp) mod 929;
2591     BaseReg[j] := (BaseReg[j - 1] + temp) mod 929;
2592     end;
2593     temp := (CoeffReg[ECClen - 1] * wrap) mod 929;
2594     temp := (929 - temp) mod 929;
2595     BaseReg[0]:= temp;
2596     end;
2597    
2598     for j := 0 to ECCLen - 1 do
2599     BaseReg[j] := (929 - BaseReg[j]) mod 929;
2600    
2601     for j := 0 to ECCLen - 1 do begin
2602     tint := BaseReg[ECClen - 1 - j];
2603     FCodewords [NumCodewords + j] := tint;
2604     end;
2605     end;
2606    
2607     procedure TStPDF417Barcode.CalculateSize (var XSize : Integer;
2608     var YSize : Integer);
2609     var
2610     i : Integer;
2611     NumErrorCodewords : Integer;
2612     ErrorLevel : Integer;
2613     j : Integer;
2614    
2615     begin
2616     { Set the error correction level automatically if needed }
2617     ErrorLevel := GetRealErrorLevel;
2618    
2619     NumErrorCodewords := Trunc (Power (2, ErrorLevel + 1));
2620    
2621     XSize := NumColumns;
2622     YSize := NumRows;
2623    
2624     FTotalCodewords := XSize * YSize;
2625    
2626     { Adjust the size if necessary }
2627     if (NumRows <= 0) or (NumColumns <= 0) then begin
2628     if NumRows > 0 then begin
2629     i := 1;
2630     while i <= 30 do begin
2631     if i * NumRows - NumErrorCodewords > FNumCodewords then
2632     Break;
2633     Inc (i);
2634     end;
2635     FTotalCodewords := YSize * 30;
2636     XSize := i;
2637     end else if NumColumns > 0 then begin
2638     i := 3;
2639     while i <= 90 do begin
2640     if i * NumColumns - NumErrorCodewords > FNumCodewords then
2641     Break;
2642     Inc (i);
2643     end;
2644     YSize := i;
2645     FTotalCodewords := XSize * 90;
2646     end else begin
2647     i := 1;
2648     j := 3;
2649     while (i * j - NumErrorCodewords < FNumCodewords) do begin
2650     if j < 90 then
2651     Inc (j);
2652     if (i < 30) and (i * j - NumErrorCodewords < FNumCodewords) then
2653     Inc (i);
2654     if (j >= 90) and (i >= 30) then
2655     Break;
2656     end;
2657     XSize := i;
2658     YSize := J;
2659     FTotalCodewords := 900;
2660     end;
2661     end;
2662     end;
2663    
2664     function TStPDF417Barcode.CodewordToBitmask (RowNumber : Integer;
2665     Codeword : Integer) : DWord;
2666     begin
2667     if (Codeword < 0) or (CodeWord > 929) then
2668     raise E2DBarcodeError.Create (StEInvalidCodeword);
2669     Result := StPDF417Codewords[RowNumber mod 3][Codeword];
2670     end;
2671    
2672     procedure TStPDF417Barcode.ConvertBytesToBase900 (const S : array of Byte;
2673     var A : array of Integer);
2674     var
2675     i : Integer;
2676     D : array [0..5] of Byte;
2677     Dividend : Integer;
2678     Digits : array [0..4] of Integer;
2679     SP : Integer;
2680    
2681     begin
2682     // Assert(length(S) = 6,
2683     // 'ConvertBytesToBase900: there should be 6 bytes in the input byte array');
2684     // Assert(length(A) = 5,
2685     // 'ConvertBytesToBase900: there should be 5 elements in the output digit array');
2686    
2687     {copy the array of bytes}
2688     for i := 0 to 5 do
2689     D[i] := S[i];
2690    
2691     {loop until the entire base 256 value has been converted to an array
2692     of base 900 digits (6 base 256 digits will convert to 5 base 900
2693     digits)}
2694     SP := 0;
2695     while (SP < 5) do begin
2696     Dividend := 0;
2697     for i := 0 to 5 do begin
2698     {notes: at the start of the loop, Dividend will always be in the
2699     range 0..899--it starts out as zero and the final
2700     statement in the loop forces it into that range
2701     the first calculation sets Dividend to 0..230399
2702     the second calc sets D[i] to 0..255 (with no possibility
2703     of overflow)
2704     the third calc sets Dividend to 0..899 again}
2705     Dividend := (Dividend shl 8) + D[i];
2706     D[i] := Dividend div 900;
2707     Dividend := Dividend mod 900;
2708     end;
2709    
2710     Digits[SP] := Dividend;
2711     inc(SP);
2712     end;
2713    
2714     {pop the base 900 digits and enter them into the array of integers}
2715     i := 0;
2716     while (SP > 0) do begin
2717     dec(SP);
2718     A[i] := Digits[SP];
2719     inc(i);
2720     end;
2721     end;
2722    
2723     procedure TStPDF417Barcode.ConvertToBase900 (const S : string;
2724     var A : array of Integer;
2725     var LenA : Integer);
2726     var
2727     D : string;
2728     i : Integer;
2729     LenD : Integer;
2730     Dividend : Integer;
2731     Rem : Integer;
2732     Done : Boolean;
2733     FirstDigit : Integer;
2734     Digits : array [0..14] of Integer;
2735     // 15 base 900 digits = 45 base 10 digits
2736     SP : Integer;
2737    
2738     begin
2739     {Assert: S must be non-empty
2740     it must contain just the ASCII characters '0' to '9' (so no
2741     leading/trailing spaces either)
2742     it must have a maximum length of 45}
2743     Assert(IsNumericString(S), 'ConvertToBase900: S should be a numeric string');
2744    
2745     {grab the string and calculate its length}
2746     D := S;
2747     LenD := length(D);
2748    
2749     {convert the string from ASCII characters into binary digits and in
2750     the process calculate the first non-zero digit}
2751     FirstDigit := 0;
2752     for i := LenD downto 1 do begin
2753     D[i] := char(ord(D[i]) - ord('0'));
2754     if (D[i] <> #0) then
2755     FirstDigit := i;
2756     end;
2757    
2758     {if the input string comprises just zero digits, return}
2759     if (FirstDigit = 0) then begin
2760     LenA := 0;
2761     Exit;
2762     end;
2763    
2764     {prepare the stack of base 900 digits}
2765     SP := 0;
2766    
2767     {loop until the entire base 10 string has been converted to an array
2768     of base 900 digits}
2769     Done := false;
2770     while not Done do begin
2771    
2772     {if we can switch to using standard integer arithmetic, do so}
2773     if ((LenD - FirstDigit) <= 8) then begin
2774    
2775     {convert the remaining digits to a binary integer}
2776     Dividend := 0;
2777     for i := FirstDigit to LenD do
2778     Dividend := (Dividend * 10) + ord(D[i]);
2779    
2780     {calculate the remaining base 900 digits using the standard
2781     radix conversion algorithm; push onto the digit stack}
2782     while (Dividend <> 0) do begin
2783     Digits[SP] := Dividend mod 900;
2784     inc(SP);
2785     Dividend := Dividend div 900;
2786     end;
2787    
2788     {we've finished}
2789     Done := true;
2790     end
2791    
2792     {otherwise operate directly on the base 10 string}
2793     else begin
2794    
2795     {calculate the remainder base 100}
2796     Rem := ord(D[LenD]);
2797     dec(LenD);
2798     Rem := Rem + (ord(D[LenD]) * 10);
2799     dec(LenD);
2800    
2801     {calculate the quotient and remainder of the remaining digits,
2802     dividing by 9}
2803     Dividend := 0;
2804     for i := FirstDigit to LenD do begin
2805     Dividend := (Dividend * 10) + ord(D[i]);
2806     D[i] := char(Dividend div 9);
2807     Dividend := Dividend mod 9;
2808     end;
2809    
2810     {push the base 900 digit onto the stack: it's the remainder base
2811     9 multiplied by 100, plus the remainder base 100}
2812     Digits[SP] := (Dividend * 100) + Rem;
2813     inc(SP);
2814    
2815     {if the first digit is now zero, advance the index to the first
2816     non-zero digit}
2817     if (D[FirstDigit] = '0') then
2818     inc(FirstDigit);
2819     end;
2820     end;
2821    
2822     {pop the base 900 digits and enter them into the array of integers}
2823     i := 0;
2824     while (SP > 0) do begin
2825     dec(SP);
2826     A[i] := Digits[SP];
2827     inc(i);
2828     end;
2829     LenA := i;
2830     end;
2831    
2832     procedure TStPDF417Barcode.DrawBarcode;
2833     var
2834     XSize : Integer;
2835     YSize : Integer;
2836     i : Integer;
2837     j : Integer;
2838     WorkBarHeight : Integer;
2839     CodewordPos : Integer;
2840     ErrorLevel : Integer;
2841     NumErrorCodewords : Integer;
2842    
2843     const
2844     SymbolPadding = 900;
2845    
2846     begin
2847     { Set the error correction level automatically if needed }
2848     ErrorLevel := GetRealErrorLevel;
2849    
2850     NumErrorCodewords := Trunc (Power (2, ErrorLevel + 1));
2851    
2852     CalculateSize (XSize, YSize);
2853    
2854     { The first codewords is always the length }
2855     if FNumCodewords +
2856     (XSize * YSize - FNumCodewords - NumErrorCodewords) < 0 then
2857     raise E2DBarcodeError.Create (StECodeTooLarge);
2858     FCodewords[0] := FNumCodewords +
2859     (XSize * YSize - FNumCodewords - NumErrorCodewords);
2860    
2861     CodewordPos := 1; { The first codeword is always the length }
2862    
2863     WorkBarHeight := (BarCodeRect.Bottom - BarCodeRect.Top) div YSize;
2864    
2865     for i := 0 to YSize - 1 do begin
2866     if FHighlight then
2867     FBitmap.Canvas.Brush.Color := $ffbbff;
2868     DrawStartPattern (i, WorkBarHeight);
2869     if FHighlight then
2870     FBitmap.Canvas.Brush.Color := $ffffbb;
2871     DrawLeftRowIndicator (i, WorkBarHeight, YSize, XSize);
2872     for j := 0 to XSize - 1 do begin
2873     if (i = 0) and (j = 0) then begin
2874     if FHighlight then
2875     FBitmap.Canvas.Brush.Color := $bbffff;
2876     { Length }
2877     DrawCodeWordBitmask (i, j + 2, WorkBarHeight,
2878     CodeWordToBitmask (i, FNumCodewords +
2879     (XSize * YSize - FNumCodewords - NumErrorCodewords)))
2880     end else if CodewordPos < FNumCodewords then begin
2881     if FHighlight then
2882     FBitmap.Canvas.Brush.Color := $bbbbff;
2883     { Data }
2884     DrawCodeWordBitmask (i, j + 2, WorkBarHeight,
2885     CodewordToBitmask (i, FCodewords[CodewordPos]));
2886     Inc (CodewordPos);
2887     end else if CodewordPos >= XSize * YSize - NumErrorCodeWords then begin
2888     if FHighlight then
2889     FBitmap.Canvas.Brush.Color := $ffbbbb;
2890     { Error Correction Codes }
2891     DrawCodeWordBitmask (i, j + 2, WorkBarHeight,
2892     CodewordToBitmask (i, FCodewords[CodewordPos]));
2893     Inc (CodewordPos);
2894     end else begin
2895     if FHighlight then
2896     FBitmap.Canvas.Brush.Color := $bbffbb;
2897     { Padding }
2898     DrawCodewordBitmask (i, j + 2, WorkBarHeight,
2899     CodewordToBitmask (i, SymbolPadding));
2900     Inc (CodewordPos);
2901     end;
2902     end;
2903     if FHighlight then
2904     FBitmap.Canvas.Brush.Color := $bbddff;
2905     if Truncated then
2906     DrawStopPattern (i, XSize + 2, WorkBarHeight)
2907     else begin
2908     DrawRightRowIndicator (i, XSize + 2, WorkBarHeight, YSize, XSize);
2909     if FHighlight then
2910     FBitmap.Canvas.Brush.Color := $ddaaff;
2911     DrawStopPattern (i, XSize + 3, WorkBarHeight);
2912     end;
2913     end;
2914     end;
2915    
2916     procedure TStPDF417Barcode.DrawCodeword (RowNumber : Integer;
2917     ColNumber : Integer;
2918     WorkBarHeight : Integer;
2919     Pattern : string);
2920    
2921     function GetColumnPosition (ColNumber : Integer) : Integer;
2922     begin
2923     Result := ColNumber * StPDF417CellWidth * BarWidth;
2924     end;
2925    
2926     var
2927     i : Integer;
2928     CurPos : Integer;
2929     NewPos : Integer;
2930     DrawBlock : Boolean;
2931    
2932     begin
2933     if FHighlight then begin
2934     FBitmap.Canvas.FillRect (
2935     Rect (BarCodeRect.Left + (GetColumnPosition (ColNumber)),
2936     BarCodeRect.Top + RowNumber * WorkBarHeight,
2937     BarCodeRect.Left + 17 * BarWidth + GetColumnPosition (ColNumber),
2938     BarCodeRect.Top + (RowNumber + 1) * WorkBarHeight));
2939     FBitmap.Canvas.Brush.Color := Color;
2940     end;
2941    
2942     CurPos := 0;
2943     DrawBlock := True;
2944     for i := 1 to Length (Pattern) do begin
2945     NewPos := StrToInt (Copy (Pattern, i, 1)) * BarWidth;
2946     if DrawBlock then
2947     FBitmap.Canvas.Rectangle (
2948     BarCodeRect.Left + CurPos + GetColumnPosition (ColNumber),
2949     BarCodeRect.Top + RowNumber * WorkBarHeight,
2950     BarCodeRect.Left + CurPos + NewPos + GetColumnPosition (ColNumber),
2951     BarCodeRect.Top + (RowNumber + 1) * WorkBarHeight);
2952     CurPos := CurPos + NewPos;
2953     DrawBlock := not DrawBlock;
2954     end;
2955     end;
2956    
2957     procedure TStPDF417Barcode.DrawCodewordBitmask (RowNumber : Integer;
2958     ColNumber : Integer;
2959     WorkBarHeight : Integer;
2960     Bitmask : DWord);
2961    
2962     function GetColumnPosition (ColNumber : Integer) : Integer;
2963     begin
2964     Result := ColNumber * StPDF417CellWidth * BarWidth;
2965     end;
2966    
2967     var
2968     i : Integer;
2969    
2970     begin
2971     if FHighlight then begin
2972     FBitmap.Canvas.FillRect (
2973     Rect (BarCodeRect.Left + (GetColumnPosition (ColNumber)),
2974     BarCodeRect.Top + RowNumber * WorkBarHeight,
2975     BarCodeRect.Left + 17 * BarWidth + GetColumnPosition (ColNumber),
2976     BarCodeRect.Top + (RowNumber + 1) * WorkBarHeight));
2977     FBitmap.Canvas.Brush.Color := Color;
2978     end;
2979    
2980     for i := 16 downto 0 do
2981     if ((BitMask shr i) and $00001) <> 0 then
2982     FBitmap.Canvas.Rectangle (
2983     BarCodeRect.Left + (16 - i) * BarWidth +
2984     GetColumnPosition (ColNumber),
2985     BarCodeRect.Top + RowNumber * WorkBarHeight,
2986     BarCodeRect.Left + (17 - i) * BarWidth +
2987     GetColumnPosition (ColNumber),
2988     BarCodeRect.Top + (RowNumber + 1) * WorkBarHeight);
2989     end;
2990    
2991     procedure TStPDF417Barcode.DrawLeftRowIndicator (RowNumber : Integer;
2992     WorkBarHeight : Integer;
2993     NumRows : Integer;
2994     NumCols : Integer);
2995     var
2996     CodeWord : Integer;
2997     ErrorLevel : Integer;
2998    
2999     begin
3000     ErrorLevel := GetRealErrorLevel;
3001     CodeWord := 0;
3002     if RowNumber mod 3 = 0 then
3003     CodeWord := ((RowNumber div 3) * 30) + ((NumRows - 1) div 3)
3004     else if RowNumber mod 3 = 1 then
3005     CodeWord := ((RowNumber div 3) * 30) + ((NumRows - 1) mod 3) +
3006     (3 * ErrorLevel)
3007     else if RowNumber mod 3 = 2 then
3008     CodeWord := (( RowNumber div 3) * 30) + (NumCols - 1);
3009     DrawCodeWordBitmask (RowNumber, 1, WorkBarHeight,
3010     CodewordToBitmask (RowNumber, Codeword));
3011     end;
3012    
3013     procedure TStPDF417Barcode.DrawRightRowIndicator (RowNumber : Integer;
3014     ColNumber : Integer;
3015     WorkBarHeight : Integer;
3016     NumRows : Integer;
3017     NumCols : Integer);
3018     var
3019     Codeword : Integer;
3020     ErrorLevel : Integer;
3021    
3022     begin
3023     ErrorLevel := GetRealErrorLevel;
3024     CodeWord := 0;
3025     if RowNumber mod 3 = 0 then
3026     Codeword := ((RowNumber div 3) * 30) + (NumCols - 1)
3027     else if RowNumber mod 3 = 1 then
3028     Codeword := ((RowNumber div 3) * 30) + ((NumRows - 1) div 3)
3029     else if RowNumber mod 3 = 2 then
3030     Codeword := ((RowNumber div 3) * 30) + ((NumRows - 1) mod 3) +
3031     (3 * ErrorLevel);
3032     DrawCodeWordBitmask (RowNumber, ColNumber, WorkBarHeight,
3033     CodewordToBitmask (RowNumber, Codeword));
3034     end;
3035    
3036     procedure TStPDF417Barcode.DrawStartPattern (RowNumber : Integer;
3037     WorkBarHeight : Integer);
3038     begin
3039     DrawCodeword (RowNumber, 0, WorkBarHeight, '81111113');
3040     end;
3041    
3042     procedure TStPDF417Barcode.DrawStopPattern (RowNumber : Integer;
3043     ColNumber : Integer;
3044     WorkBarHeight : Integer);
3045     begin
3046     if Truncated then
3047     DrawCodeWord (RowNumber, ColNumber, WorkBarHeight, '1')
3048     else
3049     DrawCodeWord (RowNumber, ColNumber, WorkBarHeight, '711311121');
3050     end;
3051    
3052     procedure TStPDF417Barcode.EncodeBinary (var Position : Integer;
3053     CodeLen : Integer);
3054    
3055     function CountBytes (Position : Integer; CodeLen : Integer) : Integer;
3056     var
3057     Done : Boolean;
3058     Dummy : Integer;
3059    
3060     begin
3061     Result := 0;
3062     Done := False;
3063     while not done do begin
3064     if (Result < CodeLen) and
3065     (not GoodForNumericCompaction (Position + Result, CodeLen, Dummy)) and
3066     (not GoodForTextCompaction (Position + Result, CodeLen, Dummy)) then
3067     Inc (Result)
3068     else
3069     Done := True;
3070     end;
3071     end;
3072    
3073     var
3074     MultipleOfSix : Boolean;
3075     BinaryDataSize : Integer;
3076     i : Integer;
3077     j : Integer;
3078     A : array [0..6] of Integer;
3079    
3080     const
3081     Even6Bytes = 924;
3082     Odd6Bytes = 901;
3083    
3084     begin
3085     BinaryDataSize := CountBytes (Position, CodeLen);
3086     if BinaryDataSize mod 6 = 0 then
3087     MultipleOfSix := True
3088     else
3089     MultipleOfSix := False;
3090     if MultipleOfSix then
3091     AddCodeword (Even6Bytes)
3092     else
3093     AddCodeword (Odd6Bytes);
3094    
3095     i := 0;
3096     while i < BinaryDataSize do
3097     if BinaryDataSize - i < 6 then begin
3098     AddCodeword (Word (Code[Position + i]));
3099     Inc (i);
3100     end else begin
3101     ConvertBytesToBase900 ([Byte (Code[Position + i]),
3102     Byte (Code[Position + i + 1]),
3103     Byte (Code[Position + i + 2]),
3104     Byte (Code[Position + i + 3]),
3105     Byte (Code[Position + i + 4]),
3106     Byte (Code[Position + i + 5])], A);
3107     for j := 1 to 5 do
3108     AddCodeword (A[j - 1]); {!!.dg}
3109     Inc (i, 6);
3110     end;
3111     Inc (Position, BinaryDataSize); {!!.dg}
3112     end;
3113    
3114     procedure TStPDF417Barcode.EncodeNumeric (var Position : Integer;
3115     CodeLen : Integer);
3116    
3117     function CollectDigits (var Position : Integer;
3118     CodeLen : Integer) : string;
3119     var
3120     StartPos : Integer;
3121    
3122     const
3123     MaxDigitChunk = 44;
3124    
3125     begin
3126     Result := '';
3127     StartPos := Position;
3128     while (Position <= CodeLen) and (Position - StartPos < MaxDigitChunk) and
3129     (Code[Position] >= '0') and (Code[Position] <= '9') do begin
3130     Inc (Position);
3131     end;
3132     if Position - StartPos > 0 then
3133     Result := '1' + Copy (Code, StartPos, Position - StartPos);
3134     end;
3135    
3136     var
3137     NumericString : string;
3138     A : array [0..44] of Integer;
3139     LenA : Integer;
3140     i : Integer;
3141    
3142     const
3143     NumericLatch = 902;
3144    
3145     begin
3146     AddCodeword (NumericLatch);
3147     repeat
3148     NumericString := CollectDigits (Position, CodeLen);
3149     if NumericString <> '' then begin
3150     ConvertToBase900 (NumericString, A, LenA);
3151     for i := 0 to LenA do
3152     AddCodeword (A[i]);
3153     end;
3154     until NumericString = '';
3155     end;
3156    
3157     procedure TStPDF417Barcode.EncodeText (var Position : Integer;
3158     CodeLen : Integer);
3159    
3160     function SelectBestTextMode (
3161     CurChar : TStPDF417TextCompactionData) : TStPDF417TextCompactionMode;
3162     begin
3163     if cmAlpha in CurChar.Mode then
3164     Result := cmAlpha
3165     else if cmLower in CurChar.Mode then
3166     Result := cmLower
3167     else if cmMixed in CurChar.Mode then
3168     Result := cmMixed
3169     else if cmPunctuation in CurChar.Mode then
3170     Result := cmPunctuation
3171     else
3172     Result := cmNone;
3173     end;
3174    
3175     procedure AddTextCharacter (Value : Word);
3176     begin
3177     if FNewTextCodeword then
3178     FCodewords[FNumCodewords] := 30 * Value
3179     else begin
3180     FCodewords[FNumCodewords] := FCodewords[FNumCodewords] + Value;
3181     Inc (FNumCodewords);
3182     end;
3183     FNewTextCodeword := not FNewTextCodeword;
3184     end;
3185    
3186     function ChangeTextSubmode (CurrentMode : TStPDF417TextCompactionMode;
3187     NewMode : TStPDF417TextCompactionMode;
3188     UseShift : Boolean) : TStPDF417TextCompactionMode;
3189     const
3190     LatchAlphaToLower = 27;
3191     LatchAlphaToMixed = 28;
3192     ShiftAlphaToPunctuation = 29;
3193     ShiftLowerToAlpha = 27;
3194     LatchLowerToMixed = 28;
3195     ShiftLowertoPunctuation = 29;
3196     LatchMixedToPunctuation = 25;
3197     LatchMixedToLower = 27;
3198     LatchMixedToAlpha = 28;
3199     ShiftMixedToPunctuation = 29;
3200     LatchPunctuationToAlpha = 29;
3201    
3202     begin
3203     if UseShift then
3204     Result := CurrentMode
3205     else
3206     Result := NewMode;
3207    
3208     case CurrentMode of
3209     cmAlpha :
3210     case NewMode of
3211     cmLower :
3212     begin
3213     { Alpha to Lower. No shift }
3214     AddTextCharacter (LatchAlphaToLower);
3215     if UseShift then
3216     Result := NewMode;
3217     end;
3218     cmMixed :
3219     begin
3220     { Alpha to Numeric. No shift }
3221     AddTextCharacter (LatchAlphaToMixed);
3222     if UseShift then
3223     Result := NewMode;
3224     end;
3225     cmPunctuation :
3226     { Alpha to Punctuation }
3227     if UseShift then
3228     AddTextCharacter (ShiftAlphaToPunctuation)
3229     else begin
3230     AddTextCharacter (LatchAlphaToMixed);
3231     AddTextCharacter (LatchMixedToPunctuation);
3232     end;
3233     end;
3234    
3235     cmLower :
3236     case NewMode of
3237     cmAlpha :
3238     { Lower to Alpha }
3239     if UseShift then
3240     AddTextCharacter (ShiftLowerToAlpha)
3241     else begin
3242     AddTextCharacter (LatchLowerToMixed);
3243     AddTextCharacter (LatchMixedToAlpha);
3244     end;
3245     cmMixed :
3246     begin
3247     { Lower to Mixed. No shift }
3248     AddTextCharacter (LatchLowerToMixed);
3249     if UseShift then
3250     Result := NewMode;
3251     end;
3252     cmPunctuation :
3253     { Lower to Punctuation }
3254     if UseShift then
3255     AddTextCharacter (ShiftLowerToPunctuation)
3256     else begin
3257     AddTextCharacter (LatchLowerToMixed);
3258     AddTextCharacter (LatchMixedToPunctuation);
3259     end;
3260     end;
3261    
3262     cmMixed :
3263     case NewMode of
3264     cmAlpha :
3265     begin
3266     { Mixed to Alpha. No shift }
3267     AddTextCharacter (LatchMixedToAlpha);
3268     if UseShift then
3269     Result := NewMode;
3270     end;
3271     cmLower :
3272     begin
3273     { Mixed to Lower. No shift }
3274     AddTextCharacter (LatchMixedToLower);
3275     if UseShift then
3276     Result := NewMode;
3277     end;
3278     cmPunctuation :
3279     { Mixed to Punctuation }
3280     if UseShift then
3281     AddTextCharacter (ShiftMixedToPunctuation)
3282     else
3283     AddTextCharacter (LatchMixedToPunctuation);
3284     end;
3285     cmPunctuation :
3286     case NewMode of
3287     cmAlpha :
3288     begin
3289     { Punctuation to Alpha. No shift }
3290     AddTextCharacter (LatchPunctuationToAlpha);
3291     if UseShift then
3292     Result := NewMode;
3293     end;
3294     cmLower :
3295     begin
3296     { Punctuation to Lower. No shift }
3297     AddTextCharacter (LatchPunctuationToAlpha);
3298     AddTextCharacter (LatchAlphaToLower);
3299     if UseShift then
3300     Result := NewMode;
3301     end;
3302     cmMixed :
3303     begin
3304     { Punctuation to Mixed. No shift }
3305     AddTextCharacter (LatchPunctuationToAlpha);
3306     AddTextCharacter (LatchAlphaToMixed);
3307     if UseShift then
3308     Result := NewMode;
3309     end;
3310     end;
3311     end;
3312     end;
3313    
3314     var
3315     CurrentTextSubmode : TStPDF417TextCompactionMode;
3316     CurChar : TStPDF417TextCompactionData;
3317     UseShift : Boolean;
3318     Done : Boolean;
3319     Dummy : Integer;
3320     NewChar : Integer;
3321     Codeword : Boolean;
3322    
3323     const
3324     EndingPadChar = 29;
3325    
3326     begin
3327     { Initialize and get the first character }
3328     FNewTextCodeword := True;
3329     CurrentTextSubmode := cmAlpha;
3330     Done := False;
3331    
3332     { get characters until it is necessary to step out of text mode }
3333     while (Position <= CodeLen) and (CurChar.Value >= 0) and
3334     (not Done) do begin
3335     if (Position <= CodeLen) then begin
3336     GetNextCharacter (NewChar, Codeword, Position, CodeLen);
3337     CurChar := TStPDF417TextCompaction[NewChar];
3338     end;
3339    
3340     if Codeword then begin
3341     { If the text contains an odd number of letters, follow it with a
3342     trailing 29 }
3343     if not FNewTextCodeword then
3344     AddTextCharacter (EndingPadChar);
3345     FNewTextCodeword := True;
3346     { Add the codeword }
3347     AddCodeword (NewChar)
3348     end else begin
3349     { Check if the text submode for the current character is different than
3350     the current text submode }
3351     if not (CurrentTextSubmode in CurChar.Mode) then begin
3352     { if the text submode is different, see if it remains different. If
3353     it does, use a latch, otherwise just shift }
3354     if Position < CodeLen then begin
3355     if not (CurrentTextSubmode in
3356     TStPDF417TextCompaction[Integer (Code[Position + 1])].Mode) then
3357     UseShift := False
3358     else
3359     UseShift := True;
3360     end else
3361     UseShift := True;
3362    
3363     { Add the shift or latch to the text codewords }
3364     CurrentTextSubmode := ChangeTextSubmode (CurrentTextSubmode,
3365     SelectBestTextMode (CurChar),
3366     UseShift);
3367     end;
3368    
3369     { Add the character to the codeword array }
3370     AddTextCharacter (CurChar.Value);
3371     end;
3372     { If this is a digit and it looks like a good time to switch to
3373     numeric mode, do so }
3374     if GoodForNumericCompaction (Position, CodeLen, Dummy) then
3375     Done := True;
3376     end;
3377    
3378     { If the text contains an odd number of letters, follow it with a
3379     trailing 29 }
3380     if not FNewTextCodeword then
3381     AddTextCharacter (EndingPadChar);
3382     end;
3383    
3384     procedure TStPDF417Barcode.GenerateCodewords;
3385     var
3386     ErrorLevel : Integer;
3387     NumErrorCodewords : Integer;
3388     XSize : Integer;
3389     YSize : Integer;
3390    
3391     begin
3392     TextToCodewords;
3393    
3394     ErrorLevel := GetRealErrorLevel;
3395    
3396     NumErrorCodewords := Trunc (Power (2, ErrorLevel + 1));
3397    
3398     CalculateSize (XSize, YSize);
3399    
3400     FUsedCodewords := FNumCodewords;
3401     FUsedECCCodewords := NumErrorCodewords;
3402     FFreeCodewords := FTotalCodewords - FUsedCodewords;
3403    
3404     { The first codewords is always the length }
3405     if FNumCodewords +
3406     (XSize * YSize - FNumCodewords - NumErrorCodewords) < 0 then
3407     raise E2DBarcodeError.Create (StECodeTooLarge);
3408     FCodewords[0] := FNumCodewords +
3409     (XSize * YSize - FNumCodewords - NumErrorCodewords);
3410    
3411     if NumErrorCodeWords + FNumCodeWords <= XSize * YSize then
3412     CalculateECC (XSize * YSize - NumErrorCodeWords, NumErrorCodewords)
3413     else
3414     raise E2DBarcodeError.Create (StECodeTooLarge);
3415     end;
3416    
3417     procedure TStPDF417Barcode.GetNextCharacter (var NewChar : Integer;
3418     var Codeword : Boolean;
3419     var Position : Integer;
3420     CodeLen : Integer);
3421     var
3422     WorkNum : Integer;
3423    
3424     begin
3425     NewChar := 0;
3426     Codeword := False;
3427    
3428     if Position <= CodeLen then begin
3429     if (FCode[Position] = '\') and
3430     (Position < CodeLen) then begin
3431     case FCode[Position + 1] of
3432     '0'..'9' : begin
3433     try
3434     NewChar := StrToInt (Copy (FCode, Position + 1, 3));
3435     Inc (Position, 4);
3436     except
3437     NewChar := 0;
3438     Inc (Position, 4);
3439     end;
3440     end;
3441     'C', 'c' : begin
3442     try
3443     Codeword := True;
3444     NewChar := StrToInt (Copy (FCode, Position + 2, 3));
3445     Inc (Position, 5);
3446     except
3447     NewChar := 0;
3448     Inc (Position, 5);
3449     end;
3450     end;
3451     'G', 'g' : begin
3452     WorkNum := StrToInt (Copy (FCode, Position + 1, 6));
3453     Inc (Position, 8);
3454     if (WorkNum >= 0) and (WorkNum <= 899) then begin
3455     AddCodeword (927);
3456     Codeword := True;
3457     NewChar := WorkNum;
3458     end else if (WorkNum >= 900) and (WorkNum < 810900) then begin
3459     AddCodeword (926);
3460     AddCodeword ((WorkNum div 900) - 1);
3461     Codeword := True;
3462     NewChar := WorkNum mod 900;
3463     end else if (WorkNum >= 810900) and (WorkNum < 811800) then begin
3464     AddCodeword (925);
3465     Codeword := True;
3466     NewChar := WorkNum;
3467     end else
3468     raise E2DBarcodeError.Create (StEGLIOutOfRange);
3469     end;
3470     'X', 'x' : begin
3471     try
3472     NewChar := StrToInt ('$' + Copy (FCode, Position + 2, 2));
3473     Inc (Position, 4);
3474     except
3475     NewChar := 0;
3476     Inc (Position, 4);
3477     end;
3478     end;
3479     '\' : begin
3480     NewChar := Byte (FCode[Position]);
3481     Inc (Position, 2);
3482     end;
3483     else begin
3484     NewChar := Byte (FCode[Position]);
3485     Inc (Position);
3486     end;
3487     end;
3488     end else begin
3489     NewChar := Byte (FCode[Position]);
3490     Inc (Position);
3491     end;
3492     end;
3493     end;
3494    
3495     function TStPDF417Barcode.GetPDF417ECCLevel : TStPDF417ECCLevels;
3496     begin
3497     case FECCLevel of
3498     0 : Result := ecLevel0;
3499     1 : Result := ecLevel1;
3500     2 : Result := ecLevel2;
3501     3 : Result := ecLevel3;
3502     4 : Result := ecLevel4;
3503     5 : Result := ecLevel5;
3504     6 : Result := ecLevel6;
3505     7 : Result := ecLevel7;
3506     8 : Result := ecLevel8;
3507     else
3508     Result := ecAuto;
3509     end;
3510     end;
3511    
3512     function TStPDF417Barcode.GetRealErrorLevel : Integer;
3513     begin
3514     if (FECCLevel < 0) then begin
3515     if FNumCodeWords < 41 then
3516     Result := 2
3517     else if FNumCodeWords < 161 then
3518     Result := 3
3519     else if FNumCodeWords < 321 then
3520     Result := 4
3521     else
3522     Result := 5;
3523     end else
3524     Result := FECCLevel
3525     end;
3526    
3527     function TStPDF417Barcode.GoodForNumericCompaction (
3528     Position : Integer;
3529     CodeLen : Integer;
3530     var Count : Integer) : Boolean;
3531     const
3532     BytesNeeded = 13;
3533    
3534     begin
3535     Result := False;
3536     Count := 0;
3537     while (Position + Count < CodeLen) and
3538     (Code[Position + Count] >= '0') and
3539     (Code[Position + Count] <= '9') do
3540     Inc (Count);
3541     if Count > BytesNeeded then
3542     Result := True;
3543     end;
3544    
3545     function TStPDF417Barcode.GoodForTextCompaction (
3546     Position : Integer;
3547     CodeLen : Integer;
3548     var Count : Integer) : Boolean;
3549    
3550     function IsGoodTextValue (const v : Char) : Boolean; {!!.01}
3551     begin {!!.01}
3552     if v > #127 then {!!.01}
3553     Result := False {!!.01}
3554     else if TStPDF417TextCompaction[Integer (v)].Value >= 0 then {!!.01}
3555     Result := True {!!.01}
3556     else {!!.01}
3557     Result := False; {!!.01}
3558     end; {!!.01}
3559    
3560     const
3561     BytesNeeded = 5;
3562    
3563     begin
3564     Result := False;
3565     Count := 0;
3566     while (Position + Count < CodeLen) and {!!.01}
3567     (IsGoodTextValue (Code[Position + Count])) and {!!.01}
3568     (Count <= BytesNeeded) do {!!.01}
3569     Inc (Count);
3570     if (Count > BytesNeeded) or
3571     ((Position + Count >= CodeLen) and (Count > 0)) then
3572     Result := True;
3573     end;
3574    
3575     procedure TStPDF417Barcode.RenderToResolution (var OutBitmap : TBitmap;
3576     ResX : Integer;
3577     ResY : Integer;
3578     var SizeX : Integer;
3579     var SizeY : Integer);
3580     var
3581     OldBarWidth : Integer;
3582     OldWidth : Integer;
3583     OldHeight : Integer;
3584     CurResX : Integer;
3585     CurResY : Integer;
3586     MultX : Extended;
3587     MultY : Extended;
3588    
3589     begin
3590     OldBarWidth := BarWidth;
3591     OldWidth := Width;
3592     OldHeight := Height;
3593     SizeX := Width;
3594     SizeY := Height;
3595     try
3596     if (ResX <> 0) and (ResY <> 0) then begin
3597     GetCurrentResolution (CurResX, CurResY);
3598     MultX := ResX / CurResX;
3599     MultY := ResY / CurResY;
3600     FBarWidth := Trunc (FBarWidth * MultX);
3601     FBitmap.Width := Trunc (FBitmap.Width * MultX);
3602     FBitmap.Height := Trunc (FBitmap.Height * MultY);
3603     SizeX := FBitmap.Width;
3604     SizeY := FBitmap.Height;
3605     end;
3606     FBitmap.Canvas.Font.PixelsPerInch := OutBitmap.Canvas.Font.PixelsPerInch;
3607     GenerateBarcodeBitmap (FBitmap.Width, FBitmap.Height);
3608     OutBitmap.Width := SizeX;
3609     OutBitmap.Height := SizeY;
3610     OutBitmap.Canvas.CopyRect (Rect (0, 0, SizeX, SizeY), FBitmap.Canvas,
3611     Rect (0, 0, SizeX, SizeY));
3612     finally
3613     FBarWidth := OldBarWidth;
3614     FBitmap.Width := OldWidth;
3615     FBitmap.Height := OldHeight;
3616     GenerateBarcodeBitmap (Width, Height);
3617     end;
3618     end;
3619    
3620     procedure TStPDF417Barcode.SetBarHeight (const v : Integer);
3621     begin
3622     if (v < 1) and (BarHeightToWidth = 0) and (not RelativeBarHeight) then
3623     raise E2DBarcodeError.Create (StENeedBarHeight);
3624     if v < 0 then
3625     raise E2DBarcodeError.Create (StEBadBarWidth);
3626     inherited SetBarHeight (v);
3627     end;
3628    
3629     procedure TStPDF417Barcode.SetBarHeightToWidth (const v : Integer);
3630     begin
3631     if (v = 0) and (BarHeight = 0) and (not RelativeBarHeight) then
3632     raise E2DBarcodeError.Create (StENeedBarHeight);
3633     inherited SetBarHeightToWidth (v);
3634     end;
3635    
3636     procedure TStPDF417Barcode.SetBarWidth (const v : Integer);
3637     begin
3638     if v < 1 then
3639     raise E2DBarcodeError.Create (StEBadBarHeight);
3640     inherited SetBarWidth (v);
3641     end;
3642    
3643     procedure TStPDF417Barcode.SetPDF417ECCLevel (const v : TStPDF417ECCLevels);
3644     var
3645     NewLevel : Integer;
3646     OldLevel : Integer;
3647    
3648     begin
3649     NewLevel := -1;
3650     case v of
3651     ecAuto : NewLevel := -1;
3652     ecLevel0 : NewLevel := 0;
3653     ecLevel1 : NewLevel := 1;
3654     ecLevel2 : NewLevel := 2;
3655     ecLevel3 : NewLevel := 3;
3656     ecLevel4 : NewLevel := 4;
3657     ecLevel5 : NewLevel := 5;
3658     ecLevel6 : NewLevel := 6;
3659     ecLevel7 : NewLevel := 7;
3660     ecLevel8 : NewLevel := 8;
3661     end;
3662    
3663     if NewLevel <> FECCLevel then begin
3664     OldLevel := FECCLevel;
3665     try
3666     FECCLevel := NewLevel;
3667     GenerateCodewords;
3668     GenerateBarcodeBitmap (Width, Height);
3669     Invalidate;
3670     except
3671     on E2DBarcodeError do begin
3672     FECCLevel := OldLevel;
3673     try
3674     GenerateCodewords;
3675     GenerateBarcodeBitmap (Width, Height);
3676     Invalidate;
3677     except
3678     on E2DBarcodeError do begin
3679     end;
3680     end;
3681     raise
3682     end;
3683     end;
3684     end;
3685     end;
3686    
3687     procedure TStPDF417Barcode.SetRelativeBarHeight (const v : Boolean);
3688     begin
3689     if (not v) and (BarHeightToWidth = 0) and (BarHeight = 0) then
3690     raise E2DBarcodeError.Create (StENeedBarHeight);
3691     inherited SetRelativeBarHeight (v);
3692     end;
3693    
3694     procedure TStPDF417Barcode.SetTruncated (const v : Boolean);
3695     var
3696     OldTruncated : Boolean;
3697    
3698     begin
3699     if v <> FTruncated then begin
3700     OldTruncated := FTruncated;
3701     try
3702     FTruncated := v;
3703     GenerateBarcodeBitmap (Width, Height);
3704     Invalidate;
3705     except
3706     on E2DBarcodeError do begin
3707     FTruncated := OldTruncated;
3708     try
3709     GenerateBarcodeBitmap (Width, Height);
3710     Invalidate;
3711     except
3712     on E2DBarcodeError do begin
3713     end;
3714     end;
3715     raise
3716     end;
3717     end;
3718     end;
3719     end;
3720    
3721     function TStPDF417Barcode.IsNumericString (const S : string) : boolean;
3722     var
3723     i : integer;
3724     LenS : integer;
3725    
3726     begin
3727     {note: an assertion test for ConvertToBase900}
3728     Result := false;
3729     LenS := length(S);
3730     if (LenS = 0) or (LenS > 45) then
3731     Exit;
3732     for i := 1 to LenS do
3733     if not (('0' <= S[i]) and (S[i] <= '9')) then
3734     Exit;
3735     Result := true;
3736     end;
3737    
3738     procedure TStPDF417Barcode.SetNumColumns (const v : Integer);
3739     var
3740     OldNumColumns : Integer;
3741    
3742     begin
3743     if (v < 0) or (v > 30) then
3744     raise E2DBarcodeError.Create (StEBadNumCols);
3745     if v <> FNumColumns then begin
3746     OldNumColumns := FNumColumns;
3747     try
3748     if v < 0 then
3749     FNumColumns := 0
3750     else
3751     FNumColumns := v;
3752     GenerateCodewords;
3753     GenerateBarcodeBitmap (Width, Height);
3754     Invalidate;
3755     except
3756     on E2DBarcodeError do begin
3757     FNumColumns := OldNumColumns;
3758     try
3759     GenerateCodewords;
3760     GenerateBarcodeBitmap (Width, Height);
3761     Invalidate;
3762     except
3763     on E2DBarcodeError do begin
3764     end;
3765     end;
3766     raise
3767     end;
3768     end;
3769     end;
3770     end;
3771    
3772     procedure TStPDF417Barcode.SetNumRows (const v : Integer);
3773     var
3774     OldNumRows : Integer;
3775    
3776     begin
3777     if (v < 0) or (v > 90) then
3778     raise E2DBarcodeError.Create (StEBadNumRows);
3779     if v <> FNumRows then begin
3780     OldNumRows := FNumRows;
3781     try
3782     if v < 0 then
3783     FNumRows := 0
3784     else
3785     FNumRows := v;
3786     GenerateCodewords;
3787     GenerateBarcodeBitmap (Width, Height);
3788     Invalidate;
3789     except
3790     on E2DBarcodeError do begin
3791     FNumRows := OldNumRows;
3792     try
3793     GenerateCodewords;
3794     GenerateBarcodeBitmap (Width, Height);
3795     Invalidate;
3796     except
3797     on E2DBarcodeError do begin
3798     end;
3799     end;
3800     raise
3801     end;
3802     end;
3803     end;
3804     end;
3805    
3806     procedure TStPDF417Barcode.TextToCodewords;
3807     var
3808     i : Integer;
3809     CodeLen : Integer;
3810     CurrentMode : TStDataMode;
3811     Count : Integer;
3812     First : Boolean;
3813    
3814     const
3815     TextCompaction = 900;
3816     PadCodeword = 900;
3817    
3818     begin
3819     First := True;
3820     for i := 0 to 2700 do
3821     FCodewords[i] := PadCodeword;
3822     FNumCodewords := 1; { There will always be a length codeword }
3823     i := 1;
3824    
3825     CodeLen := Length (Code);
3826     if CodeLen = 0 then
3827     Exit;
3828    
3829     if GoodForNumericCompaction (i, CodeLen, Count) then
3830     CurrentMode := dmNumeric
3831     else if GoodForTextCompaction (i, CodeLen, Count) then
3832     CurrentMode := dmText
3833     else
3834     CurrentMode := dmBinary;
3835    
3836     while i < CodeLen do begin
3837     case CurrentMode of
3838     dmBinary :
3839     EncodeBinary (i, CodeLen);
3840     dmText :
3841     if First then
3842     EncodeText (i, CodeLen);
3843     dmNumeric :
3844     EncodeNumeric (i, CodeLen);
3845     end;
3846    
3847     if GoodForNumericCompaction (i, CodeLen, Count) then
3848     CurrentMode := dmNumeric
3849     else if GoodForTextCompaction (i, CodeLen, Count) then begin
3850     if not First then
3851     AddCodeword (TextCompaction);
3852     CurrentMode := dmText;
3853     EncodeText (i, CodeLen); {!!.01}
3854     end else
3855     CurrentMode := dmBinary;
3856     First := False;
3857     end;
3858     end;
3859    
3860     { TStMaxiCodeBarcode }
3861    
3862     constructor TStMaxiCodeBarcode.Create (AOwner : TComponent);
3863     begin
3864     inherited Create (AOwner);
3865    
3866     FMode := cmMode4;
3867     FHighlight := False;
3868     FShowCodewords := False;
3869     FShowAll := False;
3870     FAutoScale := True;
3871     FBarWidth := 0;
3872     FBarHeight := 0;
3873     FHorPixelsPerMM := 4;
3874     FVerPixelsPerMM := 4;
3875     FMaxiHexWidth := 9;
3876     FMaxiHexHeight := 9;
3877     FMaxiHexVOffset := -2;
3878     FMaxiHexHOffset := 4;
3879     FCarrierCountryCode := 0;
3880     FCarrierServiceClass := 0;
3881     FCarrierPostalCode := '000000000';
3882    
3883     GetSizes;
3884    
3885     Width := 121;
3886     Height := 129;
3887    
3888     GenerateCodewords;
3889     GenerateBarcodeBitmap (Width, Height);
3890     end;
3891    
3892     procedure TStMaxiCodeBarcode.AddCodeword (Value : Integer);
3893     begin
3894     if FNumCodewords <= 144 then
3895     FMessage[FNumCodewords] := Value;
3896     Inc (FNumCodewords);
3897     end;
3898    
3899     function TStMaxiCodeBarcode.CalculateBarCodeWidth (
3900     PaintableWidth : Integer) : Integer;
3901     begin
3902     Result := Round (30 * FMaxiHexWidth + FMaxiHexHOffset);
3903     end;
3904    
3905     function TStMaxiCodeBarcode.CalculateBarCodeHeight (
3906     PaintableHeight : Integer) : Integer;
3907     begin
3908     Result := Round (33 * FMaxiHexHeight + 33 * FMaxiHexVOffset);
3909     end;
3910    
3911     procedure TStMaxiCodeBarcode.DrawBarcode;
3912    
3913     function IsBitOn (Value : Byte; Bit : Byte) : Boolean;
3914     begin
3915     Result := ((Value shr Bit) and $01) <> $00;
3916     end;
3917    
3918     const
3919     {
3920     The MaxBits array is arranged to match the hex layout of the MaxiCode
3921     Barcode.
3922    
3923     -2 identifies the (light) module at the center of the finder pattern,
3924     -1 identifies modules which are always dark,
3925     0 identifies modules which are always light, and
3926     Positive numbers indicate the bitnumber of the cell.
3927     }
3928     MaxBits : array [0..32] of array [0..29] of Integer =
3929     (( 122,121,128,127,134,133,140,139,146,145,152,151,158,157,164,163,170,169,176,175,182,181,188,187,194,193,200,199, -1, -1 ),
3930     ( 124,123,130,129,136,135,142,141,148,147,154,153,160,159,166,165,172,171,178,177,184,183,190,189,196,195,202,201,817, 0 ),
3931     ( 126,125,132,131,138,137,144,143,150,149,156,155,162,161,168,167,174,173,180,179,186,185,192,191,198,197,204,203,819,818 ),
3932     ( 284,283,278,277,272,271,266,265,260,259,254,253,248,247,242,241,236,235,230,229,224,223,218,217,212,211,206,205,820, 0 ),
3933     ( 286,285,280,279,274,273,268,267,262,261,256,255,250,249,244,243,238,237,232,231,226,225,220,219,214,213,208,207,822,821 ),
3934     ( 288,287,282,281,276,275,270,269,264,263,258,257,252,251,246,245,240,239,234,233,228,227,222,221,216,215,210,209,823, 0 ),
3935     ( 290,289,296,295,302,301,308,307,314,313,320,319,326,325,332,331,338,337,344,343,350,349,356,355,362,361,368,367,825,824 ),
3936     ( 292,291,298,297,304,303,310,309,316,315,322,321,328,327,334,333,340,339,346,345,352,351,358,357,364,363,370,369,826, 0 ),
3937     ( 294,293,300,299,306,305,312,311,318,317,324,323,330,329,336,335,342,341,348,347,354,353,360,359,366,365,372,371,828,827 ),
3938     ( 410,409,404,403,398,397,392,391, 80, 79, -1, -1, 14, 13, 38, 37, 3, 0, 45, 44,110,109,386,385,380,379,374,373,829, 0 ),
3939     ( 412,411,406,405,400,399,394,393, 82, 81, 41, -1, 16, 15, 40, 39, 4, 0, 0, 46,112,111,388,387,382,381,376,375,831,830 ),
3940     ( 414,413,408,407,402,401,396,395, 84, 83, 42, 0, 0, 0, 0, 0, 6, 5, 48, 47,114,113,390,389,384,383,378,377,832, 0 ),
3941     ( 416,415,422,421,428,427,104,103, 56, 55, 17, 0, 0, 0, 0, 0, 0, 0, 21, 20, 86, 85,434,433,440,439,446,445,834,833 ),
3942     ( 418,417,424,423,430,429,106,105, 58, 57, 0, 0, 0, 0, 0, 0, 0, 0, 23, 22, 88, 87,436,435,442,441,448,447,835, 0 ),
3943     ( 420,419,426,425,432,431,108,107, 60, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 24, 90, 89,438,437,444,443,450,449,837,836 ),
3944     ( 482,481,476,475,470,469, 49, -1, 31, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 54, 53,464,463,458,457,452,451,838, 0 ),
3945     ( 484,483,478,477,472,471, 50, 0, -1, 0, 0, 0, 0, 0, -2, 0, 0, 0, 0, 0, -1, 0,466,465,460,459,454,453,840,839 ),
3946     ( 486,485,480,479,474,473, 52, 51, 32, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, -1, 43,468,467,462,461,456,455,841, 0 ),
3947     ( 488,487,494,493,500,499, 98, 97, 62, 61, 0, 0, 0, 0, 0, 0, 0, 0, 0, 27, 92, 91,506,505,512,511,518,517,843,842 ),
3948     ( 490,489,496,495,502,501,100, 99, 64, 63, 0, 0, 0, 0, 0, 0, 0, 0, 29, 28, 94, 93,508,507,514,513,520,519,844, 0 ),
3949     ( 492,491,498,497,504,503,102,101, 66, 65, 18, 0, 0, 0, 0, 0, 0, 0, 19, 30, 96, 95,510,509,516,515,522,521,846,845 ),
3950     ( 560,559,554,553,548,547,542,541, 74, 73, 33, 0, 0, 0, 0, 0, 0, 11, 68, 67,116,115,536,535,530,529,524,523,847, 0 ),
3951     ( 562,561,556,555,550,549,544,543, 76, 75, -1, 0, 8, 7, 36, 35, 12, -1, 70, 69,118,117,538,537,532,531,526,525,849,848 ),
3952     ( 564,563,558,557,552,551,546,545, 78, 77, -1, 34, 10, 9, 26, 25, 0, -1, 72, 71,120,119,540,539,534,533,528,527,850, 0 ),
3953     ( 566,565,572,571,578,577,584,583,590,589,596,595,602,601,608,607,614,613,620,619,626,625,632,631,638,637,644,643,852,851 ),
3954     ( 568,567,574,573,580,579,586,585,592,591,598,597,604,603,610,609,616,615,622,621,628,627,634,633,640,639,646,645,853, 0 ),
3955     ( 570,569,576,575,582,581,588,587,594,593,600,599,606,605,612,611,618,617,624,623,630,629,636,635,642,641,648,647,855,854 ),
3956     ( 728,727,722,721,716,715,710,709,704,703,698,697,692,691,686,685,680,679,674,673,668,667,662,661,656,655,650,649,856, 0 ),
3957     ( 730,729,724,723,718,717,712,711,706,705,700,699,694,693,688,687,682,681,676,675,670,669,664,663,658,657,652,651,858,857 ),
3958     ( 732,731,726,725,720,719,714,713,708,707,702,701,696,695,690,689,684,683,678,677,672,671,666,665,660,659,654,653,859, 0 ),
3959     ( 734,733,740,739,746,745,752,751,758,757,764,763,770,769,776,775,782,781,788,787,794,793,800,799,806,805,812,811,861,860 ),
3960     ( 736,735,742,741,748,747,754,753,760,759,766,765,772,771,778,777,784,783,790,789,796,795,802,801,808,807,814,813,862, 0 ),
3961     ( 738,737,744,743,750,749,756,755,762,761,768,767,774,773,780,779,786,785,792,791,798,797,804,803,810,809,816,815,864,863 ));
3962    
3963     ColorTable : array [0..11] of TColor = ($bbffff, $ffbbff, $ffffbb, $bbbbff,
3964     $bbffbb, $ffbbbb, $a0cbff, $a0ffcb,
3965     $ffa0cb, $cba0ff, $ffcba0, $cbffa0);
3966     var
3967     i : Integer;
3968     j : Integer;
3969     XPos : Integer;
3970     YPos : Integer;
3971     RowOffset : Extended;
3972     ByteNum : Integer;
3973     BitOffset : Integer;
3974    
3975     begin
3976    
3977     FBitmap.Canvas.Brush.Color := Color;
3978     FBitmap.Canvas.Pen.Width := 1;
3979    
3980     YPos := 0;
3981     RowOffset := 0;
3982    
3983     for i := 0 to 32 do begin
3984     for j := 0 to 29 do begin
3985     XPos := Round (j * FMaxiHexWidth + RowOffset);
3986     if FHighlight then begin
3987     FBitmap.Canvas.Pen.Color := Color;
3988     FBitmap.Canvas.Brush.Color := Color;
3989     end;
3990    
3991     ByteNum := MaxBits[i, j];
3992     if ByteNum = -1 then begin
3993     if FHighlight then
3994     FBitmap.Canvas.Pen.Color := $505050;
3995     DrawHex (XPos, YPos);
3996     if FHighlight then
3997     FBitmap.Canvas.Pen.Color := Color;
3998     end else if ByteNum > 0 then begin
3999     BitOffset := ((ByteNum - 1) mod 6);
4000     ByteNum := (ByteNum - 1) div 6 {+ 1}; { Codeword 1 is the mode }
4001     if FHighlight then begin
4002     if not FShowCodewords then
4003     case ByteNum of
4004     0 : FBitmap.Canvas.Pen.Color := ColorTable[0];
4005     1..9 : FBitmap.Canvas.Pen.Color := ColorTable[1];
4006     10..19 : FBitmap.Canvas.Pen.Color := ColorTable[2];
4007     20..87 : FBitmap.Canvas.Pen.Color := ColorTable[3];
4008     89..103 : FBitmap.Canvas.Pen.Color := ColorTable[4];
4009     104..144 : FBitmap.Canvas.Pen.Color := ColorTable[5];
4010     end
4011     else
4012     FBitmap.Canvas.Pen.Color := ColorTable[ByteNum mod 12];
4013     FBitmap.Canvas.Brush.Color := FBitmap.Canvas.Pen.Color;
4014     DrawHex (XPos, YPos);
4015     FBitmap.Canvas.Pen.Color := Color;
4016     FBitmap.Canvas.Brush.Color := Color;
4017     end;
4018     if IsBitOn (FCodewords[ByteNum], 5 - BitOffset) then
4019     DrawHex (XPos, YPos)
4020     else if FShowAll then
4021     DrawHex (XPos, YPos);
4022     end;
4023     end;
4024     RowOffset := FMaxiHexHOffset - RowOffset;
4025     YPos := Round (((i + 1) * FMaxiHexHeight) * 0.8660254);
4026     end;
4027    
4028     DrawFinder;
4029     end;
4030    
4031     procedure TStMaxiCodeBarcode.DrawFinder;
4032     var
4033     CenterX : Integer;
4034     CenterY : Integer;
4035    
4036     begin
4037     CenterX := Round (BarCodeRect.Left + 14.5 * FMaxiHexWidth);
4038     CenterY := BarCodeRect.Top + Round (16.5 * FMaxiHexHeight * 0.8660254);
4039     FBitmap.Canvas.Brush.Color := BackgroundColor;
4040     FBitmap.Canvas.Pen.Width := Round (FMaxiHexWidth + FMaxiHexVOffset);
4041     FBitmap.Canvas.Ellipse (
4042     CenterX - Round (FMaxiHexWidth) * 4,
4043     CenterY - Round (FMaxiHexHeight) * 4,
4044     CenterX + Round (FMaxiHexWidth) * 4,
4045     CenterY + Round (FMaxiHexHeight) * 4);
4046     FBitmap.Canvas.Ellipse (
4047     CenterX - Round (FMaxiHexWidth * 2.5),
4048     CenterY - Round (FMaxiHexHeight * 2.5),
4049     CenterX + Round (FMaxiHexWidth * 2.5),
4050     CenterY + Round (FMaxiHexHeight * 2.5));
4051     FBitmap.Canvas.Ellipse (
4052     CenterX - Round (FMaxiHexWidth),
4053     CenterY - Round (FMaxiHexHeight),
4054     CenterX + Round (FMaxiHexWidth),
4055     CenterY + Round (FMaxiHexHeight));
4056    
4057     if FHighlight then begin
4058     FBitmap.Canvas.Pen.Width := 1;
4059     FBitmap.Canvas.Pen.Color := clRed;
4060     FBitmap.Canvas.MoveTo (CenterX, 0);
4061     FBitmap.Canvas.LineTo (CenterX, Height);
4062     FBitmap.Canvas.MoveTo (0, CenterY);
4063     FBitmap.Canvas.LineTo (Width, CenterY);
4064     end;
4065    
4066     FBitmap.Canvas.Pen.Width := 1;
4067     FBitmap.Canvas.Brush.Color := Color;
4068     end;
4069    
4070     procedure TStMaxiCodeBarcode.DrawHex (XPos, YPos : Integer);
4071     var
4072     XOffset : Integer;
4073     YOffset : Integer;
4074     HexWidth : Integer;
4075     HexHeight : Integer;
4076     Border : Extended;
4077    
4078     begin
4079     XOffset := BarCodeRect.Left + XPos;
4080     YOffset := BarCodeRect.Top + YPos;
4081     Border := ((FMaxiHexWidth + 1) / 8) + 1;
4082     if FMaxiHexWidth >= 4 then begin
4083     XOffset := Round (XOffset + Border);
4084     YOffset := Round (YOffset + Border);
4085     HexWidth := Round (FMaxiHexWidth - Border);
4086     HexHeight := Round (FMaxiHexHeight - Border);
4087     end else begin
4088     HexWidth := Round (FMaxiHexWidth);
4089     HexHeight := Round (FMaxiHexHeight);
4090     end;
4091    
4092     if (HexWidth < 4) or (HexHeight < 4) then
4093     { Ellipses look better at poorer resolutions }
4094     FBitmap.Canvas.Ellipse (XOffset, YOffset,
4095     XOffset + HexWidth, YOffset + HexHeight)
4096     else begin
4097     { Better resolution, draw a hex }
4098     FBitmap.Canvas.MoveTo (XOffset + HexWidth div 2,
4099     YOffset);
4100     FBitmap.Canvas.LineTo (XOffset + HexWidth,
4101     YOffset + HexHeight div 4);
4102     FBitmap.Canvas.LineTo (XOffset + HexWidth,
4103     YOffset + HexHeight - (HexHeight div 4));
4104     FBitmap.Canvas.LineTo (XOffset + HexWidth div 2,
4105     YOffset + HexHeight);
4106     FBitmap.Canvas.LineTo (XOffset,
4107     YOffset + HexHeight - (HexHeight div 4));
4108     FBitmap.Canvas.LineTo (XOffset,
4109     YOffset + HexHeight div 4);
4110     FBitmap.Canvas.LineTo (XOffset + HexWidth div 2,
4111     YOffset);
4112    
4113     FBitmap.Canvas.FloodFill (XOffset + HexWidth div 2,
4114     YOffset + HexWidth div 2,
4115     BackgroundColor,
4116     fsSurface);
4117     end;
4118     end;
4119    
4120     procedure TStMaxiCodeBarcode.GenerateCodewords;
4121     begin
4122     TextToCodewords;
4123     end;
4124    
4125     procedure TStMaxiCodeBarcode.GenerateECC;
4126     { Calculate the ECC codes for MaxiCode }
4127    
4128     function GFSum (a : Integer; b : Integer) : Integer;
4129     { Sum of two numbers in Galois field arithmetic }
4130     begin
4131     Result := a xor b;
4132     end;
4133    
4134     function GfDifference (a : Integer; b : Integer) : Integer;
4135     { difference between two numbers in Galois field arithmetic (included for
4136     completeness) }
4137     begin
4138     Result := a xor b;
4139     end;
4140    
4141     function GFProduct (a : Integer; b : Integer) : Integer;
4142     { Product of two numbers in Galois field arithmetic }
4143     begin
4144     if (a = 0) or (b = 0) then
4145     Result := 0
4146     else
4147     Result := FAntiLog[(FLog[a] + FLog[b]) mod (StMaxiCodeGaloisField - 1)];
4148     end;
4149    
4150     function GFQuotient (a : Integer; b : Integer) : Integer;
4151     { Division of two numbers in Galois field arithmetic (included for
4152     completeness ) }
4153     begin
4154     if b = 0 then
4155     Result := 1 - StMaxiCodeGaloisField
4156     else if a = 0 then
4157     Result := 0
4158     else
4159     Result := FAntiLog[(FLog[a] - FLog[b] +
4160     (StMaxiCodeGaloisField - 1)) mod (StMaxiCodeGaloisField - 1)];
4161     end;
4162    
4163     procedure FillLogArrays (StMaxiCodeGaloisField : Integer;
4164     StMaxiCodeECCPoly : Integer);
4165     { Populate the log and antilog tables for Galois field arithmetic }
4166     var
4167     i : Integer;
4168    
4169     begin
4170     FLog[0] := 1 - StMaxiCodeGaloisField;
4171     FAntiLog[0] := 1;
4172     for i := 1 to StMaxiCodeGaloisField - 1 do begin
4173     FAntiLog[i] := FAntiLog[i - 1] * 2;
4174     if FAntiLog[i] >= StMaxiCodeGaloisField then
4175     FAntiLog[i] := FAntiLog[i] xor StMaxiCodeECCPoly;
4176     FLog[FAntiLog[i]] := i;
4177     end;
4178     end;
4179    
4180     procedure CalculateECCCodes (var Data : TStMaxiCodeECCData;
4181     Polynomial : TStMaxiCodeECCPoly;
4182     IStart : TStMaxiCodeECCInterleave);
4183     { Calculate the Reed-Solomon error correcting codes (ECC) for MaxiCode.
4184     Basically, this is the equivalent of taking the Data as a series of
4185     coefficients to a polynomial (that has the lowest power the same as the
4186     highest power of the generating polynomial) and dividing it by the
4187     generating polynomial using Galois field arithmetic. Get the remainder of
4188     this division and use that as the Reed Solomon error correcting codes }
4189    
4190     const
4191     { Generating polynomials }
4192     GPrimary : array [0..10] of Integer =
4193     (46, 44, 49, 3, 2, 57, 42, 39, 28, 31, 1);
4194     GEnhanced : array [0..28] of Integer =
4195     (28, 11, 20, 7, 43, 9, 41, 34, 49, 46, 37, 40, 55, 34, 45, 61, 13, 23,
4196     29, 22, 10, 35, 55, 41, 10, 53, 45, 22, 1);
4197     GStandard : array [0..20] of Integer =
4198     (59, 23, 19, 31, 33, 38, 17, 22, 48, 15, 36, 57, 37, 22, 8, 27, 33, 11,
4199     44, 23, 1);
4200    
4201     var
4202     BRegisters : TStMaxiCodeECCData; { Works space for calculating RS ECC }
4203     DataPos : Integer; { Position for data read/writes }
4204     i : Integer;
4205     j : Integer;
4206     SumFromLast : Integer; { Result of input data + Last BReg }
4207     GenPolyMult : Integer; { Input data (SumFromLast) * gen poly }
4208     NumCodewords : Integer; { Number of ECC codewords to generate }
4209     Interleaved : Boolean; { Read all data or alternate chars }
4210     StartingPos : Integer; { Where to start reading from }
4211     DataLength : Integer; { Amount of data to read }
4212     OutDataPos : Integer; { Where to write ECC to }
4213    
4214     begin
4215     { Intialize where to get data, write data, what poly to use, etc.. based
4216     from the Polynomial used and whether or not the even characters or
4217     odd characters are being encoded. }
4218     case Polynomial of
4219     epStandard :
4220     { Standard Error Correction }
4221     begin
4222     NumCodewords := 20;
4223     Interleaved := True;
4224     if IStart = imOdd then begin
4225     StartingPos := 20;
4226     OutDataPos := 104;
4227     end else begin
4228     StartingPos := 21;
4229     OutDataPos := 105;
4230     end;
4231     DataLength := 42;
4232     end;
4233     epEnhanced :
4234     begin
4235     { Enhanced Error Correction }
4236     NumCodewords := 28;
4237     Interleaved := True;
4238     if IStart = imOdd then begin
4239     StartingPos := 20;
4240     OutDataPos := 88;
4241     end else begin
4242     StartingPos := 21;
4243     OutDataPos := 89;
4244     end;
4245     DataLength := 34;
4246     end
4247     else begin
4248     { Primary Message }
4249     NumCodewords := 10;
4250     Interleaved := False;
4251     StartingPos := 0;
4252     OutDataPos := 10;
4253     DataLength := 10;
4254     end;
4255     end;
4256    
4257     { Initialize all the BRegisters }
4258     for i := 0 to StMaxMaxiCodeECCDataSize do
4259     BRegisters[i] := 0;
4260    
4261     { Calculate the Log and AntiLog tables }
4262     FillLogArrays (StMaxiCodeGaloisField, StMaxiCodeECCPoly);
4263    
4264     DataPos := StartingPos;
4265    
4266     { Divide the polynomials and store the results in the BRegisters }
4267     for i := 0 to DataLength - 1 do begin
4268     SumFromLast := GFSum (BRegisters[NumCodewords - 1], Data[DataPos]);
4269     for j := NumCodewords - 1 downto 0 do begin
4270     case Polynomial of
4271     epStandard :
4272     GenPolyMult := GFProduct (SumFromLast, GStandard[j]);
4273     epEnhanced :
4274     GenPolyMult := GFProduct (SumFromLast, GEnhanced[j]);
4275     else
4276     GenPolyMult := GFProduct (SumFromLast, GPrimary[j]);
4277     end;
4278     if j > 0 then
4279     BRegisters[j] := GFSum (BRegisters[j - 1], GenPolyMult)
4280     else
4281     BRegisters[j] := GenPolyMult;
4282     end;
4283     if Interleaved then
4284     Inc (DataPos, 2)
4285     else
4286     Inc (DataPos);
4287     end;
4288    
4289     { Write the ECC values back into the data }
4290     DataPos := OutDataPos;
4291     for i := NumCodewords - 1 downto 0 do begin
4292     Data[DataPos] := BRegisters[i];
4293     if Interleaved then
4294     Inc (DataPos, 2)
4295     else
4296     Inc (DataPos);
4297     end;
4298     end;
4299    
4300     begin
4301     { Calculate ECC codes for MaxiCode }
4302    
4303     CalculateECCCodes (FCodewords, epPrimary, imNone);
4304     if Mode = cmMode5 then begin
4305     CalculateECCCodes (FCodewords, epEnhanced, imEven);
4306     CalculateECCCodes (FCodewords, epEnhanced, imOdd);
4307     end else begin
4308     CalculateECCCodes (FCodewords, epStandard, imEven);
4309     CalculateECCCodes (FCodewords, epStandard, imOdd);
4310     end;
4311     end;
4312    
4313     procedure TStMaxiCodeBarcode.GetNextCharacter (var NewChar : Integer;
4314     var Codeword : Boolean;
4315     var Position : Integer;
4316     CodeLen : Integer);
4317     var
4318     WorkNum : Integer;
4319    
4320     begin
4321     NewChar := 0;
4322     Codeword := False;
4323    
4324     if Position <= CodeLen then begin
4325     if (FCode[Position] = '\') and
4326     (Position < CodeLen) then begin
4327     case FCode[Position + 1] of
4328     '0'..'9' : begin
4329     try
4330     NewChar := StrToInt (Copy (FCode, Position + 1, 3));
4331     Inc (Position, 4);
4332     except
4333     NewChar := 0;
4334     Inc (Position, 4);
4335     end;
4336     end;
4337     'C', 'c' : begin
4338     try
4339     Codeword := True;
4340     NewChar := StrToInt (Copy (FCode, Position + 2, 2));
4341     Inc (Position, 4);
4342     except
4343     NewChar := 0;
4344     Inc (Position, 4);
4345     end;
4346     end;
4347     'E', 'e' : begin
4348     if UpperCase (Copy (FCode, Position + 1, 3)) = 'EOT' then begin
4349     NewChar := 4;
4350     Inc (Position, 4);
4351     end else
4352     try
4353     WorkNum := StrToInt (Copy (FCode, Position + 1, 6));
4354     AddCodeword (27);
4355     Codeword := True;
4356     Inc (Position, 8);
4357     if (WorkNum >= 0) and (WorkNum <= 31) then begin
4358     NewChar := WorkNum;
4359     end else if (WorkNum >= 32) and (WorkNum <= 1023) then begin
4360     AddCodeword ($20 or (WorkNum div 64));
4361     NewChar := WorkNum mod 64;
4362     end else if (WorkNum >= 1024) and (WorkNum <= 32767) then begin
4363     AddCodeword ($30 or (WorkNum div 4096));
4364     WorkNum := WorkNum mod 4096;
4365     AddCodeword (WorkNum div 64);
4366     NewChar := WorkNum mod 64;
4367     end else if (WorkNum >= 32768) and (WorkNum <= 999999) then begin
4368     AddCodeword ($38 or (WorkNum div 262144));
4369     WorkNum := WorkNum mod 262144;
4370     AddCodeword (WorkNum div 64);
4371     WorkNum := WorkNum mod 4096;
4372     AddCodeword (WorkNum div 64);
4373     NewChar := WorkNum mod 64;
4374     end else
4375     raise E2DBarcodeError.Create (StEGLIOutOfRange);
4376     except
4377     on EConvertError do begin
4378     NewChar := Byte (FCode[Position]);
4379     Inc (Position);
4380     end;
4381     end;
4382     end;
4383     'F', 'f', 'G', 'g', 'N', 'n', 'R', 'r' : begin
4384     if Position < CodeLen - 1 then begin
4385     if (FCode[Position + 2] = 'S') or
4386     (FCode[Position + 2] = 's') then begin
4387     case FCode[Position + 1] of
4388     'F', 'f' : NewChar := 28;
4389     'G', 'g' : NewChar := 29;
4390     'N', 'n' : begin
4391     NewChar := 31;
4392     Codeword := True;
4393     end;
4394     'R', 'r' : NewChar := 30;
4395     end;
4396     Inc (Position, 3);
4397     end else begin
4398     NewChar := Byte (FCode[Position]);
4399     Inc (Position);
4400     end;
4401     end else begin
4402     NewChar := Byte (FCode[Position]);
4403     Inc (Position);
4404     end;
4405     end;
4406     'X', 'x' : begin
4407     try
4408     NewChar := StrToInt ('$' + Copy (FCode, Position + 2, 2));
4409     Inc (Position, 4);
4410     except
4411     NewChar := 0;
4412     Inc (Position, 4);
4413     end;
4414     end;
4415     '\' : begin
4416     NewChar := Byte (FCode[Position]);
4417     Inc (Position, 2);
4418     end;
4419     else begin
4420     NewChar := Byte (FCode[Position]);
4421     Inc (Position);
4422     end;
4423     end;
4424     end else begin
4425     NewChar := Byte (FCode[Position]);
4426     Inc (Position);
4427     end;
4428     end;
4429     end;
4430    
4431     procedure TStMaxiCodeBarcode.GetSizes;
4432     var
4433     ResX : Integer;
4434     ResY : Integer;
4435    
4436     begin
4437     ResX := GetDeviceCaps (FBitmap.Canvas.Handle, LOGPIXELSX);
4438     ResY := GetDeviceCaps (FBitmap.Canvas.Handle, LOGPIXELSY);
4439     GetSizesEx (ResX, ResY);
4440     end;
4441    
4442     procedure TStMaxiCodeBarcode.GetSizesEx (ResX : Integer; ResY : Integer);
4443     begin
4444     if FAutoScale then begin
4445     FMaxiHexWidth := (ResX * 1.003937) / 29; { Width is 1.00" }
4446     FMaxiHexHeight := (ResY * 0.959449) /29; { Height is 0.96" }
4447     FMaxiHexVOffset := -1 * (FMaxiHexHeight / 6);
4448     FMaxiHexHOffset := FMaxiHexWidth / 2;
4449     end else begin
4450     if BarWidth <> 0 then
4451     FMaxiHexWidth := BarWidth
4452     else
4453     FMaxiHexWidth := (FHorPixelsPerMM * 27) / 29;
4454     if BarHeight <> 0 then
4455     FMaxiHexHeight := BarHeight
4456     else
4457     FMaxiHexHeight := Round (FVerPixelsPerMM * 25) / 29;
4458     FMaxiHexVOffset := -1 * (FMaxiHexHeight / 6);
4459     FMaxiHexHOffset := FMaxiHexWidth / 2;
4460     end;
4461     end;
4462    
4463     procedure TStMaxiCodeBarcode.PlotCell (Row : Integer; Col : Integer);
4464     var
4465     XPos : Integer;
4466     YPos : Integer;
4467    
4468     begin
4469     YPos := Round (Row * FMaxiHexHeight + Row * FMaxiHexVOffset);
4470     if (Row mod 2) <> 0 then
4471     XPos := Round (FMaxiHexHOffset + FMaxiHexWidth * Col)
4472     else
4473     XPos := Round (FMaxiHexWidth * Col);
4474     DrawHex (XPos, YPos);
4475     end;
4476    
4477     procedure TStMaxiCodeBarcode.RenderToResolution (var OutBitmap : TBitmap;
4478     ResX : Integer;
4479     ResY : Integer;
4480     var SizeX : Integer;
4481     var SizeY : Integer);
4482     var
4483     OldBarWidth : Integer;
4484     OldBarHeight : Integer;
4485     OldHorPixelsPerMM : Extended;
4486     OldVerPixelsPerMM : Extended;
4487     OldWidth : Integer;
4488     OldHeight : Integer;
4489     CurResX : Integer;
4490     CurResY : Integer;
4491     MultX : Extended;
4492     MultY : Extended;
4493     OldPPI : Integer;
4494    
4495     begin
4496     OldBarWidth := BarWidth;
4497     OldBarHeight := BarHeight;
4498     OldHorPixelsPerMM := FHorPixelsPerMM;
4499     OldVerPixelsPerMM := FVerPixelsPerMM;
4500     OldWidth := Width;
4501     OldHeight := Height;
4502     SizeX := Width;
4503     SizeY := Height;
4504     try
4505     if (ResX <> 0) and (ResY <> 0) then begin
4506     GetCurrentResolution (CurResX, CurResY);
4507     MultX := ResX / CurResX;
4508     MultY := ResY / CurResY;
4509    
4510     FBarWidth := Trunc (FBarWidth * MultX);
4511     FBarHeight := Trunc (FBarHeight * MultX);
4512     FHorPixelsPerMM := FHorPixelsPerMM * MultX;
4513     FVerPixelsPerMM := FVerPixelsPerMM * MultX;
4514     GetSizesEx (ResX, ResY);
4515     FBitmap.Width := Trunc (FBitmap.Width * MultX);
4516     FBitmap.Height := Trunc (FBitmap.Height * MultY);
4517    
4518     SizeX := FBitmap.Width;
4519     SizeY := FBitmap.Height;
4520     end;
4521     OldPPI := FBitmap.Canvas.Font.PixelsPerInch;
4522     try
4523     FBitmap.Canvas.Font.PixelsPerInch := OutBitmap.Canvas.Font.PixelsPerInch;
4524     GenerateBarcodeBitmap (FBitmap.Width, FBitmap.Height);
4525     finally
4526     FBitmap.Canvas.Font.PixelsPerInch := OldPPI;
4527     end;
4528     OutBitmap.Width := SizeX;
4529     OutBitmap.Height := SizeY;
4530     OutBitmap.Canvas.CopyRect (Rect (0, 0, SizeX, SizeY), FBitmap.Canvas,
4531     Rect (0, 0, SizeX, SizeY));
4532     finally
4533     FBarWidth := OldBarWidth;
4534     FBarHeight := OldBarHeight;
4535     FHorPixelsPerMM := OldHorPixelsPerMM;
4536     FVerPixelsPerMM := OldVerPixelsPerMM;
4537     FBitmap.Width := OldWidth;
4538     FBitmap.Height := OldHeight;
4539     GetSizes;
4540     GenerateBarcodeBitmap (Width, Height);
4541     end;
4542     end;
4543    
4544     procedure TStMaxiCodeBarcode.SetAutoScale (const v : Boolean);
4545     var
4546     OldAutoScale : Boolean;
4547    
4548     begin
4549     if v <> FAutoScale then begin
4550     OldAutoScale := FAutoScale;
4551     try
4552     if (BarHeight = 0) and (HorPixelsPerMM = 0) and (not v) then
4553     raise E2DBarcodeError.Create (StENeedHorz);
4554     if (BarWidth = 0) and (VerPixelsPerMM = 0) and (not v) then
4555     raise E2DBarcodeError.Create (StENeedVert);
4556     FAutoScale := v;
4557     GetSizes;
4558     GenerateBarcodeBitmap (Width, Height);
4559     Invalidate;
4560     except
4561     on E2DBarcodeError do begin
4562     FAutoScale := OldAutoScale;
4563     try
4564     GetSizes;
4565     GenerateBarcodeBitmap (Width, Height);
4566     Invalidate;
4567     except
4568     on E2DBarcodeError do begin
4569     end;
4570     end;
4571     raise
4572     end;
4573     end;
4574     end;
4575     end;
4576    
4577     procedure TStMaxiCodeBarcode.SetBarHeight (const v : Integer);
4578     begin
4579     if (v = 0) and (VerPixelsPerMM = 0) and (not AutoScale) then
4580     raise E2DBarcodeError.Create (StENeedVert);
4581     inherited SetBarHeight (v);
4582     GetSizes;
4583     GenerateBarcodeBitmap (Width, Height);
4584     Invalidate;
4585     end;
4586    
4587     procedure TStMaxiCodeBarcode.SetBarWidth (const v : Integer);
4588     begin
4589     if (v = 0) and (HorPixelsPerMM = 0) and (not AutoScale) then
4590     raise E2DBarcodeError.Create (StENeedHorz);
4591     inherited SetBarWidth (v);
4592     GetSizes;
4593     GenerateBarcodeBitmap (Width, Height);
4594     Invalidate;
4595     end;
4596    
4597     procedure TStMaxiCodeBarcode.SetCarrierCountryCode (const v : Integer);
4598     var
4599     OldCarrierCountryCode : Integer;
4600    
4601     begin
4602     if v <> FCarrierCountryCode then begin
4603     OldCarrierCountryCode := FCarrierCountryCode;
4604     try
4605     FCarrierCountryCode := v;
4606     if (FMode = cmMode2) or (FMode = cmMode3) then begin
4607     GenerateCodewords;
4608     GenerateBarcodeBitmap (Width, Height);
4609     Invalidate;
4610     end;
4611     except
4612     on E2DBarcodeError do begin
4613     FCarrierCountryCode := OldCarrierCountryCode;
4614     try
4615     GenerateCodewords;
4616     GenerateBarcodeBitmap (Width, Height);
4617     Invalidate;
4618     except
4619     on E2DBarcodeError do begin
4620     end;
4621     end;
4622     raise
4623     end;
4624     end;
4625     end;
4626     end;
4627    
4628     procedure TStMaxiCodeBarcode.SetCarrierPostalCode (const v : string);
4629     var
4630     OldCarrierPostalCode : string;
4631    
4632     begin
4633     if v <> FCarrierPostalCode then begin
4634     OldCarrierPostalCode := FCarrierPostalCode;
4635     try
4636     FCarrierPostalCode := v;
4637     if (FMode = cmMode2) or (FMode = cmMode3) then begin
4638     GenerateCodewords;
4639     GenerateBarcodeBitmap (Width, Height);
4640     Invalidate;
4641     end;
4642     except
4643     on E2DBarcodeError do begin
4644     FCarrierPostalCode := OldCarrierPostalCode;
4645     try
4646     GenerateCodewords;
4647     GenerateBarcodeBitmap (Width, Height);
4648     Invalidate;
4649     except
4650     on E2DBarcodeError do begin
4651     end;
4652     end;
4653     raise
4654     end;
4655     end;
4656     end;
4657     end;
4658    
4659     procedure TStMaxiCodeBarcode.SetCarrierServiceClass (const v : Integer);
4660     var
4661     OldCarrierServiceClass : Integer;
4662    
4663     begin
4664     if v <> FCarrierServiceClass then begin
4665     OldCarrierServiceClass := FCarrierServiceClass;
4666     try
4667     FCarrierServiceClass := v;
4668     if (FMode = cmMode2) or (FMode = cmMode3) then begin
4669     GenerateCodewords;
4670     GenerateBarcodeBitmap (Width, Height);
4671     Invalidate;
4672     end;
4673     except
4674     on E2DBarcodeError do begin
4675     FCarrierServiceClass := OldCarrierServiceClass;
4676     try
4677     GenerateCodewords;
4678     GenerateBarcodeBitmap (Width, Height);
4679     Invalidate;
4680     except
4681     on E2DBarcodeError do begin
4682     end;
4683     end;
4684     raise
4685     end;
4686     end;
4687     end;
4688     end;
4689    
4690     procedure TStMaxiCodeBarcode.SetHorPixelsPerMM (const v : Extended);
4691     var
4692     OldHorPixelsPerMM : Extended;
4693    
4694     begin
4695     if v <> FHorPixelsPerMM then begin
4696     if (v = 0) and (BarWidth = 0) and (not AutoScale) then
4697     raise E2DBarcodeError.Create (StENeedHorz);
4698     OldHorPixelsPerMM := FHorPixelsPerMM;
4699     try
4700     FHorPixelsPerMM := v;
4701     GetSizes;
4702     GenerateBarcodeBitmap (Width, Height);
4703     Invalidate;
4704     except
4705     on E2DBarcodeError do begin
4706     FHorPixelsPerMM := OldHorPixelsPerMM;
4707     try
4708     GetSizes;
4709     GenerateBarcodeBitmap (Width, Height);
4710     Invalidate;
4711     except
4712     on E2DBarcodeError do begin
4713     end;
4714     end;
4715     raise
4716     end;
4717     end;
4718     end;
4719     end;
4720    
4721     procedure TStMaxiCodeBarcode.SetMode (const v : TStMaxiCodeMode);
4722     var
4723     OldMode : TStMaxiCodeMode;
4724    
4725     begin
4726     if v <> FMode then begin
4727     OldMode := Mode;
4728     try
4729     FMode := v;
4730     GenerateCodewords;
4731     GenerateBarcodeBitmap (Width, Height);
4732     Invalidate;
4733     except
4734     on E2DBarcodeError do begin
4735     FMode := OldMode;
4736     try
4737     GenerateCodewords;
4738     GenerateBarcodeBitmap (Width, Height);
4739     Invalidate;
4740     except
4741     on E2DBarcodeError do begin
4742     end;
4743     end;
4744     raise
4745     end;
4746     end;
4747     end;
4748     end;
4749    
4750     procedure TStMaxiCodeBarcode.SetVerPixelsPerMM (const v : Extended);
4751     var
4752     OldVerPixelsPerMM : Extended;
4753    
4754     begin
4755     if v <> FVerPixelsPerMM then begin
4756     if (v = 0) and (BarHeight = 0) and (not AutoScale) then
4757     raise E2DBarcodeError.Create (StENeedVert);
4758     OldVerPixelsPerMM := FVerPixelsPerMM;
4759     try
4760     FVerPixelsPerMM := v;
4761     GetSizes;
4762     GenerateBarcodeBitmap (Width, Height);
4763     Invalidate;
4764     except
4765     on E2DBarcodeError do begin
4766     FVerPixelsPerMM := OldVerPixelsPerMM;
4767     try
4768     GetSizes;
4769     GenerateBarcodeBitmap (Width, Height);
4770     Invalidate;
4771     except
4772     on E2DBarcodeError do begin
4773     end;
4774     end;
4775     raise
4776     end;
4777     end;
4778     end;
4779     end;
4780    
4781     procedure TStMaxiCodeBarcode.TextToCodewords;
4782    
4783    
4784     function FindCodeSet (Value : Char) : TStMaxiCodeCodeSet;
4785     begin
4786     Result := csCodeSetA;
4787     while Result < csNone do begin
4788     if StMaxiCodeCodeSets[Result][Integer (Value)] <> -1 then
4789     Exit;
4790     Inc (Result);
4791     end;
4792     Result := csNone;
4793     end;
4794    
4795     function ChangeCodeSet (CurrentMode : TStMaxiCodeCodeSet;
4796     NewMode : TStMaxiCodeCodeSet;
4797     Value : Char;
4798     UseShift : Boolean;
4799     UseTwoShift : Boolean;
4800     UseThreeShift : Boolean) : TStMaxiCodeCodeSet;
4801     const
4802     ShiftAB = 59;
4803     ShiftAC = 60;
4804     ShiftAD = 61;
4805     ShiftAE = 62;
4806     LatchAB = 63;
4807    
4808     Shift2BA = 56;
4809     Shift3BA = 57;
4810     ShiftBA = 59;
4811     ShiftBC = 60;
4812     ShiftBD = 61;
4813     ShiftBE = 62;
4814     LatchBA = 63;
4815    
4816     LatchCA = 58;
4817     LockC = 60;
4818     ShiftCD = 61;
4819     ShiftCE = 62;
4820     LatchCB = 63;
4821    
4822     LatchDA = 58;
4823     ShiftDC = 60;
4824     LockD = 61;
4825     ShiftDE = 62;
4826     LatchDB = 63;
4827    
4828     LatchEA = 58;
4829     ShiftEC = 60;
4830     ShiftED = 61;
4831     LockE = 62;
4832     LatchEB = 63;
4833    
4834     begin
4835     if UseShift then
4836     Result := CurrentMode
4837     else
4838     Result := NewMode;
4839    
4840     case CurrentMode of
4841     csCodeSetA :
4842     case NewMode of
4843     csCodeSetB :
4844     { A -> B }
4845     if UseShift then
4846     AddCodeword (ShiftAB)
4847     else
4848     AddCodeword (LatchAB);
4849     csCodeSetC :
4850     { A -> C }
4851     begin
4852     AddCodeword (ShiftAC);
4853     if not UseShift then
4854     AddCodeword (LockC);
4855     end;
4856     csCodeSetD :
4857     { A -> D }
4858     begin
4859     AddCodeword (ShiftAD);
4860     if not UseShift then
4861     AddCodeword (LockD);
4862     end;
4863     csCodeSetE :
4864     { A -> E }
4865     begin
4866     AddCodeword (ShiftAE);
4867     if not UseShift then
4868     AddCodeword (LockE);
4869     end;
4870     end;
4871    
4872     csCodeSetB :
4873     case NewMode of
4874     csCodeSetA :
4875     { B -> A }
4876     if UseThreeShift then
4877     AddCodeword (Shift3BA)
4878     else if UseTwoShift then
4879     AddCodeword (Shift2BA)
4880     else if UseShift then
4881     AddCodeword (ShiftBA)
4882     else
4883     AddCodeword (LatchBA);
4884     csCodeSetC :
4885     { B -> C }
4886     begin
4887     AddCodeword (ShiftBC);
4888     if not UseShift then
4889     AddCodeword (LockC);
4890     end;
4891     csCodeSetD :
4892     { B -> D }
4893     begin
4894     AddCodeword (ShiftBD);
4895     if not UseShift then
4896     AddCodeword (LockD);
4897     end;
4898     csCodeSetE :
4899     { B -> E }
4900     begin
4901     AddCodeword (ShiftBE);
4902     if not UseShift then
4903     AddCodeword (LockE);
4904     end;
4905     end;
4906    
4907     csCodeSetC :
4908     case NewMode of
4909     csCodeSetA :
4910     { C -> A }
4911     begin
4912     AddCodeword (LatchCA);
4913     Result := NewMode;
4914     end;
4915     csCodeSetB :
4916     { C -> B }
4917     begin
4918     AddCodeword (LatchCB);
4919     Result := NewMode;
4920     end;
4921     csCodeSetD :
4922     { C -> D }
4923     begin
4924     AddCodeword (ShiftCD);
4925     if not UseShift then
4926     AddCodeword (LockD);
4927     end;
4928     csCodeSetE :
4929     { C -> E }
4930     begin
4931     AddCodeword (ShiftCE);
4932     if not UseShift then
4933     AddCodeword (LockE);
4934     end;
4935     end;
4936    
4937     csCodeSetD :
4938     case NewMode of
4939     csCodeSetA :
4940     { D -> A }
4941     begin
4942     AddCodeword (LatchDA);
4943     Result := NewMode;
4944     end;
4945     csCodeSetB :
4946     { D -> B }
4947     begin
4948     AddCodeword (LatchDB);
4949     Result := NewMode;
4950     end;
4951     csCodeSetC :
4952     { D -> C }
4953     begin
4954     AddCodeword (ShiftDC);
4955     if not UseShift then
4956     AddCodeword (LockC);
4957     end;
4958     csCodeSetE :
4959     { D -> E }
4960     begin
4961     AddCodeword (ShiftDE);
4962     if not UseShift then
4963     AddCodeword (LockE);
4964     end;
4965     end;
4966    
4967     csCodeSetE :
4968     case NewMode of
4969     csCodeSetA :
4970     { E -> A }
4971     begin
4972     AddCodeword (LatchEA);
4973     Result := NewMode;
4974     end;
4975     csCodeSetB :
4976     { E -> B }
4977     begin
4978     AddCodeword (LatchEB);
4979     Result := NewMode;
4980     end;
4981     csCodeSetC :
4982     { E -> C }
4983     begin
4984     AddCodeword (ShiftEC);
4985     if not UseShift then
4986     AddCodeword (LockC);
4987     end;
4988     csCodeSetD :
4989     { E -> D }
4990     begin
4991     AddCodeword (ShiftED);
4992     if not UseShift then
4993     AddCodeword (LockD);
4994     end;
4995     end;
4996     end;
4997     end;
4998    
4999     procedure GetMessageCodewords;
5000     var
5001     CodeLen : Integer;
5002     CurrentMode : TStMaxiCodeCodeSet;
5003     UseShift : Boolean;
5004     UseShift2 : Boolean;
5005     UseShift3 : Boolean;
5006     WorkMode : TStMaxiCodeCodeSet;
5007     i : Integer;
5008     Codeword : Boolean;
5009     NewChar : Integer;
5010    
5011     begin
5012     CodeLen := Length (Code);
5013     if CodeLen = 0 then begin
5014     for i := 0 to 144 do
5015     AddCodeword (33);
5016     Exit;
5017     end;
5018     CurrentMode := csCodeSetA;
5019     i := 1;
5020     while i <= CodeLen do begin
5021     GetNextCharacter (NewChar, CodeWord, i, CodeLen);
5022     if CodeWord then
5023     AddCodeword (NewChar)
5024     else if StMaxiCodeCodeSets[CurrentMode][NewChar] = -1 then begin
5025     WorkMode := FindCodeSet (Char (NewChar));
5026     UseShift := False;
5027     UseShift2 := False;
5028     UseShift3 := False;
5029     if i < CodeLen then begin
5030     if StMaxiCodeCodeSets[CurrentMode][Integer (Code[i + 1])] <> -1 then
5031     UseShift := True;
5032     end;
5033     CurrentMode := ChangeCodeSet (CurrentMode, WorkMode, Char (NewChar),
5034     UseShift, UseShift2, UseShift3);
5035     AddCodeword (StMaxiCodeCodeSets[WorkMode][NewChar]);
5036     end else
5037     AddCodeword (StMaxiCodeCodeSets[CurrentMode][NewChar]);
5038     end;
5039    
5040     if (FNumCodewords > 68) and (FMode = cmMode5) then
5041     raise E2DBarcodeError.Create (StECodeTooLarge)
5042     else if FNumCodewords > 84 then
5043     raise E2DBarcodeError.Create (StECodeTooLarge);
5044    
5045     if CodeLen < 144 then begin
5046     if CurrentMode = csCodeSetC then begin
5047     AddCodeword (58);
5048     CurrentMode := csCodeSetA;
5049     end else if CurrentMode = csCodeSetD then begin
5050     AddCodeword (58);
5051     CurrentMode := csCodeSetA;
5052     end;
5053     for i := FNumCodewords to 144 do begin
5054     case CurrentMode of
5055     csCodeSetA :
5056     AddCodeword (33);
5057     csCodeSetB :
5058     AddCodeword (33);
5059     csCodeSetE :
5060     AddCodeword (28);
5061     end;
5062     end;
5063     end;
5064     end;
5065    
5066     procedure MergeCodewords;
5067     begin
5068     case FMode of
5069     cmMode2 :
5070     System.Move (FMessage, FCodewords[20], 84);
5071     cmMode3 :
5072     System.Move (FMessage, FCodewords[20], 84);
5073     cmMode4 :
5074     begin
5075     System.Move (FMessage, FCodeWords[1], 9);
5076     System.Move (FMessage[9], FCodewords[20], 84);
5077     end;
5078     cmMode5 :
5079     begin
5080     System.Move (FMessage, FCodeWords[1], 9);
5081     System.Move (FMessage[9], FCodewords[20], 68);
5082     end;
5083     cmMode6 :
5084     System.Move (FMessage, FCodewords[20], 84);
5085     end;
5086     end;
5087    
5088     function IsNumericPostalCode : Boolean;
5089     var
5090     PostalLen : Integer;
5091     i : Integer;
5092    
5093     begin
5094     Result := True;
5095     i := 1;
5096     PostalLen := Length (FCarrierPostalCode);
5097     while (i <= PostalLen) do
5098     if (FCarrierPostalCode[i] < '0') or
5099     (FCarrierPostalCode[i] > '9') then begin
5100     Result := False;
5101     i := PostalLen + 1;
5102     end else
5103     Inc (i);
5104     end;
5105    
5106     procedure EncodeCarrierInfo;
5107    
5108     { Encodation of the carrier information requires some fairly bizarre
5109     bit manipulation
5110    
5111     Codewords:--------> 111111
5112     111111222222333333444444555555666666777777888888999999000000 C
5113     012345012345012345012345012345012345012345012345012345012345012345 W
5114     num: ppMMMMppppppppppppppppppppppppllppppccllllccccccssssccssssssEEE...
5115     an: ppMMMMppppppppppppppppppppppppppppppccppppccccccssssccssssssEEE...
5116     123456789012345678901234567890123456789012345678901234567890123456 B
5117     Bits: -----> 111111111122222222223333333333444444444455555555556666666 i
5118     t
5119     MMMM = Mode
5120     pppp = Postal Code
5121     ll = Postal Code Length
5122     cccc = Country Code
5123     ssss = Service Class
5124     EEEE = ECC Codes
5125    
5126     For pppp, ll, cccc and ssss, the MSB is on the right.
5127     }
5128    
5129     var
5130     WorkNum : Integer;
5131     WorkStr : string;
5132     i : Integer;
5133    
5134     begin
5135     for WorkNum := 2 to 10 do
5136     FCodewords[WorkNum] := 0;
5137     FCodewords[0] := FCodewords[0] and $0f;
5138    
5139     if FCodewords[0] = $02 then begin
5140     { Format numeric postal code }
5141     { Format the postal code length }
5142     WorkNum := Length (FCarrierPostalCode);
5143     FCodewords[6] := (WorkNum and $3c) shr 2;
5144     FCodewords[5] := (WorkNum and $03) shl 4;
5145     { Format the postal code }
5146     try
5147     WorkNum := StrToInt (FCarrierPostalCode);
5148     except
5149     on EConvertError do
5150     raise E2DBarcodeError.Create (StEBadPostalCode);
5151     end;
5152     FCodewords[5] := FCodewords[5] or ((WorkNum shr 26) and $0f);
5153     FCodewords[4] := (WorkNum shr 20) and $3f;
5154     FCodewords[3] := (WorkNum shr 14) and $3f;
5155     FCodewords[2] := (WorkNum shr 8) and $3f;
5156     FCodewords[1] := (WorkNum shr 2) and $3f;
5157     FCodewords[0] := FCodewords[0] or ((WorkNum and $03) shl 4);
5158     end else begin
5159     { Format alphanumeric postal code }
5160     WorkStr := UpperCase (FCarrierPostalCode) + ' ';
5161     for i := 0 to 5 do begin
5162     WorkNum := StMaxiCodeCodeSets[csCodeSetA][Integer (WorkStr[6 - i])];
5163     if WorkNum < 0 then
5164     WorkNum := StMaxiCodeCodeSets[csCodeSetA][32]; { Use a space }
5165     FCodewords[i] := FCodewords[i] or ((WorkNum and $03) shl 4);
5166     FCodewords[i + 1] := FCodewords[i + 1] or ((WorkNum and $3c) shr 2);
5167     end;
5168     end;
5169    
5170     { Format country code }
5171     WorkNum := FCarrierCountryCode;
5172     FCodewords[8] := (WorkNum shr 8) and $03;
5173     FCodewords[7] := (WorkNum shr 2) and $3f;
5174     FCodewords[6] := FCodewords[6] or ((WorkNum and $03) shl 4);
5175    
5176     { Format service class }
5177     WorkNum := FCarrierServiceClass;
5178     FCodewords[9] := (WorkNum and $3f0) shr 4;
5179     FCodewords[8] := FCodewords[8] or ((WorkNum and $0f) shl 2);
5180     end;
5181    
5182     var
5183     i : Integer;
5184    
5185     begin
5186     for i := 0 to 144 do begin
5187     FCodewords[i] := 0;
5188     FMessage[i] := 0;
5189     end;
5190    
5191     FNumCodewords := 0;
5192    
5193     { Encode the primary message and set the FNumCodewords to the begining
5194     of the secondary message }
5195    
5196     case FMode of
5197     cmMode2, cmMode3 :
5198     if IsNumericPostalCode then
5199     FCodewords[0] := $02
5200     else
5201     FCodewords[0] := $03;
5202     cmMode4 :
5203     FCodewords[0] := $04;
5204     cmMode5 :
5205     FCodewords[0] := $05;
5206     cmMode6 :
5207     FCodewords[0] := $06;
5208     end;
5209    
5210     if (FMode = cmMode2) or (FMode = cmMode3) then
5211     EncodeCarrierInfo;
5212    
5213     GetMessageCodewords;
5214     MergeCodewords;
5215     GenerateECC;
5216     FNumCodewords := 144;
5217    
5218     FTotalCodewords := 144;
5219     if FMode = cmMode5 then
5220     FUsedECCCodewords := 66
5221     else
5222     FUsedECCCodewords := 50;
5223     case FMode of
5224     cmMode2 :
5225     FUsedCodewords := FNumCodewords + 10;
5226     cmMode3 :
5227     FUsedCodewords := FNumCodewords + 10;
5228     cmMode4 :
5229     FUsedCodewords := FNumCodewords + 1;
5230     cmMode5 :
5231     FUsedCodewords := FNumCodewords + 1;
5232     cmMode6 :
5233     FUsedCodewords := FNumCodewords + 1;
5234     end;
5235    
5236     FFreeCodewords := FTotalCodewords - FUsedCodewords - FUsedECCCodewords;
5237    
5238     end;
5239    
5240     end.
5241    

  ViewVC Help
Powered by ViewVC 1.1.20