Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Кириллица в латиницу и инверсия регистра. [D6, D7, WinXP]

Saimon © (2005-01-28 21:34:00)
Мастера, помогите, плиззз.

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

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

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

Saimon (2005-02-03 01:39:00) [1]
Спасибоооо!!!!!!!!!!!!!!

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

Anatoly Podgoretsky (2005-01-30 21:53:00) [2]
Однако :-)

rolex (2005-01-30 21:51:00) [3]

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

Если я правильно понял, то требуется перевести русский в транслит, и наоборот. Для перевода русского в транслит, могу предложить такой код (когда-то давно ещё прогу для себя написал):
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.

Поручик (2005-01-30 21:47:00) [4]
УРА!!! Нашел

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;

Поручик (2005-01-30 21:43:00) [5]
Могу таблицей поделиться и функциями, если найду когдато писал нажималку кнопок.

ninja (2005-01-30 21:37:00) [6]
А, ну да. Теперь работает :)

Anatoly Podgoretsky (2005-01-30 21:31:00) [7]
Ну наверно ошибка в программе.

ninja (2005-01-30 21:28:00) [8]
действительно, с кодами символов не работает. выдаёт какую-то каку..

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

Anatoly Podgoretsky (2005-01-30 19:47:00) [9]
Оно с демо версией, или ты про какой пример спрашиваешь, про таблицы перекодировки, делай по образу и подобию. Индекс массива это код символа, значение это новый код.

Saimon (2005-01-30 19:19:00) [10]
???
> ninja © (28.01.05 21:46) [1]

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

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

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

Anatoly Podgoretsky (2005-01-29 14:44:00) [11]
Saimon (28.01.05 21:34)
кириллицу в латиницу и наоборот. Как это сделать???

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

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

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

SergP (2005-01-29 14:34:00) [12]

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

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

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

Saimon (2005-01-29 14:22:00) [13]
Спасибо, чуть позже проверю...

ninja (2005-01-28 21:48:00) [14]
ой, вру я.
надо чтоб из английских получить русские - прибавлять 128, а чтобы наоборот - вычитать.

ninja (2005-01-28 21:46:00) [15]
про инверсию регистра: просто прибавляй к коду символа 192. должно работать.

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

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »