home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / tema / clin / CLIN.EXE / SRC / SRC.RAR / KODF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-09-30  |  6.0 KB  |  178 lines
  1. // EAN 13+5
  2. Unit KodF;
  3.  
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  8.   Dialogs, StdCtrls, ExtCtrls,
  9.   U;
  10.  
  11.  procedure HCF(var Co:TMemo);
  12.  procedure S2LF(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 HCF(var Co:TMemo);
  24.  begin
  25.   Co.Clear;
  26.     Co.Lines.Add('XXXXXXXXXXXX XXXXX (0 - 9)');
  27.  end;
  28.  
  29.  procedure S2LF(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..18]of byte;
  32.  begin
  33.    Raw:='';
  34.    RawS:='';
  35.    Bits:='';
  36.  
  37.    for I:=0 to 18 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>18 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.      I:=(R[14]+R[16]+R[18])*3;
  78.      J:=(R[15]+R[17])*9;
  79.      K:=I+J;
  80.     case (K mod 10) of
  81.      0:begin T[14]:=2;T[15]:=2;T[16]:=1;T[17]:=1;T[18]:=1;end;
  82.      1:begin T[14]:=2;T[15]:=1;T[16]:=2;T[17]:=1;T[18]:=1;end;
  83.      2:begin T[14]:=2;T[15]:=1;T[16]:=1;T[17]:=2;T[18]:=1;end;
  84.      3:begin T[14]:=2;T[15]:=1;T[16]:=1;T[17]:=1;T[18]:=2;end;
  85.      4:begin T[14]:=1;T[15]:=2;T[16]:=2;T[17]:=1;T[18]:=1;end;
  86.      5:begin T[14]:=1;T[15]:=1;T[16]:=2;T[17]:=2;T[18]:=1;end;
  87.      6:begin T[14]:=1;T[15]:=1;T[16]:=1;T[17]:=2;T[18]:=2;end;
  88.      7:begin T[14]:=1;T[15]:=2;T[16]:=1;T[17]:=2;T[18]:=1;end;
  89.      8:begin T[14]:=1;T[15]:=2;T[16]:=1;T[17]:=1;T[18]:=2;end;
  90.      9:begin T[14]:=1;T[15]:=1;T[16]:=2;T[17]:=1;T[18]:=2;end;
  91.      else exit;
  92.      end;
  93.  
  94.     case R[13]of
  95.      0:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=1;T[9]:=1;T[8]:=1;T[7]:=1; end;
  96.      1:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=1;T[8]:=2;T[7]:=2; end;
  97.      2:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=2;T[8]:=1;T[7]:=2; end;
  98.      3:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=2;T[8]:=2;T[7]:=1; end;
  99.      4:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=1;T[8]:=2;T[7]:=2; end;
  100.      5:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=1;T[8]:=1;T[7]:=2; end;
  101.      6:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=2;T[8]:=1;T[7]:=1; end;
  102.      7:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=2;T[8]:=1;T[7]:=2; end;
  103.      8:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=2;T[8]:=2;T[7]:=1; end;
  104.      9:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=1;T[8]:=2;T[7]:=1; end;
  105.      else exit;
  106.      end;
  107.  
  108.    //// Na zobrazitelnΘ
  109.      for I:=13 downto 1 do
  110.       begin
  111.        Raw:=Raw+Chr(R[I]+$30);
  112.       end;
  113.      Raw:=Raw+' '+Chr(R[14]+$30)+Chr(R[15]+$30)+Chr(R[16]+$30)+Chr(R[17]+$30)+Chr(R[18]+$30);
  114.      RawS:=Raw;
  115.  
  116.    //// Na bity
  117.    Bits:=Kody[10,1].Line;
  118.    for I:={13}12 downto 7 do
  119.       Bits:=Bits+Kody[R[I],T[I]].Line;
  120.    Bits:=Bits+Kody[11,3].Line;
  121.    for I:=6 downto 1 do
  122.       Bits:=Bits+Kody[R[I],T[I]].Line;
  123.    Bits:=Bits+Kody[10,3].Line;
  124.  
  125.    Bits:=Bits+'000000000000'+
  126.          '1011'+
  127.          Kody[R[14],T[14]].Line+
  128.          '01'+
  129.          Kody[R[15],T[15]].Line+
  130.          '01'+
  131.          Kody[R[16],T[16]].Line+
  132.          '01'+
  133.          Kody[R[17],T[17]].Line+
  134.          '01'+
  135.          Kody[R[18],T[18]].Line;
  136.  end;
  137.  
  138. begin
  139.  with Kody[0,1]do begin Asc:='0';Kod:=0;Line:='0001101';end;
  140.  with Kody[1,1]do begin Asc:='1';Kod:=1;Line:='0011001';end;
  141.  with Kody[2,1]do begin Asc:='2';Kod:=2;Line:='0010011';end;
  142.  with Kody[3,1]do begin Asc:='3';Kod:=3;Line:='0111101';end;
  143.  with Kody[4,1]do begin Asc:='4';Kod:=4;Line:='0100011';end;
  144.  with Kody[5,1]do begin Asc:='5';Kod:=5;Line:='0110001';end;
  145.  with Kody[6,1]do begin Asc:='6';Kod:=6;Line:='0101111';end;
  146.  with Kody[7,1]do begin Asc:='7';Kod:=7;Line:='0111011';end;
  147.  with Kody[8,1]do begin Asc:='8';Kod:=8;Line:='0110111';end;
  148.  with Kody[9,1]do begin Asc:='9';Kod:=9;Line:='0001011';end;
  149.   with Kody[10,1]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
  150.   with Kody[11,1]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
  151.  
  152.  with Kody[0,2]do begin Asc:='0';Kod:=0;Line:='0100111';end;
  153.  with Kody[1,2]do begin Asc:='1';Kod:=1;Line:='0110011';end;
  154.  with Kody[2,2]do begin Asc:='2';Kod:=2;Line:='0011011';end;
  155.  with Kody[3,2]do begin Asc:='3';Kod:=3;Line:='0100001';end;
  156.  with Kody[4,2]do begin Asc:='4';Kod:=4;Line:='0011101';end;
  157.  with Kody[5,2]do begin Asc:='5';Kod:=5;Line:='0111001';end;
  158.  with Kody[6,2]do begin Asc:='6';Kod:=6;Line:='0000101';end;
  159.  with Kody[7,2]do begin Asc:='7';Kod:=7;Line:='0010001';end;
  160.  with Kody[8,2]do begin Asc:='8';Kod:=8;Line:='0001001';end;
  161.  with Kody[9,2]do begin Asc:='9';Kod:=9;Line:='0010111';end;
  162.   with Kody[10,2]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
  163.   with Kody[11,2]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
  164.  
  165.  with Kody[0,3]do begin Asc:='0';Kod:=0;Line:='1110010';end;
  166.  with Kody[1,3]do begin Asc:='1';Kod:=1;Line:='1100110';end;
  167.  with Kody[2,3]do begin Asc:='2';Kod:=2;Line:='1101100';end;
  168.  with Kody[3,3]do begin Asc:='3';Kod:=3;Line:='1000010';end;
  169.  with Kody[4,3]do begin Asc:='4';Kod:=4;Line:='1011100';end;
  170.  with Kody[5,3]do begin Asc:='5';Kod:=5;Line:='1001110';end;
  171.  with Kody[6,3]do begin Asc:='6';Kod:=6;Line:='1010000';end;
  172.  with Kody[7,3]do begin Asc:='7';Kod:=7;Line:='1000100';end;
  173.  with Kody[8,3]do begin Asc:='8';Kod:=8;Line:='1001000';end;
  174.  with Kody[9,3]do begin Asc:='9';Kod:=9;Line:='1110100';end;
  175.   with Kody[10,3]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
  176.   with Kody[11,3]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
  177. end.
  178.