Новичок
Профиль
Группа: Участник
Сообщений: 15
Регистрация: 15.10.2014
Репутация: нет
Всего: нет
|
У меня статическая матрица(то есть она как бы вшита и не изменяется).Нужно чтобы была динамическая матрица(5 на 5,с использованием только латинского алфавита).Допустим я ввожу ключ "hello world".Матрица в этом случае должна выглядеть так: HELOW WRDAB CFGIJ KMNPQ STUVX Как это реализовать?Прикладываю программу | Код |
unit U_1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Button1: TButton;
Button2: TButton;
Label4: TLabel;
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
A:array[1..5,1..5] of char = (('L','A','R','K','X'),
('Z','G','D','Y','B'),
('Q','N','M','H','T'),
('C','O','I','V','E'),
('P','U','F','S','W')); //Ключевая матрица
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
ir,i,j,n,k:integer;
tabi,tabj,findi,findj:1..5;
begin
Memo1.Text:=AnsiUpperCase(Memo1.Text); // Делаем буквы заглавные в первом поле
Memo2.Text:=Memo1.Text; // Делаем буквы заглавные во втором поле
for ir:=0 to Memo1.Lines.Count do begin
s:='';
n:=length(Memo1.Lines[ir]);
for i:=1 to n do
if (Memo1.Lines[ir][i]=Memo1.Lines[ir][i+1]) and
(not (Memo1.Lines[ir][i] in ['0','1','2','3','4','5','6','7','8','9']))
then
s:=s+Memo1.Lines[ir][i]+'I' // Во второй строке слово будет на 1 символ больше
else
s:=s+Memo1.Lines[ir][i];
n:=0;
for i:=1 to length(s) do
if not (Memo1.Lines[ir][i] in ['0','1','2','3','4','5','6','7','8','9']) then
inc(n);
if n mod 2<>0 then // Если кол-во букв не кратно 2
s:=s+'I';
Memo1.Lines[ir]:=s;
i:=1;
n:=length(s);
s:='';
while i<=n do begin
k:=0;
if (Memo1.Lines[ir][i] in ['0','1','2','3','4','5','6','7','8','9']) then
begin
s:=s+Memo1.Lines[ir][i];
i:=i+1
end
else
begin
for tabi:=1 to 5 do
for tabj:=1 to 5 do
if Memo1.Lines[ir][i]=a[tabi,tabj] then begin
//Ищем по строкам
for findj:=1 to 5 do
if Memo1.Lines[ir][i+1]=a[tabi,findj] then
begin
if tabj+1=6 then
s:=s+a[tabi,1]
else
s:=s+a[tabi,tabj+1];
if findj+1=6 then
s:=s+a[tabi,1]
else
s:=s+a[tabi,findj+1];
k:=k+1
end;
//Ищем по столбцам
if k=0 then
for findi:=1 to 5 do
if Memo1.Lines[ir][i+1]=a[findi,tabj] then
begin
if tabi+1=6 then
s:=s+a[1,tabj]
else
s:=s+a[tabi+1,tabj];
if findi+1=6 then
s:=s+a[1,tabj]
else
s:=s+a[findi+1,tabj];
k:=k+1
end;
//В случае если нет символов
if k=0 then
for findi:=1 to 5 do
for findj:=1 to 5 do
if Memo1.Lines[ir][i+1]=a[findi,findj] then
s:=s+a[findi,tabj]+a[tabi,findj]
end;
i:=i+2;
end;
end;
Memo1.Lines[ir]:=s;
end;
s:=Memo1.Text;
Memo1.Text:=Memo2.Text;
Memo2.Text:=s;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
s:string;
ir,i,j,n,k:integer;
tabi,tabj,findi,findj:1..5;
begin
Memo3.Clear;
Memo3.Text:=Memo2.Text;
for ir:=0 to Memo2.Lines.Count do begin
s:='';
n:=length(Memo2.Lines[ir]);
i:=1;
while i<=n do begin
k:=0;
if (Memo2.Lines[ir][i] in ['0','1','2','3','4','5','6','7','8','9']) then
begin
s:=s+Memo2.Lines[ir][i];
i:=i+1
end
else
begin
for tabi:=1 to 5 do
for tabj:=1 to 5 do
if Memo2.Lines[ir][i]=a[tabi,tabj] then begin
//Ищем по строкам
for findj:=1 to 5 do
if Memo2.Lines[ir][i+1]=a[tabi,findj] then
begin
if tabj-1=0 then
s:=s+a[tabi,5]
else
s:=s+a[tabi,tabj-1];
if findj-1=0 then
s:=s+a[tabi,5]
else
s:=s+a[tabi,findj-1];
k:=k+1
end;
//Ищем по столбцам
if k=0 then
for findi:=1 to 5 do
if Memo2.Lines[ir][i+1]=a[findi,tabj] then
begin
if tabi-1=0 then
s:=s+a[5,tabj]
else
s:=s+a[tabi-1,tabj];
if findi-1=0 then
s:=s+a[5,tabj]
else
s:=s+a[findi-1,tabj];
k:=k+1
end;
//В случае если нигде нет
if k=0 then
for findi:=1 to 5 do
for findj:=1 to 5 do
if Memo2.Lines[ir][i+1]=a[findi,findj] then
s:=s+a[findi,tabj]+a[tabi,findj]
end;
i:=i+2;
end;
end;
n:=length(s);
Memo2.Lines[ir]:='';
for i:=1 to n do
if s[i]<>'I' then
Memo2.Lines[ir]:=Memo2.Lines[ir]+s[i];
end;
s:=Memo2.Text;
Memo2.Text:=Memo3.Text;
Memo3.Text:=s;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i,j:byte;
begin
Memo1.Text:='';
Memo2.Text:='';
Memo3.Text:='';
//Заполняем матрицу размером 5 на 5
for i := 0 to 4 do
for j := 0 to 4 do
StringGrid1.Cells[i,j]:=A[i+1,j+1];
end;
end.
|
Lab_1.rar 491,46 Kb |
Шифр Плейфера 
Загрузка ...
