Кириллица в латиницу и инверсия регистра.

← →
Saimon (2005-01-28 21:34) [0]

Мастера, помогите, плиззз.

Необходимо реализовать в своей проге, чтобы она (прога) умела переводить
кириллицу в латиницу и наоборот. Как это сделать???

И еще надо реализовать возможность инверсии регистра, например, "Delphi" в
"Вудзрш", "PS" в "ЗЫ" и наоборот. Как это сделать???

Заранее, спасибо.

← →
ninja © (2005-01-28 21:46) [1]

про инверсию регистра: просто прибавляй к коду символа 192. должно работать.

for i:=1 to length(s) do s[i]:=Char(Ord(s[i])+192);

← →
ninja © (2005-01-28 21:48) [2]

ой, вру я.
надо чтоб из английских получить русские - прибавлять 128, а чтобы наоборот - вычитать.

← →
Saimon (2005-01-29 14:22) [3]

Спасибо, чуть позже проверю...

← →
SergP © (2005-01-29 14:34) [4]

> [2] ninja © (28.01.05 21:48)
> ой, вру я.
> надо чтоб из английских получить русские - прибавлять 128,
> а чтобы наоборот - вычитать.

Не уверен.... Как я понял автору нужно преобразование символов по "клавиатурному" соответствию.

ИМХО лучше сделать таблицу (массив) для перекодировки.

← →
Anatoly Podgoretsky © (2005-01-29 14:44) [5]

Saimon (28.01.05 21:34)
кириллицу в латиницу и наоборот. Как это сделать???

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

И еще надо реализовать возможность инверсии регистра, например, "Delphi" в "Вудзрш", "PS" в "ЗЫ" и наоборот.

Простая подстановка по таблице. Работает в обе стороны, две таблицы.

← →
Saimon (2005-01-30 19:19) [6]

???
> ninja © (28.01.05 21:46) [1]

Не рабатает, т.е. работает но не правильно.

> Anatoly Podgoretsky © (29.01.05 14:44) [5]

Спасиб, а примера нет??

← →
Anatoly Podgoretsky © (2005-01-30 19:47) [7]

Оно с демо версией, или ты про какой пример спрашиваешь, про таблицы перекодировки, делай по образу и подобию. Индекс массива это код символа, значение это новый код.

← →
ninja © (2005-01-30 21:28) [8]

действительно, с кодами символов не работает. выдаёт какую-то каку..

А почему, не подскажете?

← →
Anatoly Podgoretsky © (2005-01-30 21:31) [9]

Ну наверно ошибка в программе.

← →
ninja © (2005-01-30 21:37) [10]

А, ну да. Теперь работает :)

Могу таблицей поделиться и функциями, если найду когдато писал нажималку кнопок.

УРА!!! Нашел

const (* Таблицы соответствия английской раскладки и русской *) TranslateDownRU: array[0..32] of char=("й","ц","у","к","е","н","г","ш","щ","з","х","ъ", "ф","ы","в","а","п","р","о","л","д","ж","э", "я","ч","с","м","и","т","ь","б","ю","."); TranslateUpRu: array[0..32] of char=("Й","Ц","У","К","Е","Н","Г","Ш","Щ","З","Х","Ъ", "Ф","Ы","В","А","П","Р","О","Л","Д","Ж","Э", "Я","Ч","С","М","И","Т","Ь","Б","Ю",","); TranslateDownENG: array[0..32] of char=("q","w","e","r","t","y","u","i","o","p","[","]", "a","s","d","f","g","h","j","k","l",";","""", "z","x","c","v","b","n","m",",",".","/"); TranslateUpENG: array[0..32] of char=("Q","W","E","R","T","Y","U","I","O","P","{","}", "A","S","D","F","G","H","J","K","L",":",""", "Z","X","C","V","B","N","M","<",">","?");

А вот и функции, убрать надо correction:

function correction(Ch: Char): Char; begin case ch of "ё": result:= "е"; "Ё": result:= "е"; ":": result:= "^"; """: result:= "@"; ".": result:= "."; ",": result:= ","; else result:= ch; end; end; function Translate(Ch: Char): char; var i: integer; ch2: char; begin Ch := Correction(Ch); for i:=0 to 32 do begin if TranslateDownRu[i] = ch then begin ch2 := TranslateDownEng[i]; break; end else ch2:= ch; if TranslateUpRu[i] = ch then begin ch2 := TranslateUpEng[i]; break; end else ch2:= ch; end; result := ch2; end;

← →
rolex (2005-01-30 21:51) [13]

> Необходимо реализовать в своей проге, чтобы она (прога)
> умела переводить
> кириллицу в латиницу и наоборот. Как это сделать???

Если я правильно понял, то требуется перевести русский в транслит, и наоборот. Для перевода русского в транслит, могу предложить такой код (когда-то давно ещё прогу для себя написал):
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Memo1: TMemo; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} function TextToTranslit(Text: string): string; var i:integer; begin for i:=1 to Length(text)*3 do begin if copy(text,i,1)="а" then begin delete(text,i,1); insert("a",text,i); end; if copy(text,i,1)="б" then begin delete(text,i,1); insert("b",text,i); end; if copy(text,i,1)="в" then begin delete(text,i,1); insert("v",text,i); end; if copy(text,i,1)="г" then begin delete(text,i,1); insert("g",text,i); end; if copy(text,i,1)="д" then begin delete(text,i,1); insert("d",text,i); end; if copy(text,i,1)="е" then begin delete(text,i,1); insert("e",text,i); end; if copy(text,i,1)="ё" then begin delete(text,i,1); insert("e",text,i); end; if copy(text,i,1)="ж" then begin delete(text,i,1); insert("zh",text,i); end; if copy(text,i,1)="з" then begin delete(text,i,1); insert("z",text,i); end; if copy(text,i,1)="и" then begin delete(text,i,1); insert("i",text,i); end; if copy(text,i,1)="й" then begin delete(text,i,1); insert("y",text,i); end; if copy(text,i,1)="к" then begin delete(text,i,1); insert("k",text,i); end; if copy(text,i,1)="л" then begin delete(text,i,1); insert("l",text,i); end; if copy(text,i,1)="м" then begin delete(text,i,1); insert("m",text,i); end; if copy(text,i,1)="н" then begin delete(text,i,1); insert("n",text,i); end; if copy(text,i,1)="о" then begin delete(text,i,1); insert("o",text,i); end; if copy(text,i,1)="п" then begin delete(text,i,1); insert("p",text,i); end; if copy(text,i,1)="р" then begin delete(text,i,1); insert("r",text,i); end; if copy(text,i,1)="с" then begin delete(text,i,1); insert("s",text,i); end; if copy(text,i,1)="т" then begin delete(text,i,1); insert("t",text,i); end; if copy(text,i,1)="у" then begin delete(text,i,1); insert("u",text,i); end; if copy(text,i,1)="ф" then begin delete(text,i,1); insert("f",text,i); end; if copy(text,i,1)="х" then begin delete(text,i,1); insert("h",text,i); end; if copy(text,i,1)="ц" then begin delete(text,i,1); insert("c",text,i); end; if copy(text,i,1)="ч" then begin delete(text,i,1); insert("ch",text,i); end; if copy(text,i,1)="ш" then begin delete(text,i,1); insert("sh",text,i); end; if copy(text,i,1)="щ" then begin delete(text,i,1); insert("sch",text,i); end; if copy(text,i,1)="ъ" then begin delete(text,i,1); insert("""",text,i); end; if copy(text,i,1)="ы" then begin delete(text,i,1); insert("yi",text,i); end; if copy(text,i,1)="ь" then begin delete(text,i,1); insert(""",text,i); end; if copy(text,i,1)="э" then begin delete(text,i,1); insert("ye",text,i); end; if copy(text,i,1)="ю" then begin delete(text,i,1); insert("yu",text,i); end; if copy(text,i,1)="я" then begin delete(text,i,1); insert("ya",text,i); end; if copy(text,i,1)="А" then begin delete(text,i,1); insert("A",text,i); end; if copy(text,i,1)="Б" then begin delete(text,i,1); insert("B",text,i); end; if copy(text,i,1)="В" then begin delete(text,i,1); insert("V",text,i); end; if copy(text,i,1)="Г" then begin delete(text,i,1); insert("G",text,i); end; if copy(text,i,1)="Д" then begin delete(text,i,1); insert("D",text,i); end; if copy(text,i,1)="Е" then begin delete(text,i,1); insert("E",text,i); end; if copy(text,i,1)="Ё" then begin delete(text,i,1); insert("E",text,i); end; if copy(text,i,1)="Ж" then begin delete(text,i,1); insert("Zh",text,i); end; if copy(text,i,1)="З" then begin delete(text,i,1); insert("Z",text,i); end; if copy(text,i,1)="И" then begin delete(text,i,1); insert("I",text,i); end; if copy(text,i,1)="Й" then begin delete(text,i,1); insert("Y",text,i); end; if copy(text,i,1)="К" then begin delete(text,i,1); insert("K",text,i); end; if copy(text,i,1)="Л" then begin delete(text,i,1); insert("L",text,i); end; if copy(text,i,1)="М" then begin delete(text,i,1); insert("M",text,i); end; if copy(text,i,1)="Н" then begin delete(text,i,1); insert("N",text,i); end; if copy(text,i,1)="О" then begin delete(text,i,1); insert("O",text,i); end; if copy(text,i,1)="П" then begin delete(text,i,1); insert("P",text,i); end; if copy(text,i,1)="Р" then begin delete(text,i,1); insert("R",text,i); end; if copy(text,i,1)="С" then begin delete(text,i,1); insert("S",text,i); end; if copy(text,i,1)="Т" then begin delete(text,i,1); insert("T",text,i); end; if copy(text,i,1)="У" then begin delete(text,i,1); insert("U",text,i); end; if copy(text,i,1)="Ф" then begin delete(text,i,1); insert("F",text,i); end; if copy(text,i,1)="Х" then begin delete(text,i,1); insert("H",text,i); end; if copy(text,i,1)="Ц" then begin delete(text,i,1); insert("C",text,i); end; if copy(text,i,1)="Ч" then begin delete(text,i,1); insert("Ch",text,i); end; if copy(text,i,1)="Ш" then begin delete(text,i,1); insert("Sh",text,i); end; if copy(text,i,1)="Щ" then begin delete(text,i,1); insert("Sch",text,i); end; if copy(text,i,1)="Ъ" then begin delete(text,i,1); insert("""",text,i); end; if copy(text,i,1)="Ы" then begin delete(text,i,1); insert("Yi",text,i); end; if copy(text,i,1)="Ь" then begin delete(text,i,1); insert(""",text,i); end; if copy(text,i,1)="Э" then begin delete(text,i,1); insert("Ye",text,i); end; if copy(text,i,1)="Ю" then begin delete(text,i,1); insert("Yu",text,i); end; if copy(text,i,1)="Я" then begin delete(text,i,1); insert("Ya",text,i); end; end; result:=Text; end; procedure TForm1.Button1Click(Sender: TObject); begin memo1.Text:=TextToTranslit(Memo1.Text); end; end.

Однако :-)

← →
Saimon (2005-02-03 01:39) [15]

Спасибоооо!!!!!!!!!!!!!!

Cgfcb,jjjj!!!!!!!!!!!!!!

Кириллица в латиницу и инверсия регистра. Найти похожие ветки