Код:
program Translit;
{$APPTYPE CONSOLE}
uses
SysUtils;
const
ENG: array[1..33] 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','Z','CH','SH','SHH','"','I','"','YE','JU','JA');
RUSup: array[1..33] of integer = (128, 129, 130, 131 ,132, 133, 240, 134, 135 ,136 ,137 ,138, 139 ,140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159);
RUSlw: array[1..33] of integer = (160, 161, 162, 163, 164, 165, 241, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239);
var
i,b:integer;
strBuff,strOut:string;
begin
writeln('Vvedite slova dlia transliterazii');
readln(strBuff);
for i:=1 to length(strBuff) do begin
b:=1;
strOut:='';
if strBuff[i] <> ' ' then
while b<>length(RUSup)+1 do begin
if ord(strBuff[i])=RUSup[b] then begin
strOut:=UpperCase(ENG[b]);
end;
if ord(strBuff[i])=RUSlw[b] then begin
strOut:=LowerCase(ENG[b]);
end;
inc(b);
end;
if strOut = '' then strOut :=strBuff[i];
write(strOut);
end;
readln;
end.
Если вам кажется что код немного кривоват и не оптимизирован - посмотрите на время поста.
Использую массив кодов ascii из - за возникших проблем с существующими функциями перевода русских символов в верхний регистр.