Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Прочее";
Текущий архив: 2008.04.20;
Скачать: [xml.tar.bz2];

Вниз

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

 
webSQLNeederr   (2008-03-06 15:10) [0]

Подскажите пожалуйста может кто то видел реализацию функции перевода кирилицы в латиницу.


 
axis_of_evil ©   (2008-03-06 15:42) [1]

ой, там столько кодировок ...
 "a ? ja = я // sample
вы определитесь - вам в какой %>


 
Игорь Шевченко ©   (2008-03-06 15:56) [2]

const

ABC_Count = 33;

RusLet: array[1..ABC_Count*2] of Char = ("А","Б","В","Г","Д","Е","Ё","Ж","З","И",
                                         "Й","К","Л","М","Н","О","П","Р","С","Т",
                                         "У","Ф","Х","Ц","Ч","Ш","Щ","Ъ","Ы","Ь",
                                         "Э","Ю","Я",
                                         "а","б","в","г","д","е","ё","ж","з","и",
                                         "й","к","л","м","н","о","п","р","с","т",
                                         "у","ф","х","ц","ч","ш","щ","ъ","ы","ь",
                                         "э","ю","я");

TransLet: array[1..ABC_Count*2] of String = ("A","B","V","G","D","YE","YE","ZH","Z","I",
                                             "Y","K","L","M","N","O","P","R","S","T",
                                             "U","F","KH","TC","CH","SH","SHCH",""","Y","""",
                                             "E","YU","YA",
                                             "a","b","v","g","d","ye","ye","zh","z","i",
                                             "y","k","l","m","n","o","p","r","s","t",
                                             "u","f","kh","tc","ch","sh","shch",""","y","""",
                                             "e","yu","ya");

function Rus2Translit(Value: Char): String;
function Rus2TranslitS(Value: String): String;

implementation

function Rus2Translit(Value: Char): String;
var i,j: integer;
begin
 j := 0;
 for i := 1 to ABC_Count*2 do
 if RusLet[i] = Value then
 begin
   j := i;
   break;
 end;
 if j > 0 then
   Result := TransLet[j]
 else
   Result := Value;
end;

function Rus2TranslitS(Value: String): String;
var i: integer;
begin
 Result := "";
 for i := 1 to Length(Value) do Result := Result + Rus2Translit(Value[i]);
end;


 
clickmaker ©   (2008-03-06 16:04) [3]

можно просто тупо забить массив из 64 строк, тогда русский символ - 192 будет индексом


 
webSQLNeederr   (2008-03-06 16:10) [4]

Спасибо но я уже свои функцию написал.

function make_url(key:string):string;
 var i:integer;temp,res:TStringList;
begin
 temp:=TStringList.Create;
 temp.Text:=key;
 for i:=0 to length(key)-1 do
 begin

   temp.Text:=lowercase(temp.Text);
   temp.text:=AnsiReplaceText(temp.text,"a","a");    temp.text:=AnsiReplaceText(temp.text,"ð","r");
   temp.text:=AnsiReplaceText(temp.text,"á","b");    temp.text:=AnsiReplaceText(temp.text,"ñ","s");
   temp.text:=AnsiReplaceText(temp.text,"â","v");    temp.text:=AnsiReplaceText(temp.text,"ò","t");
   temp.text:=AnsiReplaceText(temp.text,"ã","g");    temp.text:=AnsiReplaceText(temp.text,"ó","u");
   temp.text:=AnsiReplaceText(temp.text,"ä","d");    temp.text:=AnsiReplaceText(temp.text,"ô","f");
   temp.text:=AnsiReplaceText(temp.text,"å","e");    temp.text:=AnsiReplaceText(temp.text,"õ","h");
   temp.text:=AnsiReplaceText(temp.text,"¸","yo");    temp.text:=AnsiReplaceText(temp.text,"ö","c");
   temp.text:=AnsiReplaceText(temp.text,"æ","zh");    temp.text:=AnsiReplaceText(temp.text,"÷","ch");
   temp.text:=AnsiReplaceText(temp.text,"ç","z");    temp.text:=AnsiReplaceText(temp.text,"ø","sh");
   temp.text:=AnsiReplaceText(temp.text,"è","i");    temp.text:=AnsiReplaceText(temp.text,"ù","shch");
   temp.text:=AnsiReplaceText(temp.text,"é","y");    temp.text:=AnsiReplaceText(temp.text,"ú","");
   temp.text:=AnsiReplaceText(temp.text,"ê","k");    temp.text:=AnsiReplaceText(temp.text,"û","i");
   temp.text:=AnsiReplaceText(temp.text,"ë","l");    temp.text:=AnsiReplaceText(temp.text,"ü","");
   temp.text:=AnsiReplaceText(temp.text,"ì","m");    temp.text:=AnsiReplaceText(temp.text,"ý","e");
   temp.text:=AnsiReplaceText(temp.text,"í","n");    temp.text:=AnsiReplaceText(temp.text,"þ","yu");
   temp.text:=AnsiReplaceText(temp.text,"î","o");    temp.text:=AnsiReplaceText(temp.text,"ÿ","ya");
   temp.text:=AnsiReplaceText(temp.text,"ï","p");    temp.text:=AnsiReplaceText(temp.text," ","_");
   temp.text:=AnsiReplaceText(temp.text,"",".html");
 end;
 //temp.Add(".html");
 make_url:=temp.Text;temp.Free;
end;


 
webSQLNeederr   (2008-03-06 16:12) [5]

Только теперь вопрос когда я пытаюсь создать из всего этого урл и пишу
url:=make_url(rus_words)+".html";
то ".html" оно переносит на новую строку и соответственно урл не коректный получается.

Как сделать что бы оно не переносило на новую строку?


 
clickmaker ©   (2008-03-06 16:17) [6]


> [4] webSQLNeederr   (06.03.08 16:10)

низачот
неоптимально - раз
непонятно, что там делает цикл - два
коряво - три


 
webSQLNeederr   (2008-03-06 16:19) [7]

Цикл это да лишнее. Я забыл его убрать, я раньше через if .. then делал.

Но меня больше интересует как что бы .хтмл не переносилось на новую строку


 
clickmaker ©   (2008-03-06 16:21) [8]


> как что бы .хтмл не переносилось на новую строку

не используй стринглист
смотри мой пост или Игоря, если уж совсем лень топтать клаву


 
Игорь Шевченко ©   (2008-03-06 16:39) [9]


>    temp.text:=AnsiReplaceText(temp.text,"",".html");


Сильно


 
webSQLNeederr   (2008-03-06 16:47) [10]

:) та это я тоже так ... тестировал разные варианты на авось :)

Игорь Шевченко, спасибо твоя функция заработала.



Страницы: 1 вся ветка

Форум: "Прочее";
Текущий архив: 2008.04.20;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.044 c
15-1204619018
Kerk
2008-03-04 11:23
2008.04.20
Писательница призналась в фабрикации мемуаров о Холокосте


3-1194961339
Kolan
2007-11-13 16:42
2008.04.20
Как узнать SQL запрос возвращает результат или нет?


2-1206415904
Santon26
2008-03-25 06:31
2008.04.20
Работа с XML файлом


2-1206463452
Strate
2008-03-25 19:44
2008.04.20
Несколько вопросов по сервисам начинающего


15-1204520510
ryden
2008-03-03 08:01
2008.04.20
Помогите найти иконки для прграммы





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский