home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / tema / clin / CLIN.EXE / SRC / SRC.RAR / KODD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-09-30  |  4.7 KB  |  134 lines
  1. // EAN 13
  2. Unit KodD;
  3.  
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  8.   Dialogs, StdCtrls, ExtCtrls,
  9.   U;
  10.  
  11.  procedure HCD(var Co:TMemo);
  12.  procedure S2LD(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 HCD(var Co:TMemo);
  24.  begin
  25.   Co.Clear;
  26.     Co.Lines.Add('XXXXXXXXXXXX (0 - 9)');
  27.  end;
  28.  
  29.  procedure S2LD(Co:String; StartStop:Boolean; Crc:Boolean    ; var Raw:String; var RawS:String; var Bits:String);
  30.  var I,J,K:Integer;
  31.      R,T:Array[1..13]of byte;
  32.  begin
  33.    Raw:='';
  34.    RawS:='';
  35.    Bits:='';
  36.  
  37.    for I:=1 to 13 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.    //// Crc
  55.      I:=R[2]+R[4]+R[6]+R[8]+R[10]+R[12];I:=I*3;
  56.      J:=R[3]+R[5]+R[7]+R[9]+R[11]+R[13];
  57.      K:=I+J;
  58.       I:=K;
  59.       while (I mod 10)<>0 do I:=I+1;
  60.      R[1]:=I-K;
  61.  
  62.    //// Volba tabulek
  63.     case R[13]of
  64.      0:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=1;T[9]:=1;T[8]:=1;T[7]:=1; end;
  65.      1:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=1;T[8]:=2;T[7]:=2; end;
  66.      2:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=2;T[8]:=1;T[7]:=2; end;
  67.      3:begin T[13]:=1; T[12]:=1;T[11]:=1;T[10]:=2;T[9]:=2;T[8]:=2;T[7]:=1; end;
  68.      4:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=1;T[8]:=2;T[7]:=2; end;
  69.      5:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=1;T[8]:=1;T[7]:=2; end;
  70.      6:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=2;T[8]:=1;T[7]:=1; end;
  71.      7:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=2;T[8]:=1;T[7]:=2; end;
  72.      8:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=1;T[9]:=2;T[8]:=2;T[7]:=1; end;
  73.      9:begin T[13]:=1; T[12]:=1;T[11]:=2;T[10]:=2;T[9]:=1;T[8]:=2;T[7]:=1; end;
  74.      else exit;
  75.      end;
  76.  
  77.    //// Na zobrazitelnΘ
  78.      for I:=13 downto 1 do
  79.       begin
  80.        Raw:=Raw+Chr(R[I]+$30);
  81.       end;
  82.      RawS:=Raw;
  83.  
  84.    //// Na bity
  85.    Bits:=Kody[10,1].Line;
  86.    for I:={13}12 downto 7 do
  87.       Bits:=Bits+Kody[R[I],T[I]].Line;
  88.    Bits:=Bits+Kody[11,3].Line;
  89.    for I:=6 downto 1 do
  90.       Bits:=Bits+Kody[R[I],T[I]].Line;
  91.    Bits:=Bits+Kody[10,3].Line;
  92.  end;
  93.  
  94. begin
  95.  with Kody[0,1]do begin Asc:='0';Kod:=0;Line:='0001101';end;
  96.  with Kody[1,1]do begin Asc:='1';Kod:=1;Line:='0011001';end;
  97.  with Kody[2,1]do begin Asc:='2';Kod:=2;Line:='0010011';end;
  98.  with Kody[3,1]do begin Asc:='3';Kod:=3;Line:='0111101';end;
  99.  with Kody[4,1]do begin Asc:='4';Kod:=4;Line:='0100011';end;
  100.  with Kody[5,1]do begin Asc:='5';Kod:=5;Line:='0110001';end;
  101.  with Kody[6,1]do begin Asc:='6';Kod:=6;Line:='0101111';end;
  102.  with Kody[7,1]do begin Asc:='7';Kod:=7;Line:='0111011';end;
  103.  with Kody[8,1]do begin Asc:='8';Kod:=8;Line:='0110111';end;
  104.  with Kody[9,1]do begin Asc:='9';Kod:=9;Line:='0001011';end;
  105.   with Kody[10,1]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
  106.   with Kody[11,1]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
  107.  
  108.  with Kody[0,2]do begin Asc:='0';Kod:=0;Line:='0100111';end;
  109.  with Kody[1,2]do begin Asc:='1';Kod:=1;Line:='0110011';end;
  110.  with Kody[2,2]do begin Asc:='2';Kod:=2;Line:='0011011';end;
  111.  with Kody[3,2]do begin Asc:='3';Kod:=3;Line:='0100001';end;
  112.  with Kody[4,2]do begin Asc:='4';Kod:=4;Line:='0011101';end;
  113.  with Kody[5,2]do begin Asc:='5';Kod:=5;Line:='0111001';end;
  114.  with Kody[6,2]do begin Asc:='6';Kod:=6;Line:='0000101';end;
  115.  with Kody[7,2]do begin Asc:='7';Kod:=7;Line:='0010001';end;
  116.  with Kody[8,2]do begin Asc:='8';Kod:=8;Line:='0001001';end;
  117.  with Kody[9,2]do begin Asc:='9';Kod:=9;Line:='0010111';end;
  118.   with Kody[10,2]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
  119.   with Kody[11,2]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
  120.  
  121.  with Kody[0,3]do begin Asc:='0';Kod:=0;Line:='1110010';end;
  122.  with Kody[1,3]do begin Asc:='1';Kod:=1;Line:='1100110';end;
  123.  with Kody[2,3]do begin Asc:='2';Kod:=2;Line:='1101100';end;
  124.  with Kody[3,3]do begin Asc:='3';Kod:=3;Line:='1000010';end;
  125.  with Kody[4,3]do begin Asc:='4';Kod:=4;Line:='1011100';end;
  126.  with Kody[5,3]do begin Asc:='5';Kod:=5;Line:='1001110';end;
  127.  with Kody[6,3]do begin Asc:='6';Kod:=6;Line:='1010000';end;
  128.  with Kody[7,3]do begin Asc:='7';Kod:=7;Line:='1000100';end;
  129.  with Kody[8,3]do begin Asc:='8';Kod:=8;Line:='1001000';end;
  130.  with Kody[9,3]do begin Asc:='9';Kod:=9;Line:='1110100';end;
  131.   with Kody[10,3]do begin Asc:='{Round}'; Kod:=10;Line:='101';end;
  132.   with Kody[11,3]do begin Asc:='{Divide}';Kod:=11;Line:='01010';end;
  133. end.
  134.