@Zlata111

Подскажите пожалуйста! Что мне тут надо поменять чтоб работала программа. Чтобы кодировались буквы в русском алфавите.

Вот код:

program Project1;

{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;

type
str3 = string[3];

const
vtext: array[1..33] of char=('а','б','в','г','д','е','ё','ж','з','и','й','к','л',
'м','н','о','п','р','с','т','у','ф','х','ц','ч','ш','щ','ъ','ы','ь','э','ю','я') ;
vcode: array[1..33] of str3=('123','033','333','121','603','901','301','302','303',
'304','305','306','307','308','309','213','331','332','334','335','336','337',
'338','339','092','093','094','095','096','097','098','099','606');
var

mytext: string;
mycode: array[1..65536] of str3;
i,j,k, n: integer;


procedure MyWriteln(const S: string);
var
NewStr: string;
begin
SetLength(NewStr, Length(S));
CharToOem(PChar(S), PChar(NewStr));
Writeln(NewStr);
end;

begin

repeat
MyWriteln('Введите слово');
Readln(mytext);

for i := 1 to Length(mytext) do
if Pos(mytext[i], vtext) = 0 then Inc(k);

if k<>0 then MyWriteln('Неправильно');
until k=0;

n := Length(mytext);
for i := 1 to Length(mytext) do
mycode[ i ] := vcode[ Pos(mytext[i], vtext) ];

MyWriteln('Закодированное слово:');

for i := 1 to n do
Writeln(mycode[ i ]);


WriteLn;
Readln

end.

0