Автор: Balu
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Перекодировка текста из Win кодировки в КОИ-8 и обратно

Перекодировка текста из Win кодировки в КОИ-8 и обратно

Зависимости: НЕТ :-)
Автор:       Balu, balusoft@mail.ru, Харьков
Copyright:   Balu
Дата:        26 июня 2002 г.
***************************************************** }

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

function WinToKoi(Str: string): string;
var
  i, j, Index: Integer;
begin
  Result := '';

  for i := 1 to Length(Str) do
  begin
    Index := -1;
    for j := Low(Win) to High(Win) do
      if Win[j] = Str[i] then
      begin
        Index := j;
        Break;
      end;

    if Index = -1 then
      Result := Result + Str[i]
    else
      Result := Result + Koi[Index];
  end;
end;

function KoiToWin(Str: string): string;
var
  i, j, Index: Integer;
begin
  Result := '';

  for i := 1 to Length(Str) do
  begin
    Index := -1;
    for j := Low(Win) to High(Win) do
      if Koi[j] = Str[i] then
      begin
        Index := j;
        Break;
      end;

    if Index = -1 then
      Result := Result + Str[i]
    else
      Result := Result + Win[Index];
  end;
end;

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Text := WinToKoi(Memo2.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Text := KoiToWin(Memo2.Text);
end;