unit Ucode128;

interface
uses Windows, Sysutils, Dialogs;
procedure Construction_Code128;

var
      Chaine128    : string;
      Code128      : string;
      Cle128       : Integer;
      CalculCle    : boolean;

implementation

var   MChecksum     : extended;
      MMini, MDummy, Mcle : integer;
      TableB        : boolean;

const
      MCode128      : string = '';

procedure Construction_Code128;
var  car            : char;
     ncar           : byte;
     i              : integer;
     interdit       : byte;
     ccar           : Array[1..2] of char;
begin
     interdit       := 0;
     Code128        := '';
     if (Chaine128>'') then
        begin for i:=1 to length(Chaine128) do begin car := Chaine128 [i];
                                                     if ((car>char(31)) and (car<char(127))) or (car=char(198)) then continue else begin interdit:=ord(car); break; end;
                                               end;
              if interdit=0 then
                 begin Code128      := '';
                       tableB       := true;
                       i            := 1;
                       While i<=length(Chaine128) do
                             begin if tableB then
                                      begin if (i=1) or ((i+3)=length(Chaine128)) then MMini := 4 else MMini := 6;
                                            MMini := MMini - 1;
                                            if ((i + MMini) <= length(Chaine128)) then
                                               begin While MMini >=0 do
                                                           begin car  := Chaine128 [i+MMini];
                                                                 ncar := ord(car);
                                                                 if (ncar<48) or (ncar>57) then break;
                                                                 MMini := MMini - 1;
                                                           end;
                                               end;
                                            if (MMini<0) then    // Choix table C
                                               begin  if i=1 then Code128 := char(210) else Code128 := Code128 + char(204);
                                                      tableB       := false;
                                               end
                                               else   if i=1 then Code128 := char(209);
                                      end;
                                   if not tableB then
                                      begin MMini := 2;
                                            MMini := MMini - 1;
                                            if ((i + MMini) <= length(Chaine128)) then
                                                begin While MMini >=0 do
                                                            begin ccar [MMini + 1] := Chaine128 [i+MMini];
                                                                  ncar           := ord(ccar [MMini+1]);
                                                                  if (ncar<48) or (ncar>57) then break;
                                                                  MMini := MMini - 1;
                                                            end;
                                                end;
                                            if (MMini<0) then
                                               begin MDummy := StrToInt(ccar [1]+ccar [2]);
                                                     if MDummy<95 then MDummy := MDummy + 32 else MDummy := MDummy + 100;
                                                     Code128 := Code128 + char(MDummy);
                                                     i:=i+2;
                                               end
                                               else
                                               begin Code128 := Code128 + char(205);
                                                     tableB  := true;
                                               end;
                                      end;
                                   if tableB then
                                      begin car     := Chaine128 [i];
                                            Code128 := Code128 + car;
                                            i:=i+1;
                                      end;
                             end;

                       // Calcul de la clé de contrôle
                       if CalculCle then
                          begin for i:=1 to length(Code128) do
                                    begin car     := Code128 [i];
                                          ncar    := ord(car);
                                          if (ncar<127) then ncar := ncar - 32 else ncar := ncar - 100;
                                          if (i=1) then MChecksum := ncar;
                                          MChecksum := MChecksum + ((i - 1) * ncar);
                                          MCle := trunc(MChecksum/103);
                                          MChecksum := trunc(MChecksum - (MCle * 103));
                                    end;
                                if (MChecksum<95) then MChecksum := MChecksum + 32 else MChecksum := MChecksum + 100;
                                i       := trunc(MChecksum);
                                Code128 := Code128 + char(i) + char(211);
                                Cle128  := i;
                          end
                          else  Cle128  := 0;
                       //
                 end;
        end;

end;

end.