1142 lines
38 KiB
ObjectPascal
1142 lines
38 KiB
ObjectPascal
unit frxDelphiMaxiCode;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
{$IFNDEF FPC}Windows,{$ENDIF} Graphics, SysUtils;
|
|
|
|
(* Copyright 2014-2015 Robin Stuart, Daniel Gredler
|
|
*
|
|
* Licensed under the Apache License, Version 2.0 (the "License");
|
|
* you may not use this file except in compliance with the License.
|
|
* You may obtain a copy of the License at
|
|
*
|
|
* http://www.apache.org/licenses/LICENSE-2.0
|
|
*
|
|
* Unless required by applicable law or agreed to in writing, software
|
|
* distributed under the License is distributed on an "AS IS" BASIS,
|
|
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
* See the License for the specific language governing permissions and
|
|
* limitations under the License.
|
|
|
|
* Implements MaxiCode according to ISO 16023:2000.
|
|
*
|
|
* MaxiCode employs a pattern of hexagons around a central 'bulls-eye'
|
|
* finder pattern. Encoding in several modes is supported, but encoding in
|
|
* Mode 2 and 3 require primary messages to be set. Input characters can be
|
|
* any from the ISO 8859-1 (Latin-1) character set.
|
|
*
|
|
* TODO: Add ECI functionality.
|
|
*
|
|
* @author <a href="mailto:rstuart114@gmail.com">Robin Stuart</a>
|
|
* @author Daniel Gredler
|
|
*)
|
|
|
|
type
|
|
TMaxicodeEncoder = class
|
|
private
|
|
FData: WideString;
|
|
FMode: Integer;
|
|
|
|
procedure SetData(const Value: WideString);
|
|
procedure SetMode(const Value: Integer);
|
|
function GetIsBlack(Row, Column: integer): Boolean;
|
|
protected
|
|
FBitmap: TBitmap;
|
|
|
|
procedure Update;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Width: Integer;
|
|
function Height: Integer;
|
|
function GetScanLine(Column: Integer): PByteArray;
|
|
|
|
property IsBlack[Row, Column: integer]: Boolean read GetIsBlack;
|
|
property Data: WideString read FData write SetData;
|
|
property Mode: Integer read FMode write SetMode;
|
|
property Bitmap: TBitmap read FBitmap;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math, Classes, Types, frxUnicodeUtils, frxClass, frxUtils;
|
|
|
|
const
|
|
INK_SPREAD = 0.9;
|
|
OFFSET_X: array[0..5] of Extended = (0.0, 0.866, 0.866, 0.0, -0.866, -0.866);
|
|
OFFSET_Y: array[0..5] of Extended = (1.0, 0.5, -0.5, -1.0, -0.5, 0.5);
|
|
|
|
type
|
|
TLongIntArray = array of LongInt;
|
|
|
|
TMaxiCodeImpl = class
|
|
private
|
|
FStructuredAppendPosition: LongInt;
|
|
FStructuredAppendTotal: LongInt;
|
|
FPrimaryData: AnsiString;
|
|
FHexagonCount: Integer;
|
|
|
|
procedure SetStructuredAppendPosition(const Value: Integer);
|
|
procedure SetStructuredAppendTotal(const Value: Integer);
|
|
function GetHexagonPoint(i, j: Integer): TfrxPoint;
|
|
function GetEllipceCount: Integer;
|
|
function GetEllipseRect(i: Integer): TfrxRect;
|
|
protected
|
|
FMode: Integer;
|
|
eciMode: LongInt;
|
|
FHexagonCenter: array[0..33 * 30] of TfrxPoint;
|
|
FEllipseRect: array[0..2] of TfrxRect;
|
|
codewords: TLongIntArray;
|
|
source: TLongIntArray;
|
|
sourcelen: Integer;
|
|
Fset: array[0..144-1] of LongInt;
|
|
character: array[0..144-1] of LongInt;
|
|
grid: array[0..33-1, 0..30-1] of Boolean;
|
|
|
|
function IsNumeral(str: AnsiString; i: Integer): Boolean;
|
|
function Substring(str: AnsiString; startIndex: Integer; len: Integer = -1): AnsiString;
|
|
function IndexOf(str, substr: AnsiString): integer;
|
|
function IntParse(str: AnsiString; startIndex: Integer = 0; len: Integer = -1): Integer;
|
|
|
|
function processText: Boolean;
|
|
function getPrimaryCodewords: TLongIntArray;
|
|
function getErrorCorrection(codewords: TLongIntArray; ecclen: Integer): TLongIntArray;
|
|
procedure plotSymbol;
|
|
function getMode2PrimaryCodewords(postcode: AnsiString; country, service: Integer): TLongIntArray;
|
|
function getMode3PrimaryCodewords(postcode: AnsiString; country, service: Integer): TLongIntArray;
|
|
function bestSurroundingSet(index, len: Integer; valid: array of Integer): Integer;
|
|
public
|
|
constructor Create;
|
|
|
|
function Encode(inputBytes: AnsiString; Mode: Integer): Boolean;
|
|
function HexagonCenter(Row, Col: Integer): TfrxPoint;
|
|
function HexagonPointByIndex(Center: TfrxPoint; Index: Integer): TfrxPoint;
|
|
|
|
property StructuredAppendPosition: LongInt read FStructuredAppendPosition write SetStructuredAppendPosition;
|
|
property StructuredAppendTotal: LongInt read FStructuredAppendTotal write SetStructuredAppendTotal;
|
|
property PrimaryData: AnsiString read FPrimaryData write FPrimaryData;
|
|
|
|
property HexagonCount: Integer read FHexagonCount;
|
|
property HexagonPoint[i, j: Integer]: TfrxPoint read GetHexagonPoint;
|
|
property EllipceCount: Integer read GetEllipceCount;
|
|
property EllipseRect[i: Integer]: TfrxRect read GetEllipseRect;
|
|
end;
|
|
|
|
TReedSolomon = class
|
|
private
|
|
logmod: LongInt;
|
|
rlen: LongInt;
|
|
logt: TLongIntArray;
|
|
alog: TLongIntArray;
|
|
rspoly: TLongIntArray;
|
|
public
|
|
res: TLongIntArray;
|
|
|
|
function getResult(count: LongInt): LongInt;
|
|
procedure init_gf(poly: LongInt);
|
|
procedure init_code(nsym, index: LongInt);
|
|
procedure encode(len: LongInt; data: TLongIntArray);
|
|
|
|
end;
|
|
|
|
const
|
|
//* MaxiCode module sequence, from ISO/IEC 16023 Figure 5 (30 x 33 data grid).
|
|
MAXICODE_GRID: array [0..990-1] of integer = (
|
|
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, 0, 0,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
410, 409, 404, 403, 398, 397, 392, 391, 80, 79, 0, 0, 14, 13, 38, 37, 3, 0, 45, 44, 110, 109, 386, 385, 380, 379, 374, 373, 829, 0,
|
|
412, 411, 406, 405, 400, 399, 394, 393, 82, 81, 41, 0, 16, 15, 40, 39, 4, 0, 0, 46, 112, 111, 388, 387, 382, 381, 376, 375, 831, 830,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
482, 481, 476, 475, 470, 469, 49, 0, 31, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 54, 53, 464, 463, 458, 457, 452, 451, 838, 0,
|
|
484, 483, 478, 477, 472, 471, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 466, 465, 460, 459, 454, 453, 840, 839,
|
|
486, 485, 480, 479, 474, 473, 52, 51, 32, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 43, 468, 467, 462, 461, 456, 455, 841, 0,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
562, 561, 556, 555, 550, 549, 544, 543, 76, 75, 0, 0, 8, 7, 36, 35, 12, 0, 70, 69, 118, 117, 538, 537, 532, 531, 526, 525, 849, 848,
|
|
564, 563, 558, 557, 552, 551, 546, 545, 78, 77, 0, 34, 10, 9, 26, 25, 0, 0, 72, 71, 120, 119, 540, 539, 534, 533, 528, 527, 850, 0,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
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,
|
|
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
|
|
);
|
|
|
|
//* ASCII character to Code Set mapping, from ISO/IEC 16023 Appendix A.
|
|
//* 1 = Set A, 2 = Set B, 3 = Set C, 4 = Set D, 5 = Set E.
|
|
//* 0 refers to special characters that fit into more than one set (e.g. GS).
|
|
MAXICODE_SET: array [0..256-1] of integer = (
|
|
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 0, 5, 5, 5, 5, 5, 5,
|
|
5, 5, 5, 5, 5, 5, 5, 5, 0, 0, 0, 5, 0, 2, 1, 1, 1, 1, 1, 1,
|
|
1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 2,
|
|
2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
|
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2,
|
|
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
|
|
2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4,
|
|
4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
|
|
5, 4, 5, 5, 5, 5, 5, 5, 4, 5, 3, 4, 3, 5, 5, 4, 4, 3, 3, 3,
|
|
4, 3, 5, 4, 4, 3, 3, 4, 3, 3, 3, 4, 3, 3, 3, 3, 3, 3, 3, 3,
|
|
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
|
|
3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
|
|
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4
|
|
);
|
|
|
|
//* ASCII character to symbol value, from ISO/IEC 16023 Appendix A.
|
|
MAXICODE_SYMBOL_CHAR: array [0..256-1] of integer = (
|
|
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
|
|
20, 21, 22, 23, 24, 25, 26, 30, 28, 29, 30, 35, 32, 53, 34, 35, 36, 37, 38, 39,
|
|
40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 37,
|
|
38, 39, 40, 41, 52, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
|
|
16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 42, 43, 44, 45, 46, 0, 1, 2, 3,
|
|
4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23,
|
|
24, 25, 26, 32, 54, 34, 35, 36, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 47, 48,
|
|
49, 50, 51, 52, 53, 54, 55, 56, 57, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 36,
|
|
37, 37, 38, 39, 40, 41, 42, 43, 38, 44, 37, 39, 38, 45, 46, 40, 41, 39, 40, 41,
|
|
42, 42, 47, 43, 44, 43, 44, 45, 45, 46, 47, 46, 0, 1, 2, 3, 4, 5, 6, 7,
|
|
8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 32,
|
|
33, 34, 35, 36, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
|
|
16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 32, 33, 34, 35, 36
|
|
);
|
|
|
|
{ TMaxiCodeImpl }
|
|
|
|
function TMaxiCodeImpl.bestSurroundingSet(index, len: Integer;
|
|
valid: array of Integer): Integer;
|
|
|
|
function contains(values: array of Integer; value: integer): boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := True;
|
|
for i := 0 to High(values) do
|
|
if values[i] = value then
|
|
Exit;
|
|
Result := False;
|
|
end;
|
|
|
|
var
|
|
option1, option2: Integer;
|
|
begin
|
|
option1 := Fset[index - 1];
|
|
if index + 1 < len then // we have two options to check
|
|
begin
|
|
option2 := Fset[index + 1];
|
|
if contains(valid, option1) and contains(valid, option2) then
|
|
Result := Min(option1, option2)
|
|
else if contains(valid, option1) then
|
|
Result := option1
|
|
else if contains(valid, option2) then
|
|
Result := option2
|
|
else
|
|
Result := valid[0];
|
|
end
|
|
else // we only have one option to check
|
|
begin
|
|
if contains(valid, option1) then
|
|
Result := option1
|
|
else
|
|
Result := valid[0];
|
|
end;
|
|
end;
|
|
|
|
constructor TMaxiCodeImpl.Create;
|
|
const
|
|
radii: array [0..2] of Extended = (9.91, 6.16, 2.37);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FMode := 4;
|
|
|
|
eciMode := 3;
|
|
structuredAppendPosition := 1;
|
|
structuredAppendTotal := 1;
|
|
PrimaryData := '';
|
|
|
|
FHexagonCount := 0;
|
|
|
|
for i := 0 to High(radii) do
|
|
FEllipseRect[i] := frxRect(35.76 - radii[i], 35.60 - radii[i],
|
|
35.76 + radii[i], 35.60 + radii[i]);
|
|
end;
|
|
|
|
function TMaxiCodeImpl.Encode(inputBytes: AnsiString; Mode: Integer): Boolean;
|
|
|
|
function insert(original: TLongIntArray; index: Integer; inserted: TLongIntArray): TLongIntArray;
|
|
|
|
function ArrayCopy(sourceArray: TLongIntArray; sourceIndex: Integer;
|
|
destinationArray: TLongIntArray; destinationIndex, len: Integer): TLongIntArray;
|
|
begin
|
|
Move(sourceArray[sourceIndex], destinationArray[destinationIndex],
|
|
len * SizeOf(sourceArray[0]));
|
|
end;
|
|
|
|
var
|
|
modified: TLongIntArray;
|
|
begin
|
|
SetLength(modified, Length(original) + Length(inserted));
|
|
ArrayCopy(original, 0, modified, 0, index);
|
|
ArrayCopy(inserted, 0, modified, index, Length(inserted));
|
|
ArrayCopy(original, index, modified, index + Length(inserted), Length(modified) - index - Length(inserted));
|
|
result := modified;
|
|
end;
|
|
|
|
var
|
|
i, j, index, secondaryMax, secondaryECMax, totalMax, block, bit: Integer;
|
|
_primary, flag, primary, primaryCheck, secondary, secondaryOdd, secondaryEven,
|
|
secondaryECOdd, secondaryECEven, bit_pattern: TLongIntArray;
|
|
begin
|
|
sourcelen := Length(inputBytes);
|
|
FMode := Mode;
|
|
SetLength(source, sourcelen);
|
|
for i := 0 to sourcelen - 1 do
|
|
source[i] := Ord(inputBytes[i + 1]); // i + 1: delphi string is 1-based
|
|
|
|
// mode 2 -> mode 3 if postal code isn't strictly numeric
|
|
if FMode = 2 then
|
|
for i := 0 to Min(9, Length(PrimaryData) - 1) do
|
|
if not IsNumeral(PrimaryData, i) then
|
|
begin
|
|
FMode := 3;
|
|
Break;
|
|
end;
|
|
|
|
// initialize the set and character arrays
|
|
if not processText then
|
|
raise Exception.Create('Input data too long');
|
|
|
|
// start building the codeword array, starting with a copy of the character data
|
|
// insert primary message if this is a structured carrier message; insert mode otherwise
|
|
SetLength(codewords, Length(character));
|
|
Move(character[0], codewords[0], Length(character) * SizeOf(character[0]));
|
|
if FMode in [2..3] then
|
|
begin
|
|
_primary := getPrimaryCodewords;
|
|
if Length(_primary) = 0 then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
codewords := insert(codewords, 0, _primary);
|
|
end
|
|
else
|
|
begin
|
|
SetLength(_primary, 1);
|
|
_primary[0] := FMode;
|
|
codewords := insert(codewords, 0, _primary);
|
|
end;
|
|
|
|
// insert structured append flag if necessary
|
|
if StructuredAppendTotal > 1 then
|
|
begin
|
|
SetLength(flag, 2);
|
|
flag[0] := 33; // padding
|
|
flag[1] := ((StructuredAppendTotal - 1) shl 3) or (structuredAppendTotal - 1); // position + total
|
|
if FMode in [2..3] then
|
|
index := 10 // first two data symbols in the secondary message
|
|
else
|
|
index := 1; // first two data symbols in the primary message (first symbol at index 0 isn't a data symbol)
|
|
codewords := insert(codewords, index, flag);
|
|
end;
|
|
|
|
if FMode = 5 then // 68 data codewords, 56 error corrections in secondary message
|
|
begin
|
|
secondaryMax := 68;
|
|
secondaryECMax := 56;
|
|
end
|
|
else // 84 data codewords, 40 error corrections in secondary message
|
|
begin
|
|
secondaryMax := 84;
|
|
secondaryECMax := 40;
|
|
end;
|
|
|
|
// truncate data codewords to maximum data space available
|
|
totalMax := secondaryMax + 10;
|
|
if (Length(codewords) > totalMax) then
|
|
SetLength(codewords, totalMax);
|
|
|
|
// insert primary error correction between primary message and secondary message (always EEC)
|
|
primary := Copy(codewords, 0, 10);
|
|
primaryCheck := getErrorCorrection(primary, 10);
|
|
codewords := insert(codewords, 10, primaryCheck);
|
|
|
|
// calculate secondary error correction
|
|
secondary := Copy(codewords, 20, Length(codewords) - 20);
|
|
SetLength(secondaryOdd, Length(secondary) div 2);
|
|
SetLength(secondaryEven, Length(secondary) div 2);
|
|
for i := 0 to Length(secondary) - 1 do
|
|
if Odd(i) then
|
|
secondaryOdd[(i - 1) div 2] := secondary[i]
|
|
else
|
|
secondaryEven[i div 2] := secondary[i];
|
|
|
|
secondaryECOdd := getErrorCorrection(secondaryOdd, secondaryECMax div 2);
|
|
secondaryECEven := getErrorCorrection(secondaryEven, secondaryECMax div 2);
|
|
|
|
// add secondary error correction after secondary message
|
|
SetLength(codewords, Length(codewords) + Length(secondaryECOdd) + Length(secondaryECEven));
|
|
for i := 0 to Length(secondaryECOdd) - 1 do
|
|
codewords[20 + secondaryMax + (2 * i) + 1] := secondaryECOdd[i];
|
|
for i := 0 to Length(secondaryECEven) - 1 do
|
|
codewords[20 + secondaryMax + (2 * i)] := secondaryECEven[i];
|
|
|
|
// copy data into symbol grid
|
|
SetLength(bit_pattern, 7);
|
|
for i := 0 to 33 - 1 do
|
|
for j := 0 to 30 - 1 do
|
|
begin
|
|
block := (MAXICODE_GRID[(i * 30) + j] + 5) div 6;
|
|
bit := (MAXICODE_GRID[(i * 30) + j] + 5) mod 6;
|
|
if block <> 0 then
|
|
begin
|
|
bit_pattern[0] := (codewords[block - 1] and $20) shr 5;
|
|
bit_pattern[1] := (codewords[block - 1] and $10) shr 4;
|
|
bit_pattern[2] := (codewords[block - 1] and $8) shr 3;
|
|
bit_pattern[3] := (codewords[block - 1] and $4) shr 2;
|
|
bit_pattern[4] := (codewords[block - 1] and $2) shr 1;
|
|
bit_pattern[5] := (codewords[block - 1] and $1);
|
|
grid[i, j] := bit_pattern[bit] <> 0;
|
|
end;
|
|
end;
|
|
|
|
// add orientation markings
|
|
grid[ 0, 28] := True; // top right filler
|
|
grid[ 0, 29] := True;
|
|
grid[ 9, 10] := True; // top left marker
|
|
grid[ 9, 11] := True;
|
|
grid[10, 11] := True;
|
|
grid[15, 7] := True; // left hand marker
|
|
grid[16, 8] := True;
|
|
grid[16, 20] := True; // right hand marker
|
|
grid[17, 20] := True;
|
|
grid[22, 10] := True; // bottom left marker
|
|
grid[23, 10] := True;
|
|
grid[22, 17] := True; // bottom right marker
|
|
grid[23, 17] := True;
|
|
|
|
plotSymbol;
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
function TMaxiCodeImpl.GetEllipceCount: Integer;
|
|
begin
|
|
Result := 3;
|
|
end;
|
|
|
|
function TMaxiCodeImpl.GetEllipseRect(i: Integer): TfrxRect;
|
|
begin
|
|
Result := FEllipseRect[i];
|
|
end;
|
|
|
|
function TMaxiCodeImpl.getErrorCorrection(codewords: TLongIntArray;
|
|
ecclen: Integer): TLongIntArray;
|
|
var
|
|
results: TLongIntArray;
|
|
rs: TReedSolomon;
|
|
i: Integer;
|
|
begin
|
|
rs := TReedSolomon.Create;
|
|
rs.init_gf($43);
|
|
rs.init_code(ecclen, 1);
|
|
rs.encode(Length(codewords), codewords);
|
|
SetLength(results, ecclen);
|
|
for i := 0 to ecclen - 1 do
|
|
results[i] := rs.getResult(Length(results) - 1 - i);
|
|
Result := results;
|
|
rs.Free;
|
|
end;
|
|
|
|
function TMaxiCodeImpl.GetHexagonPoint(i, j: Integer): TfrxPoint;
|
|
begin
|
|
Result := HexagonPointByIndex(FHexagonCenter[i], j);
|
|
end;
|
|
|
|
function TMaxiCodeImpl.getMode2PrimaryCodewords(postcode: AnsiString; country,
|
|
service: Integer): TLongIntArray;
|
|
var
|
|
i, postcodeNum: LongInt;
|
|
primary: TLongIntArray;
|
|
begin
|
|
for i := 0 to Length(postcode) - 1 do
|
|
if not IsNumeral(postcode, i) then
|
|
begin
|
|
postcode := Substring(postcode, 0, i);
|
|
Break;
|
|
end;
|
|
|
|
postcodeNum := IntParse(postcode);
|
|
SetLength(primary, 10);
|
|
primary[0] := ((postcodeNum and $03) shl 4) or 2;
|
|
primary[1] := ((postcodeNum and $fc) shr 2);
|
|
primary[2] := ((postcodeNum and $3f00) shr 8);
|
|
primary[3] := ((postcodeNum and $fc000) shr 14);
|
|
primary[4] := ((postcodeNum and $3f00000) shr 20);
|
|
primary[5] := ((postcodeNum and $3c000000) shr 26) or ((Length(postcode) and $3) shl 4);
|
|
primary[6] := ((Length(postcode) and $3c) shr 2) or ((country and $3) shl 4);
|
|
primary[7] := (country and $fc) shr 2;
|
|
primary[8] := ((country and $300) shr 8) or ((service and $f) shl 2);
|
|
primary[9] := ((service and $3f0) shr 4);
|
|
|
|
Result := primary;
|
|
end;
|
|
|
|
function TMaxiCodeImpl.getMode3PrimaryCodewords(postcode: AnsiString; country,
|
|
service: Integer): TLongIntArray;
|
|
var
|
|
postcodeNums: TLongIntArray;
|
|
i: Integer;
|
|
primary: TLongIntArray;
|
|
begin
|
|
SetLength(postcodeNums, Length(postcode));
|
|
postcode := AnsiString(UpperCase(String(postcode)));
|
|
|
|
for i := 0 to Length(postcode) - 1 do
|
|
begin
|
|
postcodeNums[i] := Ord(postcode[i + 1]); // i + 1: delphi string is 1-based
|
|
if (postcode[i + 1] >= 'A') and (postcode[i + 1] <= 'Z') then
|
|
// (Capital) letters shifted to Code Set A values
|
|
postcodeNums[i] := postcodeNums[i] - 64;
|
|
if (postcodeNums[i] in [27, 31, 33]) or (postcodeNums[i] >= 59) then
|
|
// Not a valid postal code character, use space instead
|
|
postcodeNums[i] := 32;
|
|
// Input characters lower than 27 (NUL - SUB) in postal code are interpreted as capital
|
|
// letters in Code Set A (e.g. LF becomes 'J')
|
|
end;
|
|
|
|
SetLength(primary, 10);
|
|
primary[0] := ((postcodeNums[5] and $03) shl 4) or 3;
|
|
primary[1] := ((postcodeNums[4] and $03) shl 4) or ((postcodeNums[5] and $3c) shr 2);
|
|
primary[2] := ((postcodeNums[3] and $03) shl 4) or ((postcodeNums[4] and $3c) shr 2);
|
|
primary[3] := ((postcodeNums[2] and $03) shl 4) or ((postcodeNums[3] and $3c) shr 2);
|
|
primary[4] := ((postcodeNums[1] and $03) shl 4) or ((postcodeNums[2] and $3c) shr 2);
|
|
primary[5] := ((postcodeNums[0] and $03) shl 4) or ((postcodeNums[1] and $3c) shr 2);
|
|
primary[6] := ((postcodeNums[0] and $3c) shr 2) or ((country and $3) shl 4);
|
|
primary[7] := (country and $fc) shr 2;
|
|
primary[8] := ((country and $300) shr 8) or ((service and $f) shl 2);
|
|
primary[9] := ((service and $3f0) shr 4);
|
|
|
|
Result := primary;
|
|
end;
|
|
|
|
function TMaxiCodeImpl.getPrimaryCodewords: TLongIntArray;
|
|
var
|
|
i, index, country, service: Integer;
|
|
postcode: AnsiString;
|
|
begin
|
|
if Length(PrimaryData) <> 15 then
|
|
raise Exception.Create('Invalid Primary String');
|
|
|
|
for i := 9 to 15 do // check that country code and service are numeric
|
|
if not IsNumeral(PrimaryData, i) then
|
|
raise Exception.Create('Invalid Primary String');
|
|
|
|
if FMode = 2 then
|
|
begin
|
|
postcode := Substring(PrimaryData, 0, 9);
|
|
index := IndexOf(PrimaryData, ' ');
|
|
if index > -1 then
|
|
postcode := Substring(postcode, 0, index);
|
|
end
|
|
else // FMode = 3
|
|
postcode := Substring(PrimaryData, 0, 6);
|
|
|
|
country := IntParse(PrimaryData, 9, 3);
|
|
service := IntParse(PrimaryData, 12, 3);
|
|
|
|
if FMode = 2 then
|
|
Result := getMode2PrimaryCodewords(postcode, country, service)
|
|
else // Mode = 3
|
|
Result := getMode3PrimaryCodewords(postcode, country, service);
|
|
end;
|
|
|
|
function TMaxiCodeImpl.HexagonCenter(Row, Col: Integer): TfrxPoint;
|
|
begin
|
|
Result := frxPoint((2.46 * Col) + 1.23 + (Row and $1) * 1.23,
|
|
(2.135 * Row) + 1.43);
|
|
end;
|
|
|
|
function TMaxiCodeImpl.HexagonPointByIndex(Center: TfrxPoint;
|
|
Index: Integer): TfrxPoint;
|
|
begin
|
|
with Center do
|
|
begin
|
|
Result.X := X + OFFSET_X[Index] * INK_SPREAD;
|
|
Result.Y := Y + OFFSET_Y[Index] * INK_SPREAD;
|
|
end;
|
|
end;
|
|
|
|
function TMaxiCodeImpl.IndexOf(str, substr: AnsiString): integer;
|
|
begin
|
|
Result := Pos(substr, str) - 1; // zero based index
|
|
end;
|
|
|
|
function TMaxiCodeImpl.IntParse(str: AnsiString; startIndex: Integer = 0;
|
|
len: Integer = -1): Integer;
|
|
begin
|
|
Result := StrToInt(String(Substring(str, startIndex, len)));
|
|
end;
|
|
|
|
function TMaxiCodeImpl.IsNumeral(str: AnsiString; i: Integer): Boolean;
|
|
begin
|
|
Result := str[i + 1] in ['0'..'9']; // i + 1: delphi string is 1-based
|
|
end;
|
|
|
|
procedure TMaxiCodeImpl.plotSymbol;
|
|
var
|
|
row, col: Integer;
|
|
begin
|
|
// hexagons
|
|
FHexagonCount := 0;
|
|
for row := 0 to 33 - 1 do
|
|
for col := 0 to 30 - 1 do
|
|
if grid[row, col] then
|
|
begin
|
|
FHexagonCenter[FHexagonCount] := HexagonCenter(row, col);
|
|
FHexagonCount := FHexagonCount + 1;
|
|
end;
|
|
end;
|
|
|
|
function TMaxiCodeImpl.processText: Boolean;
|
|
|
|
procedure insert(position, c: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 144 - 1 downto position + 1 do
|
|
begin
|
|
FSet[i] := FSet[i - 1];
|
|
character[i] := character[i - 1];
|
|
end;
|
|
character[position] := c;
|
|
end;
|
|
|
|
var
|
|
i, j, len, count, current_set: Integer;
|
|
value: LongInt;
|
|
begin
|
|
Result := False;
|
|
if sourcelen > 138 then
|
|
Exit;
|
|
len := sourcelen;
|
|
for i := 0 to 144 - 1 do
|
|
begin
|
|
Fset[i] := -1;
|
|
character[i] := 0;
|
|
end;
|
|
for i := 0 to len - 1 do
|
|
begin
|
|
// Look up characters in table from Appendix A - this gives
|
|
// value and code set for most characters
|
|
Fset[i] := MAXICODE_SET[source[i]];
|
|
character[i] := MAXICODE_SYMBOL_CHAR[source[i]];
|
|
end;
|
|
|
|
// If a character can be represented in more than one code set, pick which version to use.
|
|
if Fset[0] = 0 then
|
|
begin
|
|
if character[0] = 13 then
|
|
character[0] := 0;
|
|
Fset[0] := 1;
|
|
end;
|
|
|
|
for i := 1 to len - 1 do
|
|
if Fset[i] = 0 then
|
|
// Special character that can be represented in more than one code set.
|
|
if character[i] = 13 then // Carriage Return
|
|
begin
|
|
Fset[i] := bestSurroundingSet(i, len, [1, 5]);
|
|
if Fset[i] = 5 then character[i] := 13
|
|
else character[i] := 0;
|
|
end
|
|
else if character[i] = 28 then // FS
|
|
begin
|
|
Fset[i] := bestSurroundingSet(i, len, [1, 2, 3, 4, 5]);
|
|
if Fset[i] = 5 then character[i] := 32;
|
|
end
|
|
else if character[i] = 29 then // GS
|
|
begin
|
|
Fset[i] := bestSurroundingSet(i, len, [1, 2, 3, 4, 5]);
|
|
if Fset[i] = 5 then character[i] := 33;
|
|
end
|
|
else if character[i] = 30 then // RS
|
|
begin
|
|
Fset[i] := bestSurroundingSet(i, len, [1, 2, 3, 4, 5]);
|
|
if Fset[i] = 5 then character[i] := 34;
|
|
end
|
|
else if character[i] = 32 then // Space
|
|
begin
|
|
Fset[i] := bestSurroundingSet(i, len, [1, 2, 3, 4, 5]);
|
|
if Fset[i] = 1 then character[i] := 32
|
|
else if Fset[i] = 2 then character[i] := 47
|
|
else character[i] := 59;
|
|
end
|
|
else if character[i] = 44 then // Comma
|
|
begin
|
|
Fset[i] := bestSurroundingSet(i, len, [1, 2]);
|
|
if Fset[i] = 2 then character[i] := 48;
|
|
end
|
|
else if character[i] = 46 then // Full Stop
|
|
begin
|
|
Fset[i] := bestSurroundingSet(i, len, [1, 2]);
|
|
if Fset[i] = 2 then character[i] := 49;
|
|
end
|
|
else if character[i] = 47 then // Slash
|
|
begin
|
|
Fset[i] := bestSurroundingSet(i, len, [1, 2]);
|
|
if Fset[i] = 2 then character[i] := 50;
|
|
end
|
|
else if character[i] = 58 then // Colon
|
|
begin
|
|
Fset[i] := bestSurroundingSet(i, len, [1, 2]);
|
|
if Fset[i] = 2 then character[i] := 51;
|
|
end;
|
|
|
|
for i := len to Length(Fset) - 1 do // Add the padding
|
|
begin
|
|
if Fset[len - 1] = 2 then Fset[i] := 2
|
|
else Fset[i] := 1;
|
|
character[i] := 33;
|
|
end;
|
|
|
|
// Find candidates for number compression (not allowed in primary message in modes 2 and 3).
|
|
if FMode in [2, 3] then j := 9
|
|
else j := 0;
|
|
count := 0;
|
|
for i := j to 144 - 1 do
|
|
begin
|
|
if (Fset[i] = 1) and (character[i] in [48..57]) then // Character is a number
|
|
count := count + 1
|
|
else
|
|
count := 0;
|
|
if count = 9 then // Nine digits in a row can be compressed
|
|
begin
|
|
Fset[i] := 6; Fset[i - 1] := 6; Fset[i - 2] := 6;
|
|
Fset[i - 3] := 6; Fset[i - 4] := 6; Fset[i - 5] := 6;
|
|
Fset[i - 6] := 6; Fset[i - 7] := 6; Fset[i - 8] := 6;
|
|
count := 0;
|
|
end;
|
|
end;
|
|
|
|
// Add shift and latch characters
|
|
current_set := 1;
|
|
i := 0;
|
|
repeat
|
|
if (Fset[i] <> current_set) and (Fset[i] <> 6) then
|
|
begin
|
|
case Fset[i] of
|
|
1:
|
|
if (i + 1 < Length(Fset)) and (Fset[i + 1] = 1) then
|
|
begin
|
|
if (i + 2 < Length(Fset)) and (Fset[i + 2] = 1) then
|
|
begin
|
|
if (i + 3 < Length(Fset)) and (Fset[i + 3] = 1) then // Latch A
|
|
begin
|
|
insert(i, 63);
|
|
current_set := 1;
|
|
len := len + 1;
|
|
i := i + 3;
|
|
end
|
|
else // 3 Shift A
|
|
begin
|
|
insert(i, 57);
|
|
len := len + 1;
|
|
i := i + 2;
|
|
end;
|
|
end
|
|
else // 2 Shift A
|
|
begin
|
|
insert(i, 56);
|
|
len := len + 1;
|
|
i := i + 1;
|
|
end;
|
|
end
|
|
else // Shift A
|
|
begin
|
|
insert(i, 59);
|
|
len := len + 1;
|
|
end;
|
|
2:
|
|
if (i + 1 < Length(Fset)) and (Fset[i + 1] = 2) then //
|
|
begin
|
|
insert(i, 63);
|
|
current_set := 2;
|
|
len := len + 1;
|
|
i := i + 1;
|
|
end
|
|
else // Shift B
|
|
begin
|
|
insert(i, 59);
|
|
len := len + 1;
|
|
end;
|
|
3:
|
|
if (i + 3 < Length(Fset)) and
|
|
(Fset[i + 1] = 3) and (Fset[i + 2] = 3) and (Fset[i + 3] = 3) then // Lock In C
|
|
begin
|
|
insert(i, 60);
|
|
insert(i, 60);
|
|
current_set := 3;
|
|
len := len + 1;
|
|
i := i + 3;
|
|
end
|
|
else // Shift C
|
|
begin
|
|
insert(i, 60);
|
|
len := len + 1;
|
|
end;
|
|
4:
|
|
if (i + 3 < Length(Fset)) and
|
|
(Fset[i + 1] = 4) and (Fset[i + 2] = 4) and (Fset[i + 3] = 4) then // Lock In D
|
|
begin
|
|
insert(i, 61);
|
|
insert(i, 61);
|
|
current_set := 4;
|
|
len := len + 1;
|
|
i := i + 3;
|
|
end
|
|
else // Shift D
|
|
begin
|
|
insert(i, 61);
|
|
len := len + 1;
|
|
end;
|
|
5:
|
|
if (i + 3 < Length(Fset)) and
|
|
(Fset[i + 1] = 5) and (Fset[i + 2] = 5) and (Fset[i + 5] = 4) then // Lock In E
|
|
begin
|
|
insert(i, 62);
|
|
insert(i, 62);
|
|
current_set := 5;
|
|
len := len + 1;
|
|
i := i + 3;
|
|
end
|
|
else // Shift E
|
|
begin
|
|
insert(i, 62);
|
|
len := len + 1;
|
|
end;
|
|
else
|
|
raise Exception.Create('Unexpected set ' + IntToStr(Fset[i]) + ' at index ' + IntToStr(i));
|
|
end;
|
|
i := i + 1;
|
|
end;
|
|
i := i + 1;
|
|
until i >= Length(Fset);
|
|
|
|
// Number compression has not been forgotten! It's handled below.
|
|
i := 0;
|
|
repeat
|
|
if Fset[i] = 6 then // Number compression
|
|
begin
|
|
value := 0;
|
|
for j := 0 to 9 - 1 do
|
|
begin
|
|
value := value * 10;
|
|
value := value + (character[i + j] - Ord('0'));
|
|
end;
|
|
character[i] := 31; // NS
|
|
character[i + 1] := (value and $3f000000) shr 24;
|
|
character[i + 2] := (value and $fc0000) shr 18;
|
|
character[i + 3] := (value and $3f000) shr 12;
|
|
character[i + 4] := (value and $fc0) shr 6;
|
|
character[i + 5] := (value and $3f);
|
|
i := i + 6;
|
|
for j := i to 140 - 1 do
|
|
begin
|
|
Fset[j] := Fset[j + 3];
|
|
character[j] := character[j + 3];
|
|
end;
|
|
len := len - 3;
|
|
end
|
|
else
|
|
i := i + 1;
|
|
until i >= Length(Fset);
|
|
|
|
// Inject ECI codes to beginning of data, according to Table
|
|
if eciMode <> 3 then
|
|
begin
|
|
insert(0, 27); // ECI
|
|
|
|
if eciMode in [0..31] then
|
|
begin
|
|
insert(1, eciMode and $1F);
|
|
len := len + 2;
|
|
end;
|
|
|
|
if (eciMode >= 32) and (eciMode <= 1023) then
|
|
begin
|
|
insert(1, $20 + (eciMode shr 6));
|
|
insert(2, eciMode and $3F);
|
|
len := len + 3;
|
|
end;
|
|
|
|
if (eciMode >= 1024) and (eciMode <= 32767) then
|
|
begin
|
|
insert(1, $30 + (eciMode shr 12));
|
|
insert(2, (eciMode shr 6) and $3F);
|
|
insert(3, eciMode and $3F);
|
|
len := len + 4;
|
|
end;
|
|
|
|
if (eciMode >= 32768) and (eciMode <= 999999) then
|
|
begin
|
|
insert(1, $38 + (eciMode shr 18));
|
|
insert(2, (eciMode shr 12) and $3F);
|
|
insert(3, (eciMode shr 6) and $3F);
|
|
insert(4, eciMode and $3F);
|
|
len := len + 5;
|
|
end;
|
|
end;
|
|
|
|
if (FMode in [2, 3]) and (len > 84) or
|
|
(FMode in [4, 6]) and (len > 93) or
|
|
(FMode = 5) and (len > 77) then
|
|
Result := False
|
|
else
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TMaxiCodeImpl.SetStructuredAppendPosition(const Value: Integer);
|
|
begin
|
|
if not (Value in [1..8]) then
|
|
raise Exception.Create('Invalid MaxiCode structured append position: ' + IntToStr(Value));
|
|
if FStructuredAppendPosition <> Value then
|
|
FStructuredAppendPosition := Value;
|
|
end;
|
|
|
|
procedure TMaxiCodeImpl.SetStructuredAppendTotal(const Value: Integer);
|
|
begin
|
|
if not (Value in [1..8]) then
|
|
raise Exception.Create('Invalid MaxiCode structured append total: ' + IntToStr(Value));
|
|
if FStructuredAppendTotal <> Value then
|
|
FStructuredAppendTotal := Value;
|
|
end;
|
|
|
|
function TMaxiCodeImpl.Substring(str: AnsiString; startIndex: Integer;
|
|
len: Integer = -1): AnsiString;
|
|
begin
|
|
if len = -1 then
|
|
len := Length(str);
|
|
Result := Copy(str, startIndex + 1, len); // i + 1: delphi string is 1-based
|
|
end;
|
|
|
|
{ TReedSolomon }
|
|
|
|
procedure TReedSolomon.encode(len: LongInt; data: TLongIntArray);
|
|
var
|
|
i, k, m: LongInt;
|
|
begin
|
|
SetLength(res, rlen);
|
|
for i := 0 to rlen - 1 do
|
|
res[i] := 0;
|
|
for i := 0 to len - 1 do
|
|
begin
|
|
m := res[rlen - 1] xor data[i];
|
|
for k := rlen - 1 downto 1 do
|
|
if (m <> 0) and (rspoly[k] <> 0) then
|
|
res[k] := res[k - 1] xor (alog[(logt[m] + logt[rspoly[k]]) mod logmod])
|
|
else
|
|
res[k] := res[k - 1];
|
|
if (m <> 0) and (rspoly[0] <> 0) then
|
|
res[0] := alog[(logt[m] + logt[rspoly[0]]) mod logmod]
|
|
else
|
|
res[0] := 0;
|
|
end;
|
|
end;
|
|
|
|
function TReedSolomon.getResult(count: LongInt): LongInt;
|
|
begin
|
|
Result := res[count];
|
|
end;
|
|
|
|
procedure TReedSolomon.init_code(nsym, index: LongInt);
|
|
var
|
|
i, k: LongInt;
|
|
begin
|
|
SetLength(rspoly, nsym + 1);
|
|
rlen := nsym;
|
|
rspoly[0] := 1;
|
|
for i := 1 to nsym do
|
|
begin
|
|
rspoly[i] := 1;
|
|
for k := i-1 downto 1 do
|
|
begin
|
|
if rspoly[k] <> 0 then
|
|
rspoly[k] := alog[(logt[rspoly[k]] + index) mod logmod];
|
|
rspoly[k] := rspoly[k] xor rspoly[k - 1];
|
|
end;
|
|
rspoly[0] := alog[(logt[rspoly[0]] + index) mod logmod];
|
|
index := index + 1;
|
|
end;
|
|
end;
|
|
|
|
procedure TReedSolomon.init_gf(poly: LongInt);
|
|
var
|
|
m, b, p, v: LongInt;
|
|
begin
|
|
// Find the top bit, and hence the symbol size
|
|
b := 1;
|
|
m := 0;
|
|
while b <= poly do
|
|
begin
|
|
b := b shl 1;
|
|
m := m + 1;
|
|
end;
|
|
b := b shr 1;
|
|
m := m - 1;
|
|
// Calculate the log/alog tables
|
|
logmod := (1 shl m) - 1;
|
|
SetLength(logt, logmod + 1);
|
|
SetLength(alog, logmod);
|
|
p := 1;
|
|
v := 0;
|
|
while v < logmod do
|
|
begin
|
|
alog[v] := p;
|
|
logt[p] := v;
|
|
p := p shl 1;
|
|
if (p and b) <> 0 then
|
|
p := p xor poly;
|
|
v := v + 1;
|
|
end;
|
|
end;
|
|
|
|
{ TMaxicodeEncoder }
|
|
|
|
const
|
|
FieldSizeFactor = 2.47;
|
|
PenSizeFactor = 4.5;
|
|
HalfPen = PenSizeFactor / 2;
|
|
|
|
constructor TMaxicodeEncoder.Create;
|
|
begin
|
|
FData := '';
|
|
FMode := 4;
|
|
|
|
FBitmap := TBitmap.Create;
|
|
{$IFNDEF Linux}
|
|
FBitmap.PixelFormat := pf1Bit;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TMaxicodeEncoder.Destroy;
|
|
begin
|
|
FBitmap.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TMaxicodeEncoder.GetScanLine(Column: Integer): PByteArray;
|
|
begin
|
|
Result := PByteArray(FBitmap.ScanLine[Column]);
|
|
end;
|
|
|
|
function TMaxicodeEncoder.GetIsBlack(Row, Column: integer): Boolean;
|
|
begin
|
|
Result := FBitmap.Canvas.Pixels[Row, Column] = clBlack;
|
|
end;
|
|
|
|
function TMaxicodeEncoder.Height: Integer;
|
|
begin
|
|
Result := FBitmap.Height;
|
|
end;
|
|
|
|
procedure TMaxicodeEncoder.SetData(const Value: WideString);
|
|
begin
|
|
if FData <> Value then
|
|
begin
|
|
FData := Value;
|
|
Update;
|
|
end;
|
|
end;
|
|
|
|
procedure TMaxicodeEncoder.SetMode(const Value: Integer);
|
|
begin
|
|
if not (Value in [2..6]) then
|
|
raise Exception.Create('Invalid MaxiCode mode: ' + IntToStr(Value));
|
|
if FMode <> Value then
|
|
begin
|
|
FMode := Value;
|
|
Update;
|
|
end;
|
|
end;
|
|
|
|
procedure TMaxicodeEncoder.Update;
|
|
var
|
|
AnsiSt: AnsiString;
|
|
Encoder: TMaxiCodeImpl;
|
|
MaxSize: Extended;
|
|
i, j: Integer;
|
|
DrawPoints: array [0..5] of TPoint;
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
AnsiSt := _UnicodeToAnsi(Data, DEFAULT_CHARSET);
|
|
{$ELSE}
|
|
AnsiSt := AnsiString(Data);
|
|
{$ENDIF}
|
|
Encoder := TMaxiCodeImpl.Create;
|
|
try
|
|
Encoder.Encode(AnsiSt, Mode);
|
|
|
|
// CalcBounds
|
|
MaxSize := 0;
|
|
for j := 0 to 5 do
|
|
with Encoder.HexagonPointByIndex(Encoder.HexagonCenter(33 - 1, 30 - 1), j) do
|
|
MaxSize := Max(MaxSize, Max(X, y));
|
|
|
|
FBitmap.Width := Round(FieldSizeFactor * MaxSize) + 1;
|
|
FBitmap.Height := FBitmap.Width;
|
|
|
|
FBitmap.Canvas.Brush.Color := clWhite;
|
|
FBitmap.Canvas.FillRect(FBitmap.Canvas.ClipRect);
|
|
|
|
// Draw
|
|
FBitmap.Canvas.Brush.Color := clBlack;
|
|
FBitmap.Canvas.Pen.Color := clBlack;
|
|
FBitmap.Canvas.Pen.Width := 1;
|
|
|
|
for i := 0 to Encoder.HexagonCount - 1 do
|
|
begin
|
|
for j := 0 to 5 do
|
|
with Encoder.HexagonPoint[i, j] do
|
|
DrawPoints[j] := Point(Round(FieldSizeFactor * X), Round(FieldSizeFactor * Y));
|
|
FBitmap.Canvas.Polygon(DrawPoints);
|
|
end;
|
|
|
|
FBitmap.Canvas.Brush.Color := clWhite;
|
|
FBitmap.Canvas.Pen.Width := Round(PenSizeFactor);
|
|
for i := 0 to Encoder.EllipceCount - 1 do
|
|
with Encoder.EllipseRect[i] do
|
|
FBitmap.Canvas.Ellipse(Round(FieldSizeFactor * Left ),
|
|
Round(FieldSizeFactor * Top ),
|
|
Round(FieldSizeFactor * Right ) + 1,
|
|
Round(FieldSizeFactor * Bottom) + 1);
|
|
finally
|
|
Encoder.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMaxicodeEncoder.Width: Integer;
|
|
begin
|
|
Result := FBitmap.Width;
|
|
end;
|
|
|
|
end.
|