Транслит

← →
Yad (2004-06-01 22:21) [0]

Может кто знает ссылку на компонет, позволяющий производить транслитерацию и детранслитерацию текста. Кладовку здесь уже облазил, нашел кое-что, но здесь ничего не скачивается, всё удалено.

← →
YurikGL © (2004-06-01 22:52) [1]

Человек слегка извращался, но все же
http://delphimaster.net/view/1-1086024148/

← →
Delphin © (2004-06-01 22:55) [2]

транслитерезация:

RA:Array[0..65]Of String=("А","Б","В","Г","Д","Е","Ё","Ж","З","И","Й","К","Л","М","Н","О","П","Р","С","Т","У","Ф","Х","Ц","Ч","Ш","Щ","Ы", "Ъ","Э","Ь","Ю","Я","а","б","в","г","д","е","ё","ж","з","и","й","к","л","м","н","о","п","р","с","т","у","ф","х","ц","ч", "ш","щ","ы","ъ","э","ь","ю","я");
LA:Array[0..65]Of String=("A","B","V","G","D","E","Jo","Zh","Z","I","J","K","L","M","N","O","P","R","S","T","U","F","H","C","Ch","Sh","sh" ,"I","","E","J","Ju","Ja","a","b","v","g","d","e","jo","zh","z","i","j","k","l","m","n","o","p","r","s","t","u","f","h", "c","ch","sh","sh","i","","e","j","ju","ja");
Function Trans(Input:String):String;
Var
I,Z:Integer;
S,Output:String;
Begin
For I:=1 To Length(Input) Do Begin
S:=Copy(Input,1,1);
For Z:=0 to 65 Do
IF S=RA[z] Then Begin
S:=La[z];
End;
IF Z>=65 Then
Output:=Output+S;
Result:=Output;
Delete(Input,1,1);
S:=EmptyStr;
End;
End;
***************************************
Перевести можно таким образом (используя данные массивы)
Var
I,Z:Integer;
S:String ;

Repeat Inc(I);
S:=Memo1.Text[i];

IF S+Memo1.Text[i+1]=LA[57] Then Begin
S:=Ra[57];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[24] Then Begin
S:=Ra[24];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[6] Then Begin
S:=Ra[6];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[39] Then Begin
S:=Ra[39];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[7] Then Begin
S:=Ra[7];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[40] Then Begin
S:=Ra[40];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[57] Then Begin
S:=Ra[57];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[25] Then Begin
S:=Ra[25];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[58] Then Begin
S:=Ra[58];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[31] Then Begin
S:=Ra[31];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[64] Then Begin
S:=Ra[64];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[32] Then Begin
S:=Ra[32];
INC(I);
End;
IF S+Memo1.Text[i+1]=LA[65] Then Begin
S:=Ra[65];
INC(I);
End;
For Z:=0 to 65 Do
IF S=LA[z] Then
S:=Ra[z];
IF Z>=65 Then
Output:=Output+S;
UnTil
I=Memo1.GetTextLen;
Edit1.Text:=Output;
I:=0;
end;

← →
panov © (2004-06-01 23:05) [3]

Жуть.

← →
Gero © (2004-06-01 23:10) [4]

> panov © (01.06.04 23:05)

Не то слово.

← →
YurikGL © (2004-06-01 23:12) [5]

Слегка улучшим
RA:Array[0..65]Of Char ...

Function Trans(Input:String):String;
Var
I,Z:Integer;
Output:String;
Begin
Output:="";
For I:=1 To Length(Input) Do
For Z:=0 to 65 Do
IF input[i]=RA[z] Then
output:=output+LA[z]
Result:=Output;
End;

Если ничего не накосячил, то будет транслитерировать из англ в рус.

все что было в Delphin © (01.06.04 22:55) [2] ниже - не нужно

просто Edit1.text:=trans(Edit2.text)

← →
YurikGL © (2004-06-01 23:14) [6]

panov © (01.06.04 23:05) [3]
Gero © (01.06.04 23:10) [4]

Так получше?

← →
panov © (2004-06-01 23:20) [7]

Вот функция для перевода с русского:
function Translate(s:string):string; const //ГОСТ 16876-71 LA:array["А".."я"] of string =( "A","B","V","G","D","E","ZH","Z","I","JJ","K","L", "M","N","O","P","R","S","T","U","F","KH","C","CH", "SH","SHH",""","Y","""","EH","JU","JA", "a","b","v","g","d","e","zh","z","i","jj","k","l", "m","n","o","p","r","s","t","u","f","kh","c","ch", "sh","shh",""","y","""","eh","ju","ja"); var i:integer; begin result:=""; for i:=1 to Length(s) do case s[i] of "Ё": result := result+"YO"; "ё": result := result +"yo"; "А".."я": result := result + LA[s[i]]; else result :=result+s[i]; end; end;
(c) Adder

Для обратного перевода пока не готова...

← →
Gero © (2004-06-01 23:30) [8]

> YurikGL © (01.06.04 23:14)

Я [2] имел ввиду.

← →
Gero © (2004-06-01 23:31) [9]

> Delphin © (01.06.04 22:55)

Кстати, только заметил:
А что такое "транслитерезация"?

← →
Anatoly Podgoretsky © (2004-06-01 23:35) [10]

Чего вы функции приводите, просили же КОМПОНЕНТ

← →
YurikGL © (2004-06-01 23:36) [11]

> Gero © (01.06.04 23:30) [8]
>
> > YurikGL © (01.06.04 23:14)
>
> Я [2] имел ввиду.

А я [5] имел в виду :)))

> А что такое "транслитерезация"?

Видимо транслитерация :)

← →
YurikGL © (2004-06-01 23:37) [12]

> Чего вы функции приводите, просили же КОМПОНЕНТ

Дык недолго встроить например в компонент TLabel :) будет очень удобно.

> Кладовку здесь уже облазил, нашел кое-что

Неужто такие компоненты нашел?

> YurikGL © (01.06.04 23:36)
> А я [5] имел в виду :)))

Сорри, был невнимателен.

> Дык недолго встроить например в компонент TLabel :)

Нет, TButton круче.

> Сорри, был невнимателен.

Нот ат алл :)

> Нет, TButton круче

Тогда уж в SpeedButton - быстрее будет работать :)

← →
Yad (2004-06-02 09:10) [16]

Спасибо всем. А всё же жаль, что из кладовки исходники удалили, только exe-шники оставили. Лучше бы наоборот сделали.

Транслит Найти похожие ветки