home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / tema / clin / CLIN.EXE / SRC / SRC.RAR / KODE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-09-30  |  5.3 KB  |  163 lines
  1. // EAN 13+2
  2. Unit KodE;
  3.  
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  8.   Dialogs, StdCtrls, ExtCtrls,
  9.   U;
  10.  
  11.  procedure HCE(var Co:TMemo);
  12.  procedure S2LE(Co:String; StartStop:Boolean; Crc:Boolean    ; var Raw:String; var RawS:String; var Bits:String);
  13.  
  14.  
  15. implementation
  16.  
  17.  var Kody:Array[0..11,1..3]of record
  18.        Asc:String;
  19.        Kod:Byte;
  20.        Line:String;
  21.      end;
  22.  
  23.  procedure HCE(var Co:TMemo);
  24.  begin
  25.   Co.Clear;
  26.     Co.Lines.Add('XXXXXXXXXXXX XX (0 - 9)');
  27.  end;
  28.  
  29.  procedure S2LE(Co:String; StartStop:Boolean; Crc:Boolean    ; var Raw:String; var RawS:String; var Bits:String);
  30.  var I,I2,J,K:Integer;
  31.      R,T:Array[0..15]of byte;
  32.  begin
  33.    Raw:='';
  34.    RawS:='';
  35.    Bits:='';
  36.  
  37.    for I:=0 to 15 do
  38.    begin
  39.      R[I]:=0;
  40.      T[I]:=3;
  41.    end;
  42.  
  43.    J:=13;
  44.    for I:=1 to length(Co)do
  45.    begin
  46.      K:=Ord(Co[I])-$30;
  47.      if (K>=0)and(K<=9) then // Je to Φφslo
  48.        begin
  49.         R[J]:=K;
  50.         J:=J-1;
  51.         if J<2 then break;
  52.        end;
  53.    end;
  54.  
  55.    J:=14;
  56.    I2:=I+1;
  57.    for I:=I2 to length(Co)do
  58.    begin
  59.      K:=Ord(Co[I])-$30;
  60.      if (K>=0)and(K<=9) then // Je to Φφslo
  61.        begin
  62.         R[J]:=K;
  63.         J:=J+1;
  64.         if J>15 then break;
  65.        end;
  66.    end;
  67.  
  68.    //// Crc
  69.      I:=R[2]+R[4]+R[6]+R[8]+R[10]+R[12];I:=I*3;
  70.      J:=R[3]+R[5]+R[7]+R[9]+R[11]+R[13];
  71.      K:=I+J;
  72.       I:=K;
  73.       while (I mod 10)<>0 do I:=I+1;
  74.      R[1]:=I-K;
  75.  
  76.    //// Volba tabulek
  77.     case ((R[14]*10+R[15])and 3) of
  78.      0:begin T[14]:=1;T[15]:=1;end;
  79.      1:begin T[14]:=1;T[15]:=2;end;
  80.      2:begin T[14]:=2;T[15]:=1;end;
  81.      3:begin T[14]:=2;T[15]:=2;end;
  82.      else exit;
  83.      end;
  84.  
  85.     case R[13]of
  86.      0:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=1;T[9]:=1;T[8]:=1;T[7]:=1; end;
  87.      1:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=1;T[8]:=2;T[7]:=2; end;
  88.      2:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=2;T[8]:=1;T[7]:=2; end;
  89.      3:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=2;T[8]:=2;T[7]:=1; end;
  90.      4:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=1;T[8]:=2;T[7]:=2; end;
  91.      5:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=1;T[8]:=1;T[7]:=2; end;
  92.      6:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=2;T[8]:=1;T[7]:=1; end;
  93.      7:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=2;T[8]:=1;T[7]:=2; end;
  94.      8:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=2;T[8]:=2;T[7]:=1; end;
  95.      9:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=1;T[8]:=2;T[7]:=1; end;
  96.      else exit;
  97.      end;
  98.  
  99.    //// Na zobrazitelnΘ
  100.      for I:=13 downto 1 do
  101.       begin
  102.        Raw:=Raw+Chr(R[I]+$30);
  103.       end;
  104.      Raw:=Raw+' '+Chr(R[14]+$30)+Chr(R[15]+$30);
  105.      RawS:=Raw;
  106.  
  107.    //// Na bity
  108.    Bits:=Kody[10,1].Line;
  109.    for I:={13}12 downto 7 do
  110.       Bits:=Bits+Kody[R[I],T[I]].Line;
  111.    Bits:=Bits+Kody[11,3].Line;
  112.    for I:=6 downto 1 do
  113.       Bits:=Bits+Kody[R[I],T[I]].Line;
  114.    Bits:=Bits+Kody[10,3].Line;
  115.  
  116.    Bits:=Bits+'000000000000'+
  117.          '1011'+
  118.          Kody[R[14],T[14]].Line+
  119.          '01'+
  120.          Kody[R[15],T[15]].Line;
  121.  end;
  122.  
  123. begin
  124.  with Kody[0,1]do begin Asc:='0';Kod:=0;Line:='0001101';end;
  125.  with Kody[1,1]do begin Asc:='1';Kod:=1;Line:='0011001';end;
  126.  with Kody[2,1]do begin Asc:='2';Kod:=2;Line:='0010011';end;
  127.  with Kody[3,1]do begin Asc:='3';Kod:=3;Line:='0111101';end;
  128.  with Kody[4,1]do begin Asc:='4';Kod:=4;Line:='0100011';end;
  129.  with Kody[5,1]do begin Asc:='5';Kod:=5;Line:='0110001';end;
  130.  with Kody[6,1]do begin Asc:='6';Kod:=6;Line:='0101111';end;
  131.  with Kody[7,1]do begin Asc:='7';Kod:=7;Line:='0111011';end;
  132.  with Kody[8,1]do begin Asc:='8';Kod:=8;Line:='0110111';end;
  133.  with Kody[9,1]do begin Asc:='9';Kod:=9;Line:='0001011';end;
  134.   with Kody[10,1]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
  135.   with Kody[11,1]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
  136.  
  137.  with Kody[0,2]do begin Asc:='0';Kod:=0;Line:='0100111';end;
  138.  with Kody[1,2]do begin Asc:='1';Kod:=1;Line:='0110011';end;
  139.  with Kody[2,2]do begin Asc:='2';Kod:=2;Line:='0011011';end;
  140.  with Kody[3,2]do begin Asc:='3';Kod:=3;Line:='0100001';end;
  141.  with Kody[4,2]do begin Asc:='4';Kod:=4;Line:='0011101';end;
  142.  with Kody[5,2]do begin Asc:='5';Kod:=5;Line:='0111001';end;
  143.  with Kody[6,2]do begin Asc:='6';Kod:=6;Line:='0000101';end;
  144.  with Kody[7,2]do begin Asc:='7';Kod:=7;Line:='0010001';end;
  145.  with Kody[8,2]do begin Asc:='8';Kod:=8;Line:='0001001';end;
  146.  with Kody[9,2]do begin Asc:='9';Kod:=9;Line:='0010111';end;
  147.   with Kody[10,2]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
  148.   with Kody[11,2]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
  149.  
  150.  with Kody[0,3]do begin Asc:='0';Kod:=0;Line:='1110010';end;
  151.  with Kody[1,3]do begin Asc:='1';Kod:=1;Line:='1100110';end;
  152.  with Kody[2,3]do begin Asc:='2';Kod:=2;Line:='1101100';end;
  153.  with Kody[3,3]do begin Asc:='3';Kod:=3;Line:='1000010';end;
  154.  with Kody[4,3]do begin Asc:='4';Kod:=4;Line:='1011100';end;
  155.  with Kody[5,3]do begin Asc:='5';Kod:=5;Line:='1001110';end;
  156.  with Kody[6,3]do begin Asc:='6';Kod:=6;Line:='1010000';end;
  157.  with Kody[7,3]do begin Asc:='7';Kod:=7;Line:='1000100';end;
  158.  with Kody[8,3]do begin Asc:='8';Kod:=8;Line:='1001000';end;
  159.  with Kody[9,3]do begin Asc:='9';Kod:=9;Line:='1110100';end;
  160.   with Kody[10,3]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
  161.   with Kody[11,3]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
  162. end.
  163.