1309 lines
42 KiB
ObjectPascal
1309 lines
42 KiB
ObjectPascal
//
|
|
//
|
|
//
|
|
// Copyright 2007 by Paulo Soares.
|
|
//
|
|
// The contents of this file are subject to the Mozilla Public License Version 1.1
|
|
// (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.mozilla.org/MPL/
|
|
//
|
|
// Software distributed under the License is distributed on an "AS IS" basis,
|
|
// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
// for the specific language governing rights and limitations under the License.
|
|
//
|
|
// The Original Code is 'iText, a free JAVA-PDF library'.
|
|
//
|
|
// The Initial Developer of the Original Code is Bruno Lowagie. Portions created by
|
|
// the Initial Developer are Copyright (C) 1999, 2000, 2001, 2002 by Bruno Lowagie.
|
|
// All Rights Reserved.
|
|
// Co-Developer of the code is Paulo Soares. Portions created by the Co-Developer
|
|
// are Copyright (C) 2000, 2001, 2002 by Paulo Soares. All Rights Reserved.
|
|
// Modifications: Alexander Tzyganenko
|
|
//
|
|
//
|
|
//
|
|
//
|
|
//
|
|
// TODO:
|
|
// - âðàùåíèå íà ïðîèçâîëüíûé óãîë
|
|
// - âûäåëåíèå áàçîâîãî êëàññà frxBarcodeBase, ÷òîáû ðàçíûå áàðû íàñëåäîâàëèñü ????????
|
|
//
|
|
//
|
|
|
|
|
|
unit FMX.frxBarcodeDataMatrix;
|
|
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses System.SysUtils, System.Types, System.UITypes, System.StrUtils,
|
|
System.Classes, FMX.Objects, FMX.Types, FMX.Controls, FMX.Forms,
|
|
FMX.Dialogs, FMX.frxBarcode2DBase
|
|
{$IFDEF DELPHI19}
|
|
, FMX.Graphics
|
|
{$ENDIF};
|
|
|
|
type
|
|
|
|
|
|
// Specifies the Datamatrix encoding. ///////////////////////////////////////////////////////////////////////
|
|
|
|
DatamatrixEncoding =
|
|
(
|
|
Auto,
|
|
Ascii,
|
|
C40,
|
|
Txt,
|
|
Base256,
|
|
X12,
|
|
Edifact
|
|
);
|
|
|
|
// Specifies the Datamatrix symbol size. /////////////////////////////////////////////////////////////////////
|
|
|
|
DatamatrixSymbolSize =
|
|
(
|
|
AutoSize,
|
|
Size10x10,
|
|
Size12x12,
|
|
Size8x18,
|
|
Size14x14,
|
|
Size8x32,
|
|
Size16x16,
|
|
Size12x26,
|
|
Size18x18,
|
|
Size20x20,
|
|
Size12x36,
|
|
Size22x22,
|
|
Size16x36,
|
|
Size24x24,
|
|
Size26x26,
|
|
Size16x48,
|
|
Size32x32,
|
|
Size36x36,
|
|
Size40x40,
|
|
Size44x44,
|
|
Size48x48,
|
|
Size52x52,
|
|
Size64x64,
|
|
Size72x72,
|
|
Size80x80,
|
|
Size88x88,
|
|
Size96x96,
|
|
Size104x104,
|
|
Size120x120,
|
|
Size132x132,
|
|
Size144x144
|
|
);
|
|
|
|
// ////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
//
|
|
//
|
|
// ////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
DmParams = record
|
|
|
|
height,
|
|
width,
|
|
heightSection,
|
|
widthSection,
|
|
dataSize,
|
|
dataBlock,
|
|
errorBlock : integer;
|
|
|
|
end;
|
|
|
|
const
|
|
|
|
dmSizes : array[Size10x10..Size144x144] of DmParams =
|
|
(
|
|
( height: 10; width: 10; heightSection: 10; widthSection: 10; dataSize: 3; dataBlock: 3; errorBlock: 5 ),
|
|
( height: 12; width: 12; heightSection: 12; widthSection: 12; dataSize: 5; dataBlock: 5; errorBlock: 7 ),
|
|
( height: 8; width: 18; heightSection: 8; widthSection: 18; dataSize: 5; dataBlock: 5; errorBlock: 7 ),
|
|
( height: 14; width: 14; heightSection: 14; widthSection: 14; dataSize: 8; dataBlock: 8; errorBlock:10 ),
|
|
( height: 8; width: 32; heightSection: 8; widthSection: 16; dataSize:10; dataBlock:10; errorBlock:11 ),
|
|
( height: 16; width: 16; heightSection: 16; widthSection: 16; dataSize:12; dataBlock:12; errorBlock:12 ),
|
|
( height: 12; width: 26; heightSection: 12; widthSection: 26; dataSize:16; dataBlock:16; errorBlock:14 ),
|
|
( height: 18; width: 18; heightSection: 18; widthSection: 18; dataSize:18; dataBlock:18; errorBlock:14 ),
|
|
( height: 20; width: 20; heightSection: 20; widthSection: 20; dataSize:22; dataBlock:22; errorBlock:18 ),
|
|
( height: 12; width: 36; heightSection: 12; widthSection: 18; dataSize:22; dataBlock:22; errorBlock:18 ),
|
|
( height: 22; width: 22; heightSection: 22; widthSection: 22; dataSize:30; dataBlock:30; errorBlock:20 ),
|
|
( height: 16; width: 36; heightSection: 16; widthSection: 18; dataSize:32; dataBlock:32; errorBlock:24 ),
|
|
( height: 24; width: 24; heightSection: 24; widthSection: 24; dataSize:36; dataBlock:36; errorBlock:24 ),
|
|
( height: 26; width: 26; heightSection: 26; widthSection: 26; dataSize:44; dataBlock:44; errorBlock:28 ),
|
|
( height: 16; width: 48; heightSection: 16; widthSection: 24; dataSize:49; dataBlock:49; errorBlock:28 ),
|
|
( height: 32; width: 32; heightSection: 16; widthSection: 16; dataSize:62; dataBlock:62; errorBlock:36 ),
|
|
( height: 36; width: 36; heightSection: 18; widthSection: 18; dataSize:86; dataBlock:86; errorBlock:42 ),
|
|
( height: 40; width: 40; heightSection: 20; widthSection: 20; dataSize:114; dataBlock:114; errorBlock: 48 ),
|
|
( height: 44; width: 44; heightSection: 22; widthSection: 22; dataSize:144; dataBlock:144; errorBlock: 56 ),
|
|
( height: 48; width: 48; heightSection: 24; widthSection: 24; dataSize:174; dataBlock:174; errorBlock: 68 ),
|
|
( height: 52; width: 52; heightSection: 26; widthSection: 26; dataSize:204; dataBlock:102; errorBlock: 42 ),
|
|
( height: 64; width: 64; heightSection: 16; widthSection: 16; dataSize:280; dataBlock:140; errorBlock: 56 ),
|
|
( height: 72; width: 72; heightSection: 18; widthSection: 18; dataSize:368; dataBlock:92; errorBlock: 36 ),
|
|
( height: 80; width: 80; heightSection: 20; widthSection: 20; dataSize:456; dataBlock:114; errorBlock: 48 ),
|
|
( height: 88; width: 88; heightSection: 22; widthSection: 22; dataSize:576; dataBlock:144; errorBlock: 56 ),
|
|
( height: 96; width: 96; heightSection: 24; widthSection: 24; dataSize:696; dataBlock:174; errorBlock: 68 ),
|
|
( height:104; width:104; heightSection: 26; widthSection: 26; dataSize:816; dataBlock:136; errorBlock: 56 ),
|
|
( height:120; width:120; heightSection: 20; widthSection: 20; dataSize:1050; dataBlock:175; errorBlock: 68 ),
|
|
( height:132; width:132; heightSection: 22; widthSection: 22; dataSize:1304; dataBlock:163; errorBlock: 62 ),
|
|
( height:144; width:144; heightSection: 24; widthSection: 24; dataSize:1558; dataBlock:156; errorBlock: 62 )
|
|
);
|
|
|
|
log : array[0..255] of integer =
|
|
( 0, 255, 1, 240, 2, 225, 241, 53, 3, 38, 226, 133, 242, 43, 54, 210,
|
|
4, 195, 39, 114, 227, 106, 134, 28, 243, 140, 44, 23, 55, 118, 211, 234,
|
|
5, 219, 196, 96, 40, 222, 115, 103, 228, 78, 107, 125, 135, 8, 29, 162,
|
|
244, 186, 141, 180, 45, 99, 24, 49, 56, 13, 119, 153, 212, 199, 235, 91,
|
|
6, 76, 220, 217, 197, 11, 97, 184, 41, 36, 223, 253, 116, 138, 104, 193,
|
|
229, 86, 79, 171, 108, 165, 126, 145, 136, 34, 9, 74, 30, 32, 163, 84,
|
|
245, 173, 187, 204, 142, 81, 181, 190, 46, 88, 100, 159, 25, 231, 50, 207,
|
|
57, 147, 14, 67, 120, 128, 154, 248, 213, 167, 200, 63, 236, 110, 92, 176,
|
|
7, 161, 77, 124, 221, 102, 218, 95, 198, 90, 12, 152, 98, 48, 185, 179,
|
|
42, 209, 37, 132, 224, 52, 254, 239, 117, 233, 139, 22, 105, 27, 194, 113,
|
|
230, 206, 87, 158, 80, 189, 172, 203, 109, 175, 166, 62, 127, 247, 146, 66,
|
|
137, 192, 35, 252, 10, 183, 75, 216, 31, 83, 33, 73, 164, 144, 85, 170,
|
|
246, 65, 174, 61, 188, 202, 205, 157, 143, 169, 82, 72, 182, 215, 191, 251,
|
|
47, 178, 89, 151, 101, 94, 160, 123, 26, 112, 232, 21, 51, 238, 208, 131,
|
|
58, 69, 148, 18, 15, 16, 68, 17, 121, 149, 129, 19, 155, 59, 249, 70,
|
|
214, 250, 168, 71, 201, 156, 64, 60, 237, 130, 111, 20, 93, 122, 177, 150 );
|
|
|
|
alog : array[0..255] of integer =
|
|
( 1, 2, 4, 8, 16, 32, 64, 128, 45, 90, 180, 69, 138, 57, 114, 228,
|
|
229, 231, 227, 235, 251, 219, 155, 27, 54, 108, 216, 157, 23, 46, 92, 184,
|
|
93, 186, 89, 178, 73, 146, 9, 18, 36, 72, 144, 13, 26, 52, 104, 208,
|
|
141, 55, 110, 220, 149, 7, 14, 28, 56, 112, 224, 237, 247, 195, 171, 123,
|
|
246, 193, 175, 115, 230, 225, 239, 243, 203, 187, 91, 182, 65, 130, 41, 82,
|
|
164, 101, 202, 185, 95, 190, 81, 162, 105, 210, 137, 63, 126, 252, 213, 135,
|
|
35, 70, 140, 53, 106, 212, 133, 39, 78, 156, 21, 42, 84, 168, 125, 250,
|
|
217, 159, 19, 38, 76, 152, 29, 58, 116, 232, 253, 215, 131, 43, 86, 172,
|
|
117, 234, 249, 223, 147, 11, 22, 44, 88, 176, 77, 154, 25, 50, 100, 200,
|
|
189, 87, 174, 113, 226, 233, 255, 211, 139, 59, 118, 236, 245, 199, 163, 107,
|
|
214, 129, 47, 94, 188, 85, 170, 121, 242, 201, 191, 83, 166, 97, 194, 169,
|
|
127, 254, 209, 143, 51, 102, 204, 181, 71, 142, 49, 98, 196, 165, 103, 206,
|
|
177, 79, 158, 17, 34, 68, 136, 61, 122, 244, 197, 167, 99, 198, 161, 111,
|
|
222, 145, 15, 30, 60, 120, 240, 205, 183, 67, 134, 33, 66, 132, 37, 74,
|
|
148, 5, 10, 20, 40, 80, 160, 109, 218, 153, 31, 62, 124, 248, 221, 151,
|
|
3, 6, 12, 24, 48, 96, 192, 173, 119, 238, 241, 207, 179, 75, 150, 1 );
|
|
poly5 : array[0..4] of integer = ( 228, 48, 15, 111, 62 );
|
|
poly7 : array[0..6] of integer = ( 23, 68, 144, 134, 240, 92, 254 );
|
|
poly10 : array[0..9] of integer = ( 28, 24, 185, 166, 223, 248, 116, 255, 110, 61 );
|
|
poly11 : array[0..10] of integer = ( 175, 138, 205, 12, 194, 168, 39, 245, 60, 97, 120 );
|
|
poly12 : array[0..11] of integer = ( 41, 153, 158, 91, 61, 42, 142, 213, 97, 178, 100, 242 );
|
|
poly14 : array[0..13] of integer = ( 156, 97, 192, 252, 95, 9, 157, 119, 138, 45, 18, 186, 83, 185 );
|
|
poly18 : array[0..17] of integer = ( 83, 195, 100, 39, 188, 75, 66, 61, 241, 213, 109, 129, 94, 254, 225, 48, 90, 188 );
|
|
poly20 : array[0..19] of integer = ( 15, 195, 244, 9, 233, 71, 168, 2, 188, 160, 153, 145, 253, 79,
|
|
108, 82, 27, 174, 186, 172 );
|
|
poly24 : array[0..23] of integer = ( 52, 190, 88, 205, 109, 39, 176, 21, 155, 197, 251, 223, 155, 21, 5, 172,
|
|
254, 124, 12, 181, 184, 96, 50, 193 );
|
|
poly28 : array[0..27] of integer = ( 211, 231, 43, 97, 71, 96, 103, 174, 37, 151, 170, 53, 75, 34, 249, 121,
|
|
17, 138, 110, 213, 141, 136, 120, 151, 233, 168, 93, 255 );
|
|
poly36 : array[0..35] of integer = ( 245, 127, 242, 218, 130, 250, 162, 181, 102, 120, 84, 179, 220, 251, 80, 182,
|
|
229, 18, 2, 4, 68, 33, 101, 137, 95, 119, 115, 44, 175, 184, 59, 25,
|
|
225, 98, 81, 112 );
|
|
poly42 : array[0..41] of integer = ( 77, 193, 137, 31, 19, 38, 22, 153, 247, 105, 122, 2, 245, 133, 242, 8,
|
|
175, 95, 100, 9, 167, 105, 214, 111, 57, 121, 21, 1, 253, 57, 54, 101,
|
|
248, 202, 69, 50, 150, 177, 226, 5, 9, 5 );
|
|
poly48 : array[0..47] of integer = ( 245, 132, 172, 223, 96, 32, 117, 22, 238, 133, 238, 231, 205, 188, 237, 87,
|
|
191, 106, 16, 147, 118, 23, 37, 90, 170, 205, 131, 88, 120, 100, 66, 138,
|
|
186, 240, 82, 44, 176, 87, 187, 147, 160, 175, 69, 213, 92, 253, 225, 19 );
|
|
poly56 : array[0..55] of integer = ( 175, 9, 223, 238, 12, 17, 220, 208, 100, 29, 175, 170, 230, 192, 215, 235,
|
|
150, 159, 36, 223, 38, 200, 132, 54, 228, 146, 218, 234, 117, 203, 29, 232,
|
|
144, 238, 22, 150, 201, 117, 62, 207, 164, 13, 137, 245, 127, 67, 247, 28,
|
|
155, 43, 203, 107, 233, 53, 143, 46 );
|
|
poly62 : array[0..61] of integer = ( 242, 93, 169, 50, 144, 210, 39, 118, 202, 188, 201, 189, 143, 108, 196, 37,
|
|
185, 112, 134, 230, 245, 63, 197, 190, 250, 106, 185, 221, 175, 64, 114, 71,
|
|
161, 44, 147, 6, 27, 218, 51, 63, 87, 10, 40, 130, 188, 17, 163, 31,
|
|
176, 170, 4, 107, 232, 7, 94, 166, 224, 124, 86, 47, 11, 204 );
|
|
poly68 : array[0..67] of integer = ( 220, 228, 173, 89, 251, 149, 159, 56, 89, 33, 147, 244, 154, 36, 73, 127,
|
|
213, 136, 248, 180, 234, 197, 158, 177, 68, 122, 93, 213, 15, 160, 227, 236,
|
|
66, 139, 153, 185, 202, 167, 179, 25, 220, 232, 96, 210, 231, 136, 223, 239,
|
|
181, 241, 59, 52, 172, 25, 49, 232, 211, 189, 64, 54, 108, 153, 132, 63,
|
|
96, 103, 82, 186 );
|
|
|
|
_x12 = #13 + '*> 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
|
|
cbDefaultText = '12345678';
|
|
|
|
type
|
|
|
|
SizeF = record
|
|
height : Double;
|
|
width : Double;
|
|
end;
|
|
|
|
TInts = array of integer;
|
|
|
|
// /////////////////////////////////////////////////////////////////////////
|
|
// Generates the 2D Data Matrix barcode. /////////////////////////////////////////////////////////////////////////
|
|
// /////////////////////////////////////////////////////////////////////////
|
|
|
|
{$M+}
|
|
TfrxBarcodeDataMatrix = class( TfrxBarcode2DBase )
|
|
|
|
private
|
|
|
|
FPlace : TInts;
|
|
FSymbolSize : DatamatrixSymbolSize;
|
|
FEncoding : DatamatrixEncoding;
|
|
FCodePage : integer;
|
|
|
|
procedure SetBit(x, y, xByte : integer);
|
|
procedure Generate(var text : string); overload;
|
|
procedure Generate( var text :TBytes; textOffset, textSize : integer); overload;
|
|
function GetEncodation(var Text : tbytes; textOffset, textSize : integer; var data : Tbytes;
|
|
dataOffset, dataSize : integer; firstMatch : boolean) : integer;
|
|
|
|
procedure Draw(var data : TBytes; dataSize : integer; const dm: DmParams);
|
|
procedure SetCodePage( cp : integer );
|
|
procedure SetEncoding( v : DatamatrixEncoding);
|
|
procedure Ecc200;
|
|
procedure SetSymbolSize( s : DatamatrixSymbolSize);
|
|
function GetPixelSize : integer;
|
|
procedure SetPixelSize(v : integer);
|
|
protected
|
|
procedure SetText(v : string); override;
|
|
|
|
public
|
|
|
|
constructor Create; override;
|
|
destructor Destroy; override;
|
|
procedure Assign(src: TfrxBarcode2DBase);override;
|
|
// procedure Draw2DBarcode(var g : TCanvas; scalex, scaley : extended; x, y : integer ); override;
|
|
|
|
published
|
|
|
|
|
|
property SymbolSize : DatamatrixSymbolSize read FSymbolSize write SetSymbolSize;
|
|
property Encoding : DatamatrixEncoding read FEncoding write SetEncoding;
|
|
property CodePage : integer read FCodePage write SetCodePage;
|
|
property PixelSize : integer read GetPixelSize write SetPixelSize;
|
|
|
|
end;
|
|
|
|
|
|
procedure GenerateECC(var wd : TBytes; nd, datablock, nc : integer );
|
|
|
|
|
|
implementation
|
|
|
|
var
|
|
nrow, ncol : integer;
|
|
|
|
|
|
constructor TfrxBarcodeDataMatrix.Create;
|
|
|
|
begin
|
|
|
|
inherited;
|
|
FSymbolSize := AutoSize;
|
|
FEncoding := Auto;
|
|
FCodePage := 1251;
|
|
FPixelWidth := 3;
|
|
FWidth := 0;
|
|
FPixelHeight := 3;
|
|
FHeight := 0;
|
|
|
|
Generate(FText);
|
|
|
|
end;
|
|
|
|
destructor TfrxBarcodeDataMatrix.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
|
|
//
|
|
|
|
procedure TfrxBarcodeDataMatrix.SetCodepage(cp : integer);
|
|
begin
|
|
|
|
FCodepage := cp;
|
|
Generate(FText);
|
|
|
|
end;
|
|
|
|
|
|
procedure TfrxBarcodeDataMatrix.SetEncoding( v : DatamatrixEncoding);
|
|
begin
|
|
|
|
FEncoding := v;
|
|
Generate(FText);
|
|
|
|
end;
|
|
|
|
procedure TfrxBarcodeDataMatrix.SetSymbolSize( s : DatamatrixSymbolSize );
|
|
begin
|
|
FSymbolSize := s;
|
|
Generate(FText);
|
|
|
|
end;
|
|
|
|
function TfrxBarcodeDataMatrix.GetPixelSize : integer; begin result := FPixelWidth; end;
|
|
procedure TfrxBarcodeDataMatrix.SetPixelSize(v : integer); begin FPixelWidth := v; FPixelHeight := v; end;
|
|
|
|
|
|
|
|
|
|
procedure TfrxBarcodeDataMatrix.Assign(src: TfrxBarcode2DBase);
|
|
var
|
|
BSource : TfrxBarcodeDataMatrix;
|
|
begin
|
|
inherited;
|
|
if src is TfrxBarcodeDataMatrix then
|
|
begin
|
|
BSource := TfrxBarcodeDataMatrix( src );
|
|
FHeight := BSource.FHeight;
|
|
FSymbolSize := BSource.SymbolSize;
|
|
FEncoding := BSource.Encoding;
|
|
FCodePage := BSource.CodePage;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxBarcodeDataMatrix.SetText( v : string);
|
|
begin
|
|
if( FText <> v) then
|
|
begin
|
|
FText := v;
|
|
Generate( FText );
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxBarcodeDataMatrix.SetBit( x, y, xByte : integer);
|
|
begin
|
|
FImage[y * xByte + x div 8] := FImage[y * xByte + x div 8] or ( 128 shr (x and 7) );
|
|
end;
|
|
|
|
|
|
procedure TfrxBarcodeDataMatrix.Draw(var data : tbytes; dataSize : integer; const dm: DmParams);
|
|
var
|
|
k,i, j, p, x, y, xs, ys, z, xByte : integer;
|
|
begin
|
|
|
|
xByte := (dm.width + 7) div 8;
|
|
|
|
for k:=0 to Length(FImage)-1 do
|
|
FImage[k] := 0;
|
|
|
|
//alignment patterns
|
|
//dotted horizontal line
|
|
i := 0;
|
|
while i < dm.height do
|
|
begin
|
|
j := 0;
|
|
while j < dm.width do
|
|
begin
|
|
SetBit(j, i, xByte);
|
|
inc(j,2);
|
|
end;
|
|
inc(i, dm.heightSection);
|
|
end;
|
|
|
|
//solid horizontal line
|
|
i := dm.heightSection - 1;
|
|
while i < dm.height do
|
|
begin
|
|
for j := 0 to dm.width-1 do
|
|
SetBit(j, i, xByte);
|
|
|
|
inc(i,dm.heightSection);
|
|
end;
|
|
|
|
//solid vertical line
|
|
i := 0;
|
|
while i < dm.width do
|
|
begin
|
|
for j:=0 to dm.height-1 do
|
|
SetBit(i, j, xByte);
|
|
inc(i, dm.widthSection);
|
|
end;
|
|
|
|
//dotted vertical line
|
|
i := dm.widthSection - 1;
|
|
while i < dm.width do
|
|
begin
|
|
j := 1;
|
|
while j < dm.height do
|
|
begin
|
|
SetBit(i, j, xByte);
|
|
inc(j,2);
|
|
end;
|
|
inc(i, dm.widthSection);
|
|
end;
|
|
|
|
p := 0;
|
|
ys := 0;
|
|
while ys < dm.height do
|
|
begin
|
|
for y := 1 to dm.heightSection - 2 do
|
|
begin
|
|
xs := 0;
|
|
while xs < dm.width do
|
|
begin
|
|
for x:=1 to dm.widthSection - 2 do
|
|
begin
|
|
z := FPlace[p];
|
|
inc(p);
|
|
if ( (z = 1) or ( (z > 1) and (( data[(z div 8) - 1] and $ff ) and (128 shr (z mod 8)) <> 0) ) ) then
|
|
SetBit(x + xs, y + ys, xByte);
|
|
end;
|
|
inc(xs, dm.widthSection);
|
|
end;
|
|
end;
|
|
inc(ys, dm.heightSection);
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure MakePadding(var data : tbytes; position, count : integer);
|
|
var
|
|
t : integer;
|
|
begin
|
|
//already in ascii mode
|
|
if count > 0 then
|
|
begin
|
|
data[position] := 129;
|
|
inc(position);
|
|
dec(count);
|
|
while count > 0 do
|
|
begin
|
|
t := 129 + (((position + 1) * 149) mod 253) + 1;
|
|
if t > 254 then dec(t,254);
|
|
data[position] := byte(t);
|
|
inc(position);
|
|
dec(count);
|
|
end
|
|
end
|
|
end;
|
|
|
|
function IsDigit( c : integer ) : boolean;
|
|
begin
|
|
result := false;
|
|
if ansichar(c) in ['0'..'9'] then result := true;
|
|
end;
|
|
|
|
|
|
function AsciiEncodation( var text : tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer ) : integer;
|
|
var
|
|
ptrIn, ptrOut,c : integer;
|
|
|
|
begin
|
|
|
|
ptrIn := textOffset;
|
|
ptrOut := dataOffset;
|
|
inc(textLength, textOffset);
|
|
inc(dataLength, dataOffset);
|
|
|
|
while (ptrIn < textLength) do
|
|
begin
|
|
if (ptrOut >= dataLength) then
|
|
begin
|
|
result := -1;
|
|
exit;
|
|
end;
|
|
|
|
c := text[ptrIn] and $ff;
|
|
inc(ptrIn);
|
|
|
|
if IsDigit(c) and (ptrIn < textLength) and IsDigit( text[ptrIn] and $ff ) then
|
|
begin
|
|
data[ptrOut] := byte( (( c - integer('0')) * 10 + ( text[ptrIn] and $ff ) - integer('0') + 130));
|
|
inc(ptrIn);
|
|
inc(ptrOut);
|
|
end
|
|
else
|
|
if c > 127 then
|
|
begin
|
|
if ( ptrOut + 1 ) >= dataLength then
|
|
begin
|
|
result := -1;
|
|
exit;
|
|
end;
|
|
data[ptrOut] := byte(235);
|
|
inc(ptrOut);
|
|
data[ptrOut] := byte(c - 128 + 1);
|
|
inc(ptrOut);
|
|
end
|
|
else
|
|
begin
|
|
data[ptrOut] := byte(c + 1);
|
|
inc(ptrOut);
|
|
end
|
|
end;
|
|
|
|
result := ptrOut - dataOffset;
|
|
end;
|
|
|
|
function B256Encodation(var text : tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer ) : integer;
|
|
var
|
|
k, j, prn, tv, c : integer;
|
|
|
|
begin
|
|
|
|
if textLength = 0 then begin result := 0; exit; end;
|
|
if (textLength < 250) and (textLength + 2 > dataLength) then begin result := -1; exit; end;
|
|
if (textLength >= 250) and (textLength + 3 > dataLength) then begin result := -1; exit; end;
|
|
|
|
data[dataOffset] := byte(231);
|
|
if textLength < 250 then
|
|
begin
|
|
data[dataOffset + 1] := byte(textLength);
|
|
k := 2;
|
|
end
|
|
else
|
|
begin
|
|
data[dataOffset + 1] := byte((textLength div 250) + 249);
|
|
data[dataOffset + 2] := byte( textLength mod 250 );
|
|
k := 3;
|
|
end;
|
|
|
|
for j := 0 to textLength-1 do
|
|
data[k + dataOffset + j] := byte(text[textOffset + j]);
|
|
|
|
inc(k, textLength + dataOffset);
|
|
|
|
for j := dataOffset + 1 to k-1 do
|
|
begin
|
|
c := data[j] and $ff;
|
|
prn := ((149 * (j + 1)) mod 255) + 1;
|
|
tv := c + prn;
|
|
if (tv > 255) then dec(tv, 256);
|
|
data[j] := byte(tv);
|
|
end;
|
|
result := k - dataOffset;
|
|
end;
|
|
|
|
|
|
|
|
function X12Encodation(var text: tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer ) : integer;
|
|
var
|
|
ptrIn, ptrOut, count, k, n, ci, i : integer;
|
|
c : byte;
|
|
x : array of byte;
|
|
begin
|
|
|
|
if (textLength = 0) then begin result := 0; exit; end;
|
|
ptrOut := 0;
|
|
SetLength( x, textLength);
|
|
|
|
count := 0;
|
|
for ptrIn := 0 to textLength - 1 do
|
|
begin
|
|
i := Pos( char(text[ptrIn + textOffset]), _x12) - 1;
|
|
if (i >= 0) then
|
|
begin
|
|
x[ptrIn] := byte(i);
|
|
inc(count);
|
|
end
|
|
else
|
|
begin
|
|
x[ptrIn] := byte(100);
|
|
if (count >= 6) then
|
|
dec(count, (count div 3) * 3 );
|
|
for k := 0 to count-1 do
|
|
x[ptrIn - k - 1] := byte(100);
|
|
count := 0;
|
|
end
|
|
end;
|
|
|
|
ptrIn := textLength - 1;
|
|
|
|
if (count >= 6) then dec(count, (count div 3) * 3);
|
|
for k := 0 to count-1 do
|
|
x[ptrIn - k - 1] := byte(100);
|
|
|
|
ptrIn := 0;
|
|
while ptrIn < textLength do
|
|
begin
|
|
c := x[ptrIn];
|
|
if (ptrOut >= dataLength) then break;
|
|
if (c < 40) then
|
|
begin
|
|
if (ptrIn = 0) or ( (ptrIn > 0 ) and ( x[ptrIn - 1] > 40 ) ) then
|
|
begin
|
|
data[dataOffset + ptrOut] := byte(238);
|
|
inc(ptrOut);
|
|
end;
|
|
|
|
if (ptrOut + 2 > dataLength) then
|
|
break;
|
|
n := 1600 * x[ptrIn] + 40 * x[ptrIn + 1] + x[ptrIn + 2] + 1;
|
|
data[dataOffset + ptrOut] := byte(n div 256);
|
|
inc(ptrOut);
|
|
data[dataOffset + ptrOut] := byte(n);
|
|
inc(ptrOut);
|
|
inc(ptrIn, 2);
|
|
end
|
|
else
|
|
begin
|
|
if (ptrIn > 0) and (x[ptrIn - 1] < 40) then
|
|
begin
|
|
data[dataOffset + ptrOut] := byte(254);
|
|
inc(ptrOut);
|
|
end;
|
|
ci := text[ptrIn + textOffset] and $ff;
|
|
if (ci > 127) then
|
|
begin
|
|
data[dataOffset + ptrOut] := byte(235);
|
|
inc(ptrOut);
|
|
dec(ci, 128);
|
|
end;
|
|
if (ptrOut >= dataLength) then
|
|
break;
|
|
data[dataOffset + ptrOut] := byte(ci + 1);
|
|
inc(ptrOut);
|
|
end;
|
|
inc(ptrIn);
|
|
end;
|
|
c := 100;
|
|
if (textLength > 0) then
|
|
c := x[textLength - 1];
|
|
if (ptrIn <> textLength) or ( (c < 40 ) and (ptrOut >= dataLength)) then
|
|
begin
|
|
result := -1;
|
|
exit;
|
|
end;
|
|
if (c < 40) then
|
|
begin
|
|
data[dataOffset + ptrOut] := byte(254);
|
|
inc(ptrOut);
|
|
end;
|
|
|
|
result := ptrOut;
|
|
|
|
end;
|
|
|
|
|
|
function EdifactEncodation(var text: tbytes; textOffset, textLength: integer; var data: tbytes; dataOffset, dataLength: integer): integer;
|
|
var
|
|
ptrIn, ptrOut, edi, pedi, c : integer;
|
|
Ascii : boolean;
|
|
begin
|
|
|
|
if (textLength = 0) then begin result := 0; exit; end;
|
|
ptrOut := 0;
|
|
edi := 0;
|
|
pedi := 18;
|
|
Ascii := true;
|
|
|
|
for ptrIn := 0 to textLength-1 do
|
|
begin
|
|
c := text[ptrIn + textOffset] and $ff;
|
|
if ( ( (c and $e0) = $40 ) or ( (c and $e0) = $20) )
|
|
and
|
|
(char(c) <> '_' ) then
|
|
begin
|
|
if (Ascii) then
|
|
begin
|
|
if (ptrOut + 1 > dataLength) then break;
|
|
data[dataOffset + ptrOut] := byte(240);
|
|
inc(ptrOut);
|
|
Ascii := false;
|
|
end;
|
|
c := c and $3f;
|
|
edi := edi or (c shl pedi);
|
|
if (pedi = 0) then
|
|
begin
|
|
if (ptrOut + 3 > dataLength) then break;
|
|
data[dataOffset + ptrOut] := byte(edi shr 16); inc(ptrOut);
|
|
data[dataOffset + ptrOut] := byte(edi shr 8); inc(ptrOut);
|
|
data[dataOffset + ptrOut] := byte(edi); inc(ptrOut);
|
|
edi := 0;
|
|
pedi := 18;
|
|
end
|
|
else
|
|
dec(pedi,6);
|
|
end
|
|
else
|
|
begin
|
|
if (not Ascii) then
|
|
begin
|
|
edi := edi or ( (integer('_') and $3f) shl pedi);
|
|
if (ptrOut + (3 - ( pedi div 8 )) > dataLength) then break;
|
|
data[dataOffset + ptrOut] := byte(edi shr 16); inc(ptrOut);
|
|
if (pedi <= 12) then
|
|
begin
|
|
data[dataOffset + ptrOut] := byte(edi shr 8); inc(ptrOut);
|
|
end;
|
|
if (pedi <= 6) then
|
|
begin
|
|
data[dataOffset + ptrOut] := byte(edi); inc(ptrOut);
|
|
end;
|
|
Ascii := true;
|
|
pedi := 18;
|
|
edi := 0;
|
|
end;
|
|
if (c > 127) then
|
|
begin
|
|
if (ptrOut >= dataLength) then break;
|
|
data[dataOffset + ptrOut] := byte(235);
|
|
inc(ptrOut);
|
|
dec(c, 128);
|
|
end;
|
|
if (ptrOut >= dataLength) then break;
|
|
data[dataOffset + ptrOut] := byte(c + 1);
|
|
inc(ptrOut);
|
|
end;
|
|
|
|
end; // for
|
|
|
|
if ( ptrIn <> textLength) then begin result := -1; exit; end;
|
|
if (not Ascii) then
|
|
begin
|
|
edi := edi or ( (integer('_') and $3f) shl pedi );
|
|
if (ptrOut + (3 - (pedi div 8)) > dataLength) then begin result:= - 1; exit; end;
|
|
data[dataOffset + ptrOut] := byte(edi shr 16);
|
|
inc(ptrOut);
|
|
if ( pedi <= 12) then
|
|
begin
|
|
data[dataOffset + ptrOut] := byte(edi shr 8);
|
|
inc(ptrOut);
|
|
end;
|
|
if ( pedi <= 6 ) then
|
|
begin
|
|
data[dataOffset + ptrOut] := byte(edi);
|
|
inc(ptrOut);
|
|
end;
|
|
end;
|
|
|
|
result := ptrOut;
|
|
|
|
end;
|
|
|
|
function C40OrTextEncodation(var Text : tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer;
|
|
C40 : boolean ) : integer;
|
|
var
|
|
|
|
ptrIn, ptrOut, encPtr, last0, last1, i, a, c, idx : integer;
|
|
basic, shift2, shift3 : string;
|
|
enc : array of integer;
|
|
|
|
begin
|
|
|
|
if (textLength = 0) then begin result := 0; exit; end;
|
|
ptrIn := 0;
|
|
ptrOut := 0;
|
|
if (C40) then
|
|
begin
|
|
data[dataOffset + ptrOut] := byte(230);
|
|
inc(ptrOut);
|
|
end
|
|
else
|
|
begin
|
|
data[dataOffset + ptrOut] := byte(239);
|
|
inc(ptrOut);
|
|
end;
|
|
|
|
shift2 := '!\"#$%&'+#39+'()*+,-./:;<=>?@[\\]^_';
|
|
if (C40) then
|
|
begin
|
|
basic := ' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
|
|
shift3 := '`abcdefghijklmnopqrstuvwxyz{|}~' + #127;
|
|
end
|
|
else
|
|
begin
|
|
basic := ' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
|
|
shift3 := '`abcdefghijklmnopqrstuvwxyz{|}~' + #127;
|
|
end;
|
|
|
|
SetLength( enc, textLength * 4 + 10);
|
|
encPtr := 0;
|
|
last0 := 0;
|
|
last1 := 0;
|
|
|
|
while (ptrIn < textLength) do
|
|
begin
|
|
if ((encPtr mod 3) = 0) then
|
|
begin
|
|
last0 := ptrIn;
|
|
last1 := encPtr;
|
|
end;
|
|
c := text[textOffset + ptrIn] and $ff;
|
|
inc(ptrIn);
|
|
if (c > 127) then
|
|
begin
|
|
dec(c, 128);
|
|
enc[encPtr] := 1; inc(encPtr);
|
|
enc[encPtr] := 30; inc(encPtr);
|
|
end;
|
|
|
|
idx := Pos( char(c), basic) - 1;
|
|
if (idx >= 0) then
|
|
begin
|
|
enc[encPtr] := idx + 3;
|
|
inc(encPtr);
|
|
end
|
|
else
|
|
if (c < 32) then
|
|
begin
|
|
enc[encPtr] := 0; inc(encPtr);
|
|
enc[encPtr] := c; inc(encPtr);
|
|
end
|
|
else
|
|
begin
|
|
idx := Pos( char(c), shift2) - 1;
|
|
if ( idx >= 0 ) then
|
|
begin
|
|
enc[encPtr] := 1; inc(encPtr);
|
|
enc[encPtr] := idx; inc(encPtr);
|
|
end
|
|
else
|
|
begin
|
|
idx := Pos( char(c), shift3) - 1;
|
|
if ( idx >= 0) then
|
|
begin
|
|
enc[encPtr] := 2; inc(encPtr);
|
|
enc[encPtr] := idx; inc(encPtr);
|
|
end
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if ((encPtr mod 3) <> 0) then
|
|
begin
|
|
ptrIn := last0;
|
|
encPtr := last1;
|
|
end;
|
|
|
|
if ( (encPtr div 3) * 2 > dataLength - 2) then
|
|
begin
|
|
result := - 1;
|
|
exit;
|
|
end;
|
|
|
|
i := 0;
|
|
while i < encPtr do
|
|
begin
|
|
a := 1600 * enc[i] + 40 * enc[i + 1] + enc[i + 2] + 1;
|
|
data[dataOffset + ptrOut] := byte(a div 256); inc(ptrOut);
|
|
data[dataOffset + ptrOut] := byte(a); inc(ptrOut);
|
|
inc(i, 3);
|
|
end;
|
|
|
|
data[ptrOut] := byte(254);
|
|
inc(ptrOut);
|
|
i := AsciiEncodation(Text, ptrIn, textLength - ptrIn, data, ptrOut, dataLength - ptrOut);
|
|
if (i < 0) then
|
|
result := i
|
|
else
|
|
result := ptrOut + i;
|
|
end;
|
|
|
|
function TfrxBarcodeDataMatrix.GetEncodation(var Text : tbytes; textOffset, textSize : integer; var data : tbytes;
|
|
dataOffset, dataSize : integer; firstMatch : boolean) : integer;
|
|
var
|
|
e, j, k : integer;
|
|
e1 : array[0..5] of integer;
|
|
|
|
begin
|
|
|
|
if (dataSize < 0) then
|
|
begin
|
|
result := -1;
|
|
exit;
|
|
end;
|
|
|
|
if ( FEncoding = Auto) then
|
|
begin
|
|
e1[0] := AsciiEncodation(text, textOffset, textSize, data, dataOffset, dataSize);
|
|
if firstMatch and ( e1[0] >= 0 ) then begin result := e1[0]; exit; end;
|
|
e1[1] := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, false);
|
|
if firstMatch and ( e1[1] >= 0 ) then begin result := e1[1]; exit; end;
|
|
e1[2] := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, true);
|
|
if firstMatch and ( e1[2] >= 0 ) then begin result := e1[2]; exit; end;
|
|
e1[3] := B256Encodation(text, textOffset, textSize, data, dataOffset, dataSize);
|
|
if firstMatch and ( e1[3] >= 0 ) then begin result := e1[3]; exit; end;
|
|
e1[4] := X12Encodation(text, textOffset, textSize, data, dataOffset, dataSize);
|
|
if firstMatch and ( e1[4] >= 0 ) then begin result := e1[4]; exit; end;
|
|
e1[5] := EdifactEncodation(text, textOffset, textSize, data, dataOffset, dataSize);
|
|
if firstMatch and ( e1[5] >= 0 ) then begin result := e1[5]; exit; end;
|
|
if (e1[0] < 0) and (e1[1] < 0) and (e1[2] < 0) and (e1[3] < 0) and (e1[4] < 0) and (e1[5] < 0) then
|
|
begin
|
|
result := -1;
|
|
exit;
|
|
end;
|
|
|
|
j := 0;
|
|
e := 99999;
|
|
for k := 0 to 5 do
|
|
if (e1[k] >= 0 ) and (e1[k] < e) then
|
|
begin
|
|
e := e1[k];
|
|
j := k;
|
|
end;
|
|
|
|
if (j = 0) then
|
|
e := AsciiEncodation(text, textOffset, textSize, data, dataOffset, dataSize)
|
|
else
|
|
if (j = 1) then
|
|
e := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, false)
|
|
else
|
|
if (j = 2) then
|
|
e := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, true)
|
|
else
|
|
if (j = 3) then
|
|
e := B256Encodation(text, textOffset, textSize, data, dataOffset, dataSize)
|
|
else
|
|
if (j = 4) then
|
|
e := X12Encodation(text, textOffset, textSize, data, dataOffset, dataSize);
|
|
result := e;
|
|
exit;
|
|
end;
|
|
|
|
case (FEncoding) of
|
|
|
|
Ascii: begin result := AsciiEncodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
|
|
C40: begin result := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, true); exit; end;
|
|
Txt: begin result := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, false); exit; end;
|
|
Base256: begin result := B256Encodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
|
|
X12: begin result := X12Encodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
|
|
Edifact: begin result := EdifactEncodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
|
|
|
|
end;
|
|
result := -1;
|
|
|
|
end;
|
|
|
|
function ReplaceControlCodes(var text: string) : string;
|
|
begin
|
|
if Pos('&1;', text) = 1 then
|
|
begin
|
|
Delete(text,1,3);
|
|
text := #232 + text;
|
|
end;
|
|
result := ReplaceStr(text, '&1;', string(#29));
|
|
end;
|
|
|
|
procedure TfrxBarcodeDataMatrix.Generate(var text : string);
|
|
var
|
|
t :TBytes;
|
|
e : TEncoding;
|
|
begin
|
|
|
|
text := ReplaceControlCodes(text);
|
|
e := TEncoding.GetEncoding(CodePage);
|
|
try
|
|
t := e.GetBytes(text);
|
|
finally
|
|
e.Free;
|
|
end;
|
|
Generate(t, 0, Length(t));
|
|
|
|
end;
|
|
|
|
procedure TfrxBarcodeDataMatrix.Generate(var text: TBytes; textOffset, textSize : integer);
|
|
|
|
var
|
|
e, full, extCount : integer;
|
|
dm, last : DmParams;
|
|
data : TBytes;
|
|
k : DatamatrixSymbolSize;
|
|
|
|
begin
|
|
|
|
ErrorText := '';
|
|
extCount := 0;
|
|
SetLength(data, 2500);
|
|
if ( Length(text) > 0) and ( text[0] = byte(232)) then
|
|
begin
|
|
data[0] := byte(232);
|
|
inc(textOffset);
|
|
dec(textSize);
|
|
extCount := 1;
|
|
end;
|
|
|
|
// ïðîâåðÿåì, âîçìîæíà ëè âîîáùå êîäèðîâêà òàêîãî òåêñòà ïî äëèíå
|
|
last := dmSizes[ High(dmSizes) ];
|
|
e := GetEncodation(text, textOffset, textSize, data, extCount, last.dataSize, false); // åñëè êîäèðîâêà Auto, òî âåðíåò ñàìóþ êîðîòêóþ äëèíó êîäà
|
|
// èíà÷å äëèíó êîäà äëÿ òåêóùåé êîäèðîâêè èëè -1, åñëè íå óìåùàåòñÿ
|
|
|
|
try
|
|
|
|
if (e < 0) then
|
|
begin
|
|
raise Exception.Create('The text is too big.');
|
|
end;
|
|
|
|
inc(e, extCount); // ó÷èòûâàåì ðàñøèðåíèÿ
|
|
|
|
// òåêñò îïðåäåëåííî êîäèðóåòñÿ,
|
|
// äëèíà êîäà ñåé÷àñ â E, îïðåäåëèìñÿ ñ ðàçìåðîì ñèìâîëà
|
|
|
|
if FSymbolSize = AutoSize then
|
|
begin
|
|
|
|
for k := Size10x10 to High(dmSizes) do
|
|
if dmSizes[k].datasize >= e then
|
|
break;
|
|
|
|
dm := dmSizes[k];
|
|
FHeight := dm.height;
|
|
FWidth := dm.width;
|
|
|
|
end
|
|
else
|
|
begin
|
|
|
|
dm := dmSizes[FSymbolSize];
|
|
e := GetEncodation(text, textOffset, textSize, data, extCount, dm.dataSize, false);
|
|
|
|
if (e < 0) then
|
|
begin
|
|
raise Exception.Create(' The text is too big.');
|
|
end;
|
|
|
|
FHeight := dm.height;
|
|
FWidth := dm.width;
|
|
inc(e, extCount);
|
|
|
|
end;
|
|
|
|
SetLength(FImage, ((dm.width + 7) div 8) * dm.height );
|
|
MakePadding(data, e, dm.dataSize - e);
|
|
nrow := dm.height - ( (dm.height div dm.heightSection) * 2);
|
|
ncol := dm.width - ( ( dm.width div dm.widthSection ) * 2);
|
|
SetLength(FPlace, nrow * ncol);
|
|
Ecc200;
|
|
|
|
full := dm.dataSize + ((dm.dataSize + 2) div dm.dataBlock) * dm.errorBlock;
|
|
GenerateECC(data, dm.dataSize, dm.dataBlock, dm.errorBlock);
|
|
Draw(data, full, dm);
|
|
|
|
except
|
|
on e: Exception do
|
|
begin
|
|
// FText := cbDefaultText;
|
|
ErrorText := e.Message;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
//* "ECC200" fills an nrow x ncol array with appropriate values for ECC200 */
|
|
procedure TfrxBarcodeDataMatrix.Ecc200;
|
|
|
|
//* "module" places "chr+bit" with appropriate wrapping within array[] */
|
|
procedure Module( row, col, chr, bit : integer);
|
|
begin
|
|
if (row < 0) then begin row := row + nrow; col := col + 4 - ((nrow + 4) mod 8); end;
|
|
if (col < 0) then begin col := col + ncol; row := row + 4 - ((ncol + 4) mod 8); end;
|
|
FPlace[row * ncol + col] := integer(8 * chr + bit);
|
|
end;
|
|
|
|
//* "utah" places the 8 bits of a utah-shaped symbol character in ECC200 */
|
|
|
|
procedure Utah( row, col, chr : integer);
|
|
begin
|
|
Module(row - 2, col - 2, chr, 0);
|
|
Module(row - 2, col - 1, chr, 1);
|
|
Module(row - 1, col - 2, chr, 2);
|
|
Module(row - 1, col - 1, chr, 3);
|
|
Module(row - 1, col, chr, 4);
|
|
Module(row, col - 2, chr, 5);
|
|
Module(row, col - 1, chr, 6);
|
|
Module(row, col, chr, 7);
|
|
end;
|
|
|
|
//* "cornerN" places 8 bits of the four special corner cases in ECC200 */
|
|
procedure Corner1( chr : integer);
|
|
begin
|
|
Module(nrow - 1, 0, chr, 0);
|
|
Module(nrow - 1, 1, chr, 1);
|
|
Module(nrow - 1, 2, chr, 2);
|
|
Module(0, ncol - 2, chr, 3);
|
|
Module(0, ncol - 1, chr, 4);
|
|
Module(1, ncol - 1, chr, 5);
|
|
Module(2, ncol - 1, chr, 6);
|
|
Module(3, ncol - 1, chr, 7);
|
|
end;
|
|
|
|
procedure Corner2( chr : integer);
|
|
begin
|
|
Module(nrow - 3, 0, chr, 0);
|
|
Module(nrow - 2, 0, chr, 1);
|
|
Module(nrow - 1, 0, chr, 2);
|
|
Module(0, ncol - 4, chr, 3);
|
|
Module(0, ncol - 3, chr, 4);
|
|
Module(0, ncol - 2, chr, 5);
|
|
Module(0, ncol - 1, chr, 6);
|
|
Module(1, ncol - 1, chr, 7);
|
|
end;
|
|
|
|
procedure Corner3( chr : integer);
|
|
begin
|
|
Module(nrow - 3, 0, chr, 0);
|
|
Module(nrow - 2, 0, chr, 1);
|
|
Module(nrow - 1, 0, chr, 2);
|
|
Module(0, ncol - 2, chr, 3);
|
|
Module(0, ncol - 1, chr, 4);
|
|
Module(1, ncol - 1, chr, 5);
|
|
Module(2, ncol - 1, chr, 6);
|
|
Module(3, ncol - 1, chr, 7);
|
|
end;
|
|
|
|
procedure Corner4( chr : integer);
|
|
begin
|
|
Module(nrow - 1, 0, chr, 0);
|
|
Module(nrow - 1, ncol - 1, chr, 1);
|
|
Module(0, ncol - 3, chr, 2);
|
|
Module(0, ncol - 2, chr, 3);
|
|
Module(0, ncol - 1, chr, 4);
|
|
Module(1, ncol - 3, chr, 5);
|
|
Module(1, ncol - 2, chr, 6);
|
|
Module(1, ncol - 1, chr, 7);
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
row, col, chr, k : integer;
|
|
|
|
label l1,l2,l3;
|
|
|
|
begin
|
|
|
|
//* First, fill the array[] with invalid entries */
|
|
for k := 0 to Length(FPlace) - 1 do
|
|
FPlace[k] := 0;
|
|
//* Starting in the correct location for character #1, bit 8,... */
|
|
chr := 1; row := 4; col := 0;
|
|
l1://repeat
|
|
//* repeatedly first check for one of the special corner cases, then... */
|
|
if ((row = nrow) and (col = 0)) then begin Corner1(chr); inc(chr); end;
|
|
if ((row = nrow - 2) and (col = 0) and ( (ncol mod 4 ) <> 0)) then
|
|
begin Corner2(chr); inc(chr); end;
|
|
if ((row = nrow - 2) and (col = 0) and ( ( ncol mod 8 ) = 4)) then
|
|
begin Corner3(chr); inc(chr); end;
|
|
if ((row = nrow + 4) and (col = 2) and ( ( ncol mod 8 ) = 0)) then
|
|
begin Corner4(chr); inc(chr); end;
|
|
//* sweep upward diagonally, inserting successive characters,... */
|
|
l2: //repeat
|
|
|
|
if ((row < nrow) and (col >= 0) and ( FPlace[row * ncol + col] = 0)) then
|
|
|
|
begin
|
|
Utah(row, col, chr);
|
|
inc(chr);
|
|
end;
|
|
dec(row, 2); inc(col, 2);
|
|
//until not((row >= 0) and (col < ncol));
|
|
if ((row >= 0) and (col < ncol)) then goto l2;
|
|
inc(row);
|
|
inc(col, 3);
|
|
//* & then sweep downward diagonally, inserting successive characters,... */
|
|
l3: //repeat
|
|
if ((row >= 0) and (col < ncol) and (FPlace[row * ncol + col] = 0)) then
|
|
begin
|
|
Utah(row, col, chr);
|
|
inc(chr);
|
|
end;
|
|
inc(row,2);
|
|
dec(col, 2);
|
|
//until not ((row < nrow) and (col >= 0));
|
|
if((row < nrow) and (col >= 0)) then goto l3;
|
|
inc(row, 3);
|
|
inc( col, 1);
|
|
//* ... until the entire array is scanned */
|
|
//until not ((row < nrow) or (col < ncol));
|
|
if(((row < nrow) or (col < ncol))) then goto l1;
|
|
//* Lastly, if the lower righthand corner is untouched, fill in fixed pattern */
|
|
if (FPlace[nrow * ncol - 1] = 0) then
|
|
begin
|
|
FPlace[nrow * ncol - 1] := 1;
|
|
FPlace[nrow * ncol - ncol - 2] := 1;
|
|
end
|
|
end;
|
|
|
|
procedure ReedSolomonBlock(var wd : TBytes; nd : integer; var ncout : TBytes; nc: integer; var c : TInts );
|
|
var
|
|
|
|
i,j,k : integer;
|
|
|
|
begin
|
|
|
|
for i := 0 to nc do
|
|
ncout[i] := 0;
|
|
for i := 0 to nd-1 do
|
|
begin
|
|
k := ( ncout[0] xor wd[i] ) and $ff;
|
|
for j := 0 to nc-1 do
|
|
begin
|
|
if( k = 0 ) then
|
|
ncout[j] := byte( ncout[j + 1] xor byte(0) )
|
|
else
|
|
ncout[j] := byte( ncout[j + 1]
|
|
xor (byte( alog[ (log[k] + log[ c[nc - j - 1] ] ) mod 255 ] )) );
|
|
end
|
|
end
|
|
end;
|
|
|
|
procedure GenerateECC(var wd : TBytes; nd, datablock, nc : integer );
|
|
var
|
|
|
|
blocks, b, n, p : integer;
|
|
buf, ecc : TBytes;
|
|
c : Pointer;
|
|
|
|
begin
|
|
|
|
blocks := (nd + 2) div datablock;
|
|
SetLength(buf, 256);
|
|
SetLength(ecc, 256);
|
|
c := nil;
|
|
case nc of
|
|
5: c := @poly5;
|
|
7: c := @poly7;
|
|
10:c := @poly10;
|
|
11:c := @poly11;
|
|
12:c := @poly12;
|
|
14:c := @poly14;
|
|
18:c := @poly18;
|
|
20:c := @poly20;
|
|
24:c := @poly24;
|
|
28:c := @poly28;
|
|
36:c := @poly36;
|
|
42:c := @poly42;
|
|
48:c := @poly48;
|
|
56:c := @poly56;
|
|
62:c := @poly62;
|
|
68:c := @poly68;
|
|
end;
|
|
for b := 0 to blocks-1 do
|
|
begin
|
|
p := 0;
|
|
n := b;
|
|
while n < nd do
|
|
begin
|
|
buf[p] := wd[n];
|
|
inc(p);
|
|
inc(n, blocks);
|
|
end;
|
|
ReedSolomonBlock(buf, p, ecc, nc, TInts(c));
|
|
p := 0;
|
|
n := b;
|
|
while n < nc * blocks do
|
|
begin
|
|
wd[nd + n] := ecc[p];
|
|
inc(p);
|
|
inc(n, blocks);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
initialization
|
|
|
|
|
|
|
|
finalization
|
|
|
|
|
|
end.
|