pascal
Главная | Каталог статей | Регистрация | Вход
Воскресенье
02.02.2025
07:02
Приветствую Вас Гость | RSS
Главная » Статьи » Pascal » Программы

Транслитер по клавиатуре

 const
     n = 32;
     namef = 'cods.txt';
 
 type
    mCod = array [1..n] of char;
 
 label
     other;
 
 var
   RuM,EnM : mCod;
   pos,m : integer;
   s : string;
   
 procedure ReadCods (var a : mCOd; var p : integer);
  var
    i : integer;
    t : text;
    c : char;
  begin
   if FileExists (nameF) then
    begin
     assign (t,namef);
     reset (t);
      if p <> 0 then
       for i := 0 to (n+1)*p do
        read (t,c);
      for i := 1 to n do
       begin
        read (t,c);
        a [i] := c;
       end;
      close (t);
      p := p + 1;
     end
   else
    writeln ('File BaseCods not Found');
  end;
 
 procedure BaseTest (a,b : mCod);
  const
      KEn = 3219;
      KRu = 7664;      
  var
    i,s : integer;
    r1,r2 : boolean;
  begin
   s := 0;
   r1 := false; r2 := false;
   for i := 1 to n do
    s := s + (ord (a[i]));
   if s = KEn then
    r1 := true;
   s := 0;
   
   for i := 1 to n do
    s := s + (ord (b[i]));
   if s = KRu then
    r2 := true;
   
   if (r1) and (r2) then
    writeln ('BaseOk')
   else
    if (r1) then
     writeln ('only En BaseOk')
    else
     if (r2) then
      writeln ('only Ru BaseOk')
     else
      writeln ('Base Error');
   writeln ();
  end;
 
 function Lang (s : string) : integer;
  var
    r,a,i,l : integer;
    c : char;
  begin
   l := Length (s);
   r := 0;
   i := 1;
    while (r = 0) and (i < l) do
     begin
      c := s[i];
      a := ord (c);
   case a of
    65..122 : r :=1;
    192..255 : r := 2;;
    48..57 : i := i +1;
   end;
     end;
   Result := r;
  end;
 
 function Decod(a,b : mCod; s : string) : string;
  var
    i,l,p : integer;
    c : char;
    f : boolean;
    r : string;
  begin
   l := Length (s);
    for p := 1 to l do
     begin
      c := s[p];
      f := true;
      i := 1;
       while (i <(n+1)) and (f) do
        begin
         if (c = a[i]) or (c = UpCase (a[i])) then
          begin
           r := r + b[i];
           f := false;
          end;
         i := i +1;
        end;
       if f then
        r := r + c;
     end;
    Result := r; 
  end;
 
 begin
  m := 10; pos := 0;
  ReadCods (EnM,pos);
  ReadCods (RuM,pos);
  
  
  
  while m <> 0 do
   begin
    writeln ('Введите строку (0 - exit)');
    readln (s);
     
     case s[1] of
      '0' : m := 0;
      '3' : m := 3;
     else
      m := Lang (s);
     end;
     
     case m of
      1 : s := Decod (EnM,RuM,s);
      2 : s := Decod (RuM,EnM,s);
      0 : writeln ('exit Ok');
      3 : BaseTest (EnM, RuM);
     else
      writeln ('Errors string');
     end;
    writeln (s);
   end;
 end.

 

qwertyuiop[]asdfghjkl;'zxcvbnm,.
йцукенгшщзхъфывапролджэячсмитьбю

Категория: Программы | Добавил: cccc1808 (28.05.2015)
Просмотров: 251 | Рейтинг: 0.0/0
Всего комментариев: 0
avatar
Вход на сайт
Поиск
Copyright MyCorp © 2025
Бесплатный хостинг uCoz