1368 lines
44 KiB
ObjectPascal
1368 lines
44 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
|
||
//
|
||
//
|
||
//
|
||
//
|
||
|
||
|
||
unit frxBarcodeDataMatrix;
|
||
|
||
|
||
interface
|
||
|
||
{$I frx.inc}
|
||
|
||
uses
|
||
{$IFDEF FPC}
|
||
LCLType, LMessages, LazHelper, LCLIntf,
|
||
{$ELSE}
|
||
Windows, Messages,
|
||
{$ENDIF}
|
||
SysUtils, Types, StrUtils, Classes, Graphics, Controls, Forms, Dialogs, frxBarcode2DBase, frxUnicodeUtils, frxGS1Helper;
|
||
|
||
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 : extended;
|
||
width : extended;
|
||
end;
|
||
|
||
TInts = array of integer;
|
||
|
||
// /////////////////////////////////////////////////////////////////////////
|
||
// Generates the 2D Data Matrix barcode. /////////////////////////////////////////////////////////////////////////
|
||
// /////////////////////////////////////////////////////////////////////////
|
||
|
||
{$M+}
|
||
TfrxBarcodeDataMatrix = class( TfrxBarcode2DBaseWithUnion )
|
||
|
||
private
|
||
|
||
FPlace : TInts;
|
||
FSymbolSize : DatamatrixSymbolSize;
|
||
FEncoding : DatamatrixEncoding;
|
||
FCodePage : integer;
|
||
FGS1Rule : Boolean;
|
||
|
||
ArrOB: T2DBooleanArray;
|
||
|
||
procedure SetGS1Rule(b: Boolean);
|
||
procedure SetBit(x, y : integer);
|
||
procedure Generate(var text : string); overload;
|
||
procedure Generate( var text: array of byte; textOffset, textSize : integer); overload;
|
||
function GetEncodation(var Text : array of byte; textOffset, textSize : integer; var data : array of byte;
|
||
dataOffset, dataSize : integer; firstMatch : boolean) : integer;
|
||
|
||
procedure Draw(var data : array of byte; 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;
|
||
property GS1Rule : Boolean read FGS1Rule write SetGS1Rule;
|
||
|
||
end;
|
||
|
||
|
||
procedure GenerateECC(var wd : array of byte; nd, datablock, nc : integer );
|
||
|
||
|
||
implementation
|
||
|
||
{$IFDEF DELPHI12}
|
||
uses AnsiStrings;
|
||
{$ENDIF}
|
||
|
||
var
|
||
nrow, ncol : integer;
|
||
|
||
|
||
constructor TfrxBarcodeDataMatrix.Create;
|
||
|
||
begin
|
||
|
||
inherited;
|
||
FSymbolSize := AutoSize;
|
||
FEncoding := Auto;
|
||
FCodePage := 437;
|
||
PixelWidth := 4;
|
||
PixelHeight := 4;
|
||
FWidth := 0;
|
||
FHeight := 0;
|
||
GS1Rule := False;
|
||
|
||
Generate(FText);
|
||
|
||
end;
|
||
|
||
destructor TfrxBarcodeDataMatrix.Destroy;
|
||
begin
|
||
SetLength(FPlace, 0);
|
||
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.SetGS1Rule(b: Boolean);
|
||
begin
|
||
if (FGS1Rule <> b) then
|
||
begin
|
||
FGS1Rule := b;
|
||
Generate(FText);
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxBarcodeDataMatrix.SetBit( x, y : integer);
|
||
begin
|
||
ArrOB[x][y] := True;
|
||
end;
|
||
|
||
|
||
procedure TfrxBarcodeDataMatrix.Draw(var data : array of byte; dataSize : integer; const dm: DmParams);
|
||
var
|
||
i, j, p, x, y, xs, ys, z : integer;
|
||
begin
|
||
//doter in doter-line can become part of the figure
|
||
|
||
//dotted horizontal line
|
||
i := 0;
|
||
while i < dm.height do
|
||
begin
|
||
j := 2;//not need dot at (0, 0) it is solid line
|
||
while j < dm.width do
|
||
begin
|
||
SetBit(j, i);
|
||
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);
|
||
|
||
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);
|
||
inc(i, dm.widthSection);
|
||
end;
|
||
|
||
//dotted vertical line
|
||
i := dm.widthSection - 1;
|
||
while i < dm.width do
|
||
begin
|
||
j := 1;
|
||
while j < dm.height-2 do //not need dot at (0, dm.height) it is solid line
|
||
begin
|
||
SetBit(i, j);
|
||
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);
|
||
end;
|
||
inc(xs, dm.widthSection);
|
||
end;
|
||
end;
|
||
inc(ys, dm.heightSection);
|
||
end;
|
||
end;
|
||
|
||
procedure MakePadding(var data : array of byte; position, count : integer);
|
||
var
|
||
t : integer;
|
||
begin
|
||
// set to ascii mode
|
||
if (count > 0) and (position > 0) then
|
||
begin
|
||
if data[position - 1] <> 254 then
|
||
data[position] := 254;
|
||
inc(position);
|
||
dec(count);
|
||
end;
|
||
// 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;
|
||
{$IFDEF Delphi12}
|
||
if CharInSet(char(c), ['0'..'9']) then result := true;
|
||
{$ELSE}
|
||
if char(c) in ['0'..'9'] then result := true;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
|
||
function AsciiEncodation( var text : array of byte; textOffset, textLength : integer; var data : array of byte; 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 : array of byte; textOffset, textLength : integer; var data : array of byte; 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: array of byte; textOffset, textLength : integer; var data : array of byte; 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;
|
||
|
||
if (count >= 6) then dec(count, (count div 3) * 3);
|
||
ptrIn := textLength;
|
||
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;
|
||
// need try finally
|
||
SetLength( x, 0);
|
||
end;
|
||
|
||
|
||
function EdifactEncodation(var text: array of byte; textOffset, textLength: integer; var data: array of byte; 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 : array of byte; textOffset, textLength : integer; var data : array of byte; 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
|
||
data[dataOffset + ptrOut] := byte(230)
|
||
else
|
||
data[dataOffset + ptrOut] := byte(239);
|
||
inc(ptrOut);
|
||
|
||
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;
|
||
|
||
try
|
||
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 - 1) 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;
|
||
|
||
i := 0;
|
||
if textLength - ptrIn > 0 then
|
||
begin
|
||
data[dataOffset + ptrOut] := byte(254);
|
||
inc(ptrOut);
|
||
i := AsciiEncodation(Text, dataOffset + ptrIn, textLength - ptrIn, data, dataOffset + ptrOut, dataLength - (dataOffset +ptrOut));
|
||
end;
|
||
|
||
if (i < 0) then
|
||
result := i
|
||
else
|
||
result := ptrOut + i;
|
||
finally
|
||
SetLength( enc, 0);
|
||
end;
|
||
|
||
end;
|
||
|
||
function TfrxBarcodeDataMatrix.GetEncodation(var Text : array of byte; textOffset, textSize : integer; var data : array of byte;
|
||
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: AnsiString) : AnsiString;
|
||
begin
|
||
if Pos(AnsiString('&1;'), text) = 1 then
|
||
begin
|
||
Delete(text,1,3);
|
||
text := AnsiString(#232) + text;
|
||
end;
|
||
{$IFDEF DELPHI12}
|
||
result := AnsiStrings.StringReplace(text, '&1;', AnsiString(#29), [rfReplaceAll]);
|
||
{$ELSE}
|
||
result := StringReplace(text, '&1;', AnsiString(#29), [rfReplaceAll]);
|
||
{$ENDIF}
|
||
end;
|
||
|
||
procedure TfrxBarcodeDataMatrix.Generate(var text : string);
|
||
var
|
||
t : array of byte;
|
||
i: Integer;
|
||
AnsiText: AnsiString;
|
||
{$IFNDEF DELPHI12}
|
||
WideText: WideString;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFNDEF DELPHI12}
|
||
WideText := WideString(text);
|
||
if FCodePage = 65001 then
|
||
AnsiText := UTF8Encode(WideText)
|
||
else
|
||
AnsiText := _UnicodeToAnsi(WideText, 0, FCodePage);
|
||
{$ELSE}
|
||
if FCodePage = 65001 then
|
||
AnsiText := UTF8Encode(text)
|
||
else
|
||
AnsiText := _UnicodeToAnsi(text, 0, FCodePage);
|
||
{$ENDIF}
|
||
if FGS1Rule then
|
||
AnsiText := ParseGS1(AnsiText);
|
||
AnsiText := ReplaceControlCodes(AnsiText);
|
||
SetLength(t, Length(AnsiText));
|
||
try
|
||
for i := 1 to Length(AnsiText) do
|
||
t[i - 1] := Ord(AnsiText[i]);
|
||
Generate(t, 0, Length(t));
|
||
finally
|
||
SetLength(t, 0);
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxBarcodeDataMatrix.Generate( var text :array of byte; textOffset, textSize : integer);
|
||
|
||
var
|
||
e, full, extCount,i ,j : integer;
|
||
dm, last : DmParams;
|
||
data : array of byte;
|
||
k : DatamatrixSymbolSize;
|
||
|
||
begin
|
||
|
||
ErrorText := '';
|
||
extCount := 0;
|
||
SetLength(data, 2500);
|
||
|
||
try
|
||
if ( Length(text) > 0) and ( text[0] = byte(232)) then
|
||
begin
|
||
data[0] := byte(232);
|
||
inc(textOffset);
|
||
dec(textSize);
|
||
extCount := 1;
|
||
end;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
last := dmSizes[ High(dmSizes) ];
|
||
e := GetEncodation(text, textOffset, textSize, data, extCount, last.dataSize, false); // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Auto, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> // <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> -1, <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
try
|
||
|
||
if (e < 0) then
|
||
begin
|
||
raise Exception.Create('The text is too big.');
|
||
end;
|
||
|
||
inc(e, extCount); // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>,
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> E, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
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(ArrOB, dm.width, dm.height );
|
||
for i := 0 to dm.width-1 do
|
||
for j := 0 to dm.height-1 do
|
||
ArrOB[i][j] := False;
|
||
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);
|
||
T2DBooleanArrayToVectorPrimitives(ArrOB, dm.width, dm.height);
|
||
except
|
||
on e: Exception do
|
||
begin
|
||
// FText := cbDefaultText;
|
||
ErrorText := e.Message;
|
||
end;
|
||
end;
|
||
finally
|
||
SetLength(data, 0);
|
||
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 : array of byte; nd : integer; var ncout : array of byte; 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 : array of byte; nd, datablock, nc : integer );
|
||
var
|
||
|
||
blocks, b, n, p : integer;
|
||
buf, ecc : array of byte;
|
||
c : Pointer;
|
||
|
||
begin
|
||
blocks := (nd + 2) div datablock;
|
||
SetLength(buf, 256);
|
||
SetLength(ecc, 256);
|
||
try
|
||
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;
|
||
finally
|
||
SetLength(buf, 0);
|
||
SetLength(ecc, 0);
|
||
end;
|
||
end;
|
||
|
||
|
||
initialization
|
||
|
||
|
||
|
||
finalization
|
||
|
||
|
||
end.
|