home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / tema / clin / CLIN.EXE / SRC / SRC.RAR / KOD2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-09-23  |  3.6 KB  |  147 lines
  1. // Code 2/5 Interleaved
  2. Unit Kod2;
  3.  
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  8.   Dialogs, StdCtrls, ExtCtrls,
  9.   U;
  10.  
  11.  procedure HC2(var Co:TMemo);
  12.  procedure S2L2(Co:String; StartStop:Boolean; Crc:Boolean    ; var Raw:String; var RawS:String; var Bits:String);
  13.  
  14.  
  15. implementation
  16.  
  17.  const MaxKod=9;
  18.  var Kody:Array[0..11]of record
  19.        Asc:String;
  20.        Kod:Byte;
  21.        Line:String;
  22.      end;
  23.  
  24.  procedure HC2(var Co:TMemo);
  25.  var I:Word;
  26.  begin
  27.   Co.Clear;
  28.   for I:=0 to MaxKod do
  29.    with Kody[I] do
  30.      begin
  31.        Co.Lines.Add(Hex(Kod)+' '+Asc+' ('+Line+')');
  32.      end;
  33.  end;
  34.  
  35.  procedure S2L2(Co:String; StartStop:Boolean; Crc:Boolean    ; var Raw:String; var RawS:String; var Bits:String);
  36.  var I,J,K:Integer;
  37.      Pom,Pom2:String;
  38.      PomC:Byte;
  39.      E:Integer;
  40.      Ch:Byte;
  41.  begin
  42.    Raw:='';
  43.    RawS:='';
  44.    Bits:='';
  45.    if Length(Co)=0 then Exit;
  46.  //// Vy°a∩ neplatnΘ a zkonvertuj HEX verze
  47.    I:=1;
  48.    while I<=Length(Co) do
  49.    begin
  50.      //// Je to $ ?
  51.      if Co[I]='$' then // Je to HEX
  52.         begin
  53.           Pom:='';
  54.           repeat
  55.             Pom:=Pom+Co[I];
  56.             I:=I+1; // Posu≥ o dalÜφ znak
  57.           until (length(Pom)=3) or (I>Length(Co));
  58.           if I<=Length(Co) then I:=I-1;
  59.           Val(Pom,PomC,E);
  60.           if (E=0)and(PomC<=MaxKod) then
  61.           begin
  62.             Raw:=Raw+Chr(PomC);
  63.           end;
  64.         end else
  65.         begin   // Nenφ to HEX
  66.           for J:=0 to MaxKod do
  67.             if Co[I]=Kody[J].Asc then Raw:=Raw+Chr(Kody[J].Kod);
  68.         end;
  69.      I:=I+1;
  70.    end;
  71.  
  72.    if Length(Raw)=0 then Exit;
  73.  //// Crc
  74.    if Crc then
  75.    begin
  76.     // Lze jen sudΘ znaky !
  77.       if Not(Odd(Length(Raw))) then
  78.         Raw:=Copy(Raw,1,Length(Raw)-1);
  79.  
  80.       if Length(Raw)=0 then Exit;
  81.  
  82.      J:=0;
  83.      for I:=1 to Length(Raw) do
  84.      begin
  85.        J:=J+Ord(Raw[I]);
  86.      end;
  87.      Raw:=Raw+Chr(J mod 10);
  88.    end else
  89.    begin
  90.     // Lze jen sudΘ znaky !
  91.       if Odd(Length(Raw)) then
  92.         Raw:=Copy(Raw,1,Length(Raw)-1);
  93.    end;
  94.  
  95.  
  96.  //// Na zobrazitelne
  97.  for I:=1 to Length(Raw) do
  98.      RawS:=RawS+Kody[Ord(Raw[I])].Asc;
  99.  
  100.       //// +Na bity
  101.  for I:=1 to (Length(Raw) div 2) do
  102.   begin
  103.       Pom:='';
  104.       Ch:=$31; // ZaΦφnßme jedniΦkou
  105.  
  106.       Pom2:='';
  107.       for K:=1 to Length(Kody[Ord(Raw[2*(I-1)+1])].Line) do
  108.       begin
  109.         Pom2:=Pom2+Kody[Ord(Raw[2*(I-1)+1])].Line[K]+Kody[Ord(Raw[2*(I-1)+2])].Line[K];
  110.       end;
  111.  
  112.       for J:=1 to Length(Pom2) do
  113.       begin
  114.         for K:=1 to (Ord(Pom2[J])-$30+1) do // Pozor na 0-x a 1-x v tabulce bit∙ !!!
  115.           begin
  116.             Pom:=Pom+Chr(Ch);
  117.           end;
  118.         Ch:=Ch xor 1;
  119.       end;
  120.      Bits:=Bits+Pom;
  121.   end;
  122.  
  123.   // Doplnφ p°φpadn² Start/Stop
  124.   if StartStop then
  125.   begin
  126.     Raw:=#10+Raw+#11;
  127.     RawS:='{Start}'+RawS+'{Stop}';
  128.     Bits:='1010'+Bits+'11010';
  129.   end;
  130.  
  131.  end;
  132.  
  133. begin
  134.  with Kody[00]do begin Asc:='0';Kod:=0;Line:='00110';end;
  135.  with Kody[01]do begin Asc:='1';Kod:=1;Line:='10001';end;
  136.  with Kody[02]do begin Asc:='2';Kod:=2;Line:='01001';end;
  137.  with Kody[03]do begin Asc:='3';Kod:=3;Line:='11000';end;
  138.  with Kody[04]do begin Asc:='4';Kod:=4;Line:='00101';end;
  139.  with Kody[05]do begin Asc:='5';Kod:=5;Line:='10100';end;
  140.  with Kody[06]do begin Asc:='6';Kod:=6;Line:='01100';end;
  141.  with Kody[07]do begin Asc:='7';Kod:=7;Line:='00011';end;
  142.  with Kody[08]do begin Asc:='8';Kod:=8;Line:='10010';end;
  143.  with Kody[09]do begin Asc:='9';Kod:=9;Line:='01010';end;
  144. // with Kody[10]do begin Asc:='{Start}';Kod:=10;Line:='000';end;
  145. // with Kody[11]do begin Asc:='{Stop}';Kod:=11;Line:='100';end;
  146. end.
  147.