home *** CD-ROM | disk | FTP | other *** search
- // EAN 13
- Unit KodD;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ExtCtrls,
- U;
-
- procedure HCD(var Co:TMemo);
- procedure S2LD(Co:String; StartStop:Boolean; Crc:Boolean ; var Raw:String; var RawS:String; var Bits:String);
-
-
- implementation
-
- var Kody:Array[0..11,1..3]of record
- Asc:String;
- Kod:Byte;
- Line:String;
- end;
-
- procedure HCD(var Co:TMemo);
- begin
- Co.Clear;
- Co.Lines.Add('XXXXXXXXXXXX (0 - 9)');
- end;
-
- procedure S2LD(Co:String; StartStop:Boolean; Crc:Boolean ; var Raw:String; var RawS:String; var Bits:String);
- var I,J,K:Integer;
- R,T:Array[1..13]of byte;
- begin
- Raw:='';
- RawS:='';
- Bits:='';
-
- for I:=1 to 13 do
- begin
- R[I]:=0;
- T[I]:=3;
- end;
-
- J:=13;
- for I:=1 to length(Co)do
- begin
- K:=Ord(Co[I])-$30;
- if (K>=0)and(K<=9) then // Je to Φφslo
- begin
- R[J]:=K;
- J:=J-1;
- if J<2 then break;
- end;
- end;
- //// Crc
- I:=R[2]+R[4]+R[6]+R[8]+R[10]+R[12];I:=I*3;
- J:=R[3]+R[5]+R[7]+R[9]+R[11]+R[13];
- K:=I+J;
- I:=K;
- while (I mod 10)<>0 do I:=I+1;
- R[1]:=I-K;
-
- //// Volba tabulek
- case R[13]of
- 0:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=1;T[9]:=1;T[8]:=1;T[7]:=1; end;
- 1:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=1;T[8]:=2;T[7]:=2; end;
- 2:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=2;T[8]:=1;T[7]:=2; end;
- 3:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=2;T[8]:=2;T[7]:=1; end;
- 4:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=1;T[8]:=2;T[7]:=2; end;
- 5:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=1;T[8]:=1;T[7]:=2; end;
- 6:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=2;T[8]:=1;T[7]:=1; end;
- 7:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=2;T[8]:=1;T[7]:=2; end;
- 8:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=2;T[8]:=2;T[7]:=1; end;
- 9:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=1;T[8]:=2;T[7]:=1; end;
- else exit;
- end;
-
- //// Na zobrazitelnΘ
- for I:=13 downto 1 do
- begin
- Raw:=Raw+Chr(R[I]+$30);
- end;
- RawS:=Raw;
-
- //// Na bity
- Bits:=Kody[10,1].Line;
- for I:={13}12 downto 7 do
- Bits:=Bits+Kody[R[I],T[I]].Line;
- Bits:=Bits+Kody[11,3].Line;
- for I:=6 downto 1 do
- Bits:=Bits+Kody[R[I],T[I]].Line;
- Bits:=Bits+Kody[10,3].Line;
- end;
-
- begin
- with Kody[0,1]do begin Asc:='0';Kod:=0;Line:='0001101';end;
- with Kody[1,1]do begin Asc:='1';Kod:=1;Line:='0011001';end;
- with Kody[2,1]do begin Asc:='2';Kod:=2;Line:='0010011';end;
- with Kody[3,1]do begin Asc:='3';Kod:=3;Line:='0111101';end;
- with Kody[4,1]do begin Asc:='4';Kod:=4;Line:='0100011';end;
- with Kody[5,1]do begin Asc:='5';Kod:=5;Line:='0110001';end;
- with Kody[6,1]do begin Asc:='6';Kod:=6;Line:='0101111';end;
- with Kody[7,1]do begin Asc:='7';Kod:=7;Line:='0111011';end;
- with Kody[8,1]do begin Asc:='8';Kod:=8;Line:='0110111';end;
- with Kody[9,1]do begin Asc:='9';Kod:=9;Line:='0001011';end;
- with Kody[10,1]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
- with Kody[11,1]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
-
- with Kody[0,2]do begin Asc:='0';Kod:=0;Line:='0100111';end;
- with Kody[1,2]do begin Asc:='1';Kod:=1;Line:='0110011';end;
- with Kody[2,2]do begin Asc:='2';Kod:=2;Line:='0011011';end;
- with Kody[3,2]do begin Asc:='3';Kod:=3;Line:='0100001';end;
- with Kody[4,2]do begin Asc:='4';Kod:=4;Line:='0011101';end;
- with Kody[5,2]do begin Asc:='5';Kod:=5;Line:='0111001';end;
- with Kody[6,2]do begin Asc:='6';Kod:=6;Line:='0000101';end;
- with Kody[7,2]do begin Asc:='7';Kod:=7;Line:='0010001';end;
- with Kody[8,2]do begin Asc:='8';Kod:=8;Line:='0001001';end;
- with Kody[9,2]do begin Asc:='9';Kod:=9;Line:='0010111';end;
- with Kody[10,2]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
- with Kody[11,2]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
-
- with Kody[0,3]do begin Asc:='0';Kod:=0;Line:='1110010';end;
- with Kody[1,3]do begin Asc:='1';Kod:=1;Line:='1100110';end;
- with Kody[2,3]do begin Asc:='2';Kod:=2;Line:='1101100';end;
- with Kody[3,3]do begin Asc:='3';Kod:=3;Line:='1000010';end;
- with Kody[4,3]do begin Asc:='4';Kod:=4;Line:='1011100';end;
- with Kody[5,3]do begin Asc:='5';Kod:=5;Line:='1001110';end;
- with Kody[6,3]do begin Asc:='6';Kod:=6;Line:='1010000';end;
- with Kody[7,3]do begin Asc:='7';Kod:=7;Line:='1000100';end;
- with Kody[8,3]do begin Asc:='8';Kod:=8;Line:='1001000';end;
- with Kody[9,3]do begin Asc:='9';Kod:=9;Line:='1110100';end;
- with Kody[10,3]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
- with Kody[11,3]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
- end.
-