barcode.pas

FreeReport 2.34 consists of the report engine, designer and previewer, with capabilities comparable

     else
                  result := tmp+IntToStr(10-(sum mod 10));
end;

////////////////////////////// EAN8 /////////////////////////////////////////

// Pattern for Barcode EAN Zeichensatz A
//       L1   S1   L2   S2
const tabelle_EAN_A:array['0'..'9', 1..4] of char =
        (
        ('2', '6', '0', '5'),    // 0
        ('1', '6', '1', '5'),    // 1
        ('1', '5', '1', '6'),    // 2
        ('0', '8', '0', '5'),    // 3
        ('0', '5', '2', '6'),    // 4
        ('0', '6', '2', '5'),    // 5
        ('0', '5', '0', '8'),    // 6
        ('0', '7', '0', '6'),    // 7
        ('0', '6', '0', '7'),    // 8
        ('2', '5', '0', '6')     // 9
        );

// Pattern for Barcode EAN Zeichensatz C
//       S1   L1   S2   L2
const tabelle_EAN_C:array['0'..'9', 1..4] of char =
        (
        ('7', '1', '5', '0' ),    // 0
        ('6', '1', '6', '0' ),    // 1
        ('6', '0', '6', '1' ),    // 2
        ('5', '3', '5', '0' ),    // 3
        ('5', '0', '7', '1' ),    // 4
        ('5', '1', '7', '0' ),    // 5
        ('5', '0', '5', '3' ),    // 6
        ('5', '2', '5', '1' ),    // 7
        ('5', '1', '5', '2' ),    // 8
        ('7', '0', '5', '1' )     // 9
        );


function TBarcode.Code_EAN8:string;
var
        i, j: integer;
        tmp : String;
begin
        if FCheckSum then
           begin
           tmp := '00000000'+FText;
                          tmp := getEAN(copy(tmp,length(tmp)-6,7)+'0');
           end
        else
           tmp := Ftext;

        result := '505';   // Startcode

        for i:=1 to 4 do
            for j:= 1 to 4 do
                begin
                                         result := result + tabelle_EAN_A[tmp[i], j] ;
                end;

        result := result + '05050';   // Trennzeichen

        for i:=5 to 8 do
            for j:= 1 to 4 do
                begin
                                         result := result + tabelle_EAN_C[tmp[i], j] ;
                                         end;

        result := result + '505';   // Stopcode
end;

////////////////////////////// EAN13 ///////////////////////////////////////

// Pattern for Barcode EAN Zeichensatz B
//       L1   S1   L2   S2
const tabelle_EAN_B:array['0'..'9', 1..4] of char =
        (
        ('0', '5', '1', '7'),    // 0
        ('0', '6', '1', '6'),    // 1
        ('1', '6', '0', '6'),    // 2
        ('0', '5', '3', '5'),    // 3
        ('1', '7', '0', '5'),    // 4
        ('0', '7', '1', '5'),    // 5
        ('3', '5', '0', '5'),    // 6
        ('1', '5', '2', '5'),    // 7
        ('2', '5', '1', '5'),    // 8
        ('1', '5', '0', '7')     // 9
        );

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

function TBarcode.Code_EAN13:string;
var
        i, j, LK: integer;
        tmp : String;
begin
        if FCheckSum then
        begin
                tmp := '0000000000000'+FText;
                tmp := getEAN(copy(tmp,length(tmp)-11,12)+'0');
        end
        else
                tmp := Ftext;

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

        result := '505';   // Startcode

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

        result := result + '05050';   // Trennzeichen

        for i:=7 to 12 do
                for j:= 1 to 4 do
                begin
                        result := result + tabelle_EAN_C[tmp[i], j] ;
                end;

        result := result + '505';   // Stopcode
end;

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

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

begin
        result := '5050';   // Startcode

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

        result := result + '605';    // Stopcode
end;


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

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

        result := result + '605060';   // Stopcode
end;

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

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

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

        result := result + '70505';   // Stopcode
end;


function TBarcode.Code_39:string;

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

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


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

var
        i, idx : integer;
        checksum:integer;

begin
        checksum := 0;
        // Startcode
        result := tabelle_39[FindIdx('*')].data + '0';

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

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

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

function TBarcode.Code_39Extended:string;

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


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

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



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

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