Приветствую Вас Гость | RSS

Delphi заготовки

Суббота, 11.05.2024, 07:34
Главная » 2012 » Апрель » 18 » Пример программы на Delphi для трансляции русских букв
12:56
Пример программы на Delphi для трансляции русских букв
Пример программы для осуществления трансляции русских букв в латинские
Функция получает транслейт их русского текста


напишем две функции

Function GetRusToEng(RusV:string):string; // Функция получает транслейт их русского текста      
 
Function GetEngToRus(EngV:string):string; // Функция получает русский текст из транслейта        



Function GetRusToEng(RusV:string):string;
const

  rusold:array[1..32] of string[3]=('А','Б','В','Г','Д','Е','Ж','З','И','Й','К','Л','М','Н','О','П','Р','С','Т','У','Ф','Х','Ц','Ч','Ш','Щ','Ъ'
,'Ы','Ь','Э','Ю','Я');
  rus:array[1..32] of string[3]= ('A','B','V','G','D','E','ZH','Z','I','Y','K','L','M','N','O','P','R','S','T','U','F','KH', 'C', 'CH','SH','SCH',#39,'Y',#39,'E','YU','YA');
  var l,x:integer;
      eng:string;
begin
   eng:='';
   l:=length(RusV);
   for X:=1 to l do begin
    if (rusv[x]<='А') then
    eng:=eng+rusv[x]
    else
      if LowerCaseRus(rusv[x])=(rusv[x]) then begin // если симовл низкий то
      eng:=eng+LowerCaseRus(rus[ord(UpperCaseRus(RusV[x])[1])-ord('А')+1]);
      end
      else
       if LowerCaseRus(rusv[x+1])=(rusv[x+1]) then  // если символ следующий за большим символом низкий то делаем второй символ транслейта тоже низким

        eng:=eng+copy(rus[ord(UpperCaseRus(RusV[x])[1])-ord('А')+1],1,1)+LowerCaseRus(copy(rus[ord(UpperCaseRus(RusV[x])[1])-ord('А')+1],2,3))
      else eng:=eng+rus[ord(UpperCaseRus(RusV[x])[1])-ord('А')+1]
   end;
   result:=eng;

end;




Function GetEngToRus(EngV:string):string;
const

  rusold:array[1..32] of string[3]=('А','Б','В','Г','Д','Е','Ж','З','И','Й','К','Л','М','Н','О','П','Р','С','Т','У','Ф','Х','Ц','Ч','Ш','Щ','Ъ','Ы',
'Ь','Э','Ю','Я');
  rus:array[1..32] of string[3]= ('A','B','V','G','D','E','ZH','Z','I','Y','K','L','M','N','O','P','R','S','T','U','F','KH', 'C', 'CH','SH','SCH',#39,'Y',#39,'E','YU','YA');


Function GetRusIndexFormArray(s:string):integer;
var x:integer;
begin
 result:=-1;
 s:=UpperCaseRus(s);
 for X:=1 to 32 do begin
    if s=rus[x] then begin result:=x;
    exit;
    end;
 end;
end;
  var l,x:integer;
      s1:String;
      index:integer;
      Litle:boolean;

      Function GetLitleA(s:string;Litle:boolean):string; // делает букву строчной если litle:=true;
      begin
        if Litle then result:=LowerCaseRus(s)
        else result:=s;

      end;
begin
   result:='';
   l:=length(EngV);
   for X:=1 to l do begin
    Litle:=false;
    if LowerCaseRus(EngV[x])=(EngV[x]) then Litle:=true;
    if ((Engv[x]>='А')) or (Engv[x] in  WordDelimiters) and (Engv[x]<>#39)  then // Если русские буквы или знак разделителя слов
    result:=result+Engv[x]
    else
      begin
      s1:=copy(Engv,x,3);
      index:=GetRusIndexFormArray(s1);
      if index>-1 then
        result:=result+GetLitleA(rusold[index],litle)
        else begin
               s1:=copy(Engv,x,2);
               index:=GetRusIndexFormArray(s1);
               if index>-1 then
                  result:=result+GetLitleA(rusold[index],litle)
               else begin
                     s1:=copy(Engv,x,1);
                     index:=GetRusIndexFormArray(s1);
                     if index>-1 then
                        result:=result+GetLitleA(rusold[index],litle)
               end

             end
    end;end;
end;


Function GetRusOrEngWord(s:string):integer; // возвращает 1 если Англиское слово  // 2 если русское. 

  Function GetRusOrEngWord(s:string):integer;
  var x:integer;
      lt:boolean;
      ru:boolean;
  begin
  lt:=false;
  ru:=false;
    for X:=1 to length(s) do begin
       if s[x] in lat then lt:=true;
       if s[x] in rus then ru:=true;
    end;
  if lt and (not ru) then result:=1
  else if (ru) and (not lt) then result:=2
  else result:=3;
  end;


ключевые слова Transleit Транслейт
Просмотров: 1936 | Добавил: NetSoftWare | Рейтинг: 4.0/1
Всего комментариев: 1
1 NetSoftWare  
0
function LowerCaseRus(const S: string): string;
var
Ch: Char;
L: Integer;
Source, Dest: PChar;
begin
L := Length(S);
SetLength(Result, L);
Source := Pointer(S);
Dest := Pointer(Result);
while L <> 0 do
begin
Ch := Source^;
if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);
if (Ch >= 'А') and (Ch <= 'Я') then Inc(Ch, 32);
Dest^ := Ch;
Inc(Source);
Inc(Dest);
Dec(L);
end;
end;

Имя *:
Email *:
Код *: