//www.algorytm.org
//Konwersja pomiedzy UPC-A i UPC-E
//(c)2007 by Tomasz Lubinski

program upc_e;
{$APPTYPE CONSOLE}
uses
  SysUtils;

var
   upca: String;
   upce: String;
   i: Integer;

//return true if check digit is correct, false otherwise
function checkControlDigit(upca: String): boolean;
var
   sum : Integer;
begin
      sum := 3 * StrToInt(upca[1]) +
             1 * StrToInt(upca[2]) +
             3 * StrToInt(upca[3]) +
             1 * StrToInt(upca[4]) +
             3 * StrToInt(upca[5]) +
             1 * StrToInt(upca[6]) +
             3 * StrToInt(upca[7]) +
             1 * StrToInt(upca[8]) +
             3 * StrToInt(upca[9]) +
             1 * StrToInt(upca[10]) +
             3 * StrToInt(upca[11]);
   sum := sum mod 10;
   sum := 10 - sum;
   sum := sum mod 10;
   if (sum <> StrToInt(upca[12])) then
      Result := false
   else
      Result := true;
end;


//UPC-E => UPC-A
function convertToUPCA(upce: String): String;
var
   i: Integer;
   upce_ : array[1..8] of Integer;
begin
   Result := '000000000000';

   //check length of code
   if (length(upce) <> 8) then
   begin
      Result := 'Nieprawidlowa dlugosc kodu UPC-E (powinno byc 8 znakow)';
      exit;
   end;
   
   //convert chars to digits
   for i:=1 to 8 do
      upce_[i] := StrToInt(upce[i]);

   //check system number
   if ((upce_[1] <> 0) and (upce_[1] <> 1)) then
   begin
      Result := 'Numer systemu UPC-E musi wynosic 0 badz 1';
      exit;
   end;

   //convert UPC-E to UPC-A
   if ((upce_[7] >= 0) and (upce_[7] <= 2)) then
   begin
      Result[4] := upce[7];
      Result[5] := '0';
      Result[6] := '0';
      Result[7] := '0';
      Result[8] := '0';
      Result[9] := upce[4];
      Result[10] := upce[5];
      Result[11] := upce[6];
   end
   else if ((upce_[7] = 3) and (upce_[4] >= 3) and (upce_[4] <= 9)) then
   begin
      Result[4] := upce[4];
      Result[5] := '0';
      Result[6] := '0';
      Result[7] := '0';
      Result[8] := '0';
      Result[9] := '0';
      Result[10] := upce[5];
      Result[11] := upce[6];
   end
   else if (upce_[7] = 4) then
   begin
      Result[4] := upce[4];
      Result[5] := upce[5];
      Result[6] := '0';
      Result[7] := '0';
      Result[8] := '0';
      Result[9] := '0';
      Result[10] := '0';
      Result[11] := upce[6];
   end
   else if ((upce_[7] >= 5) and (upce_[7] <= 9)) then
   begin
      Result[4] := upce[4];
      Result[5] := upce[5];
      Result[6] := upce[6];
      Result[7] := '0';
      Result[8] := '0';
      Result[9] := '0';
      Result[10] := '0';
      Result[11] := upce[7];
   end
   else
   begin
      Result := 'Nieprawidlowy kod UPC-E';
      exit;
   end;

   //copy two first digits of producer code
   Result[2] := upce[2];
   Result[3] := upce[3];

   //copy system numer and chec digit
   Result[1] := upce[1];
   Result[12] := upce[8];
   
   //control check digit
   if (checkControlDigit(Result) <> true) then
   begin
      Result := 'Nieprawidlowa suma kontrolna';
      exit;
   end;
end;

//UPC-A => UPC-E
function convertToUPCE(upca: String): String;
var
   i: Integer;
   upca_ : array[1..12] of Integer;
begin
   Result := '00000000';

   //check code length
   if (length(upca) <> 12) then
   begin
      Result := 'Nieprawidlowa dlugosc kodu UPC-A (powinno byc 12 znakow)';
      exit;
   end;


   //convert chars to digits
   for i:=1 to 12 do
      upca_[i] := StrToInt(upca[i]);

   //control check digit
   if (checkControlDigit(upca) <> true) then
   begin
      Result := 'Nieprawidlowa suma kontrolna';
      exit;
   end;
   
   //check system number
   if ((upca_[1] <> 0) and (upca_[1] <> 1)) then
   begin
      Result := 'Numer systemu UPC-A musi wynosic 0 badz 1';
      exit;
   end;
   
   //convert UPC-A to UPC-E
   if ((upca_[4] >= 0) and (upca_[4] <= 2) and
       (upca_[5] = 0) and (upca_[6] = 0) and (upca_[7] = 0) and (upca_[8] = 0)) then
   begin
      Result[4] := upca[9];
      Result[5] := upca[10];
      Result[6] := upca[11];
      Result[7] := upca[4];
   end
   else if ((upca_[4] >= 3) and (upca_[4] <= 9) and
       (upca_[5] = 0) and (upca_[6] = 0) and (upca_[7] = 0) and (upca_[8] = 0)  and (upca_[9] = 0)) then
   begin
      Result[4] := upca[4];
      Result[5] := upca[10];
      Result[6] := upca[11];
      Result[7] := '3';
   end
   else if ((upca_[6] = 0) and (upca_[7] = 0) and (upca_[8] = 0) and (upca_[9] = 0) and (upca_[10] = 0)) then
   begin
      Result[4] := upca[4];
      Result[5] := upca[5];
      Result[6] := upca[11];
      Result[7] := '4';
   end
   else if ((upca_[11] >= 5) and (upca_[11] <= 9) and
       (upca_[7] = 0) and (upca_[8] = 0) and (upca_[9] = 0) and (upca_[10] = 0)) then
   begin
      Result[4] := upca[4];
      Result[5] := upca[5];
      Result[6] := upca[6];
      Result[7] := upca[7];
   end
   else
   begin
      Result := 'Tego kodu UPC-A nie można przekonwertować do UPC-E';
      exit;
   end;
   
   //copy two first digits of producer code
   Result[2] := upca[2];
   Result[2] := upca[3];

   //copy system numer and check digit
   Result[1] := upca[1];
   Result[8] := upca[12];
end;


begin

   writeln('1. UPC-A => UPCE-E');
   writeln('2. UPC-E => UPC-A');
   readln(i);
   
   if (i=1) then
   begin
      writeln('Podaj kod UPC-A');
      readln(upca);
      upce := convertToUPCE(upca);
      writeln('Rownowazny kod UPC-E to: ');
      writeln(upce);
   end
   else
   begin
      writeln('Podaj kod UPC-E');
      readln(upce);
      upca := convertToUPCA(upce);
      writeln('Rownowazny kod UPC-A to: ');
      writeln(upca);
   end;

end.