Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Кодирование русского текста методом сдвига

01.01.2007
Автор: ___Nikolay

unit uMain;
 
interface
 
uses
 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 
StdCtrls, ExtCtrls, ComCtrls, Spin;
 
type
  TForm1
= class(TForm)
    Panel1
: TPanel;
    mmText
: TMemo;
    Label1
: TLabel;
    seN
: TSpinEdit;
    Label2
: TLabel;
    btEncode
: TButton;
    btDecode
: TButton;
    procedure btEncodeClick
(Sender: TObject);
 
private
   
{ Private declarations }
    procedure
Encode(bCode: boolean; n: integer); // Encode - ПРОЦЕДУРА
                                                 
// bCode  - зашифровать/расшифровать
                                                 
// n      - шаг смещения
 
public
   
{ Public declarations }
 
end;
 
var
  Form1
: TForm1;
 
implementation
 
{$R *.DFM}
 
// ПРОЦЕДУРА КОДИРОВАНИЯ
procedure TForm1
.Encode(bCode: boolean; n: integer);
const
  sMsgRangeErr
= 'Значение шага должно быть от %d до %d!';
 
 
// Крайние символы для кодирования
  chBigFirstLetter
: char = 'А';
  chBigLastLetter
: char = 'Я';
 
  chFirstLetter
: char = 'а';
  chLastLetter
: char = 'я';
var
  iMinOrd
: integer; // Код символа с наименьшим кодом
  iMaxOrd
: integer; // Код символа с наибольшим кодом
  i
: integer; // Для фикла
  iTempOrd
: integer; // Код подставляемого символа
  ch
: char; // Каждый символ текста
  s
: string; // Преобразуемый текст
begin
 
// Проверка шага на диапазон допустимых значений
 
if (n > Ord(chBigLastLetter) - Ord(chBigFirstLetter)) or (n < 1) then
 
begin
   
MessageDlg(Format(sMsgRangeErr, [1, Ord(chBigLastLetter) - Ord(chBigFirstLetter)]), mtError, [mbOk], 0);
   
Exit;
 
end;
 
  s
:= Trim(mmText.Text);
 
if s <> '' then // Если есть текст
   
for i := 1 to Length(s) do // Проходит каждый символ
   
begin
      ch
:= s[i];
 
     
// Если очередной символ нужно кодировать
     
if ch in [chBigFirstLetter .. chBigLastLetter] then // Заглавные буквы
     
begin
        iMinOrd
:= Ord(chBigFirstLetter);
        iMaxOrd
:= Ord(chBigLastLetter);
     
end
     
else
     
if ch in [chFirstLetter .. chLastLetter] then // Строчные буквы
     
begin
        iMinOrd
:= Ord(chFirstLetter);
        iMaxOrd
:= Ord(chLastLetter);
     
end
     
else // Символ кодировать не нужно
       
continue;
 
     
if bCode then // Закодировать
     
begin
        iTempOrd
:= Ord(ch) + n; // Получаем потенциальную позицию
       
if iMaxOrd - iTempOrd < 0 then // Если символ зашел за границу предельного
          ch
:= Chr(iMinOrd + abs(iMaxOrd - iTempOrd) - 1) // Возьмем символ с другого конца круга
       
else // Если нет..
          ch
:= chr(iTempOrd); //..все нормально
     
end
     
else // Раскодировать
     
begin
        iTempOrd
:= Ord(ch) - n; // Получаем потенциальную позицию
       
if iMinOrd - iTempOrd > 0 then // Если символ зашел за границу предельного
          ch
:= Chr(iMaxOrd - (iMinOrd - iTempOrd - 1)) // Возьмем символ с другого конца круга
       
else // Если нет..
          ch
:= chr(iTempOrd); //..все нормально
     
end;
 
      s
[i] := ch;
   
end;
  mmText
.Text := s;
end;
 
procedure TForm1
.btEncodeClick(Sender: TObject);
begin
 
Encode(boolean((Sender as TButton).Tag), seN.Value);
end;
 
end.

https://delphiworld.narod.ru/

DelphiWorld 6.0