Кодирование по спирали

unit uMain;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Grids, StdCtrls, Buttons, ExtCtrls;
type
 TfmMain = class(TForm)
 sgMatrix: TStringGrid;
 edEncode: TEdit;
 edDecode: TEdit;
 btEncode: TSpeedButton;
 btDecode: TSpeedButton;
 Label1: TLabel;
 chAnimation: TCheckBox;
 procedure btEncodeClick(Sender: TObject);
 procedure btDecodeClick(Sender: TObject);
 private
 { Private declarations }
 // Очистить матрицу
 procedure ClearMatrix;
 // Записываем в матрицу
 procedure WriteToMatrix(s: string; bSpiralWriteMode: Boolean);
 // Считываем из матрицы
 function ReadFromMatrix(bSpiralWriteMode: Boolean): string;
 public
 { Public declarations }
 end;
var
 fmMain: TfmMain;
implementation
{$R *.DFM}
// Записываем в матрицу
procedure TfmMain.WriteToMatrix(s: string; bSpiralWriteMode: Boolean);
var
 c, r, i, iWriteSymbols, iStep, iDirection, iIncStep, iHalfCell, x, y: Integer;
 pCursor: TPoint;
begin
 sgMatrix.Selection := TGridRect(Rect(-1, -1, -1, -1));
 GetCursorPos(pCursor);
 // Половина ширины ячейки
 iHalfCell := sgMatrix.DefaultColWidth div 2;
 // Символы в матрицу вносим по спирали, начиная с центра
 if bSpiralWriteMode then
 begin
 c := 5; // Индекс колонки
 r := 5; // Индекс строки
 iWriteSymbols := 0; // Кол-во вписанных символов
 iStep := 1;
 // Шаг - кол-во вписываемых символов в одном направлении
 iDirection := 0;
 // Направление: 1 - вверх, 2 - вправо, 3 - вниз, 4 - влево
 iIncStep := -1; // Дельта шага
 for i := 1 to Length(s) do
 begin
 sgMatrix.Cells[c, r] := s[i];
 // Визуализировать
 if chAnimation.Checked then
 begin
 Application.ProcessMessages;
 x := fmMain.Left + sgMatrix.Left + sgMatrix.CellRect(c, r).Left + iHalfCell;
 y := fmMain.Top + sgMatrix.Top + sgMatrix.CellRect(c, r).Top +
 iHalfCell + GetSystemMetrics(SM_CYCAPTION);
 SetCursorPos(x, y);
 sgMatrix.Repaint;
 Sleep(30);
 end;
 Inc(iWriteSymbols);
 { Если кол-во символов, которые нужно вписывать в одном
 направлении, достигло предела - тогда нужно поворачивать }
 if iWriteSymbols = iStep then
 begin
 // Определим следующее направление
 Inc(iDirection);
 if iDirection = 5 then
 iDirection := 1;
 iWriteSymbols := 0;
 Inc(iIncStep);
 if iIncStep = 2 then
 begin
 Inc(iStep);
 iIncStep := 0;
 end;
 end;
 // Определим следующую клетку для записи
 case iDirection of
 1: Dec(r);
 2: Inc(c);
 3: Inc(r);
 4: Dec(c);
 end;
 end; // Вносим по спирали
 end
 else // Вносим по строкам
 begin
 i := 1;
 for r := 0 to sgMatrix.RowCount - 1 do
 for c := 0 to sgMatrix.ColCount - 1 do
 begin
 sgMatrix.Cells[c, r] := s[i];
 Inc(i);
 // Визуализировать
 if chAnimation.Checked then
 begin
 Application.ProcessMessages;
 x := fmMain.Left + sgMatrix.Left + sgMatrix.CellRect(c, r).Left + iHalfCell;
 y := fmMain.Top + sgMatrix.Top + sgMatrix.CellRect(c, r).Top +
 iHalfCell + GetSystemMetrics(SM_CYCAPTION);
 SetCursorPos(x, y);
 sgMatrix.Repaint;
 Sleep(30);
 end;
 end;
 end;
 SetCursorPos(pCursor.x, pCursor.y);
end;
procedure TfmMain.btEncodeClick(Sender: TObject);
const
 sMsgLengthCheck = 'Длина текста должна быть равна 121';
var
 s: string;
begin
 s := Trim(edEncode.Text);
 if Length(s) <> 121 then
 begin
 MessageDlg(sMsgLengthCheck, mtInformation, [mbOK], 0);
 Exit;
 end;
 edDecode.Text := ;
 ClearMatrix;
 WriteToMatrix(s, True);
 edDecode.Text := ReadFromMatrix(False);
end;
procedure TfmMain.btDecodeClick(Sender: TObject);
const
 sMsgLengthCheck = 'Длина текста должна быть равна 121';
var
 s: string;
begin
 s := Trim(edDecode.Text);
 if Length(s) <> 121 then
 begin
 MessageDlg(sMsgLengthCheck, mtInformation, [mbOK], 0);
 Exit;
 end;
 edEncode.Text := ;
 ClearMatrix;
 WriteToMatrix(s, False);
 edEncode.Text := ReadFromMatrix(True);
end;
// Очистит матрицу
procedure TfmMain.ClearMatrix;
var
 r, c: Integer;
begin
 for r := 0 to sgMatrix.RowCount - 1 do
 for c := 0 to sgMatrix.ColCount - 1 do
 sgMatrix.Cells[c, r] := ;
end;
// Считываем из матрицы
function TfmMain.ReadFromMatrix(bSpiralWriteMode: Boolean): string;
var
 c, r, i, iWriteSymbols, iStep, iDirection, iIncStep, x, y, iHalfCell: Integer;
 pCursor: TPoint;
 sResult: string;
begin
 sgMatrix.Selection := TGridRect(Rect(-1, -1, -1, -1));
 GetCursorPos(pCursor);
 sResult := ;
 iHalfCell := sgMatrix.DefaultColWidth div 2;
 // Половина ширины ячейки
 if bSpiralWriteMode then
 begin
 c := 5; // Индекс колонки
 r := 5; // Индекс строки
 iWriteSymbols := 0; // Кол-во вписанных символов
 iStep := 1;
 // Шаг - кол-во вписываемых символов в одном направлении
 iDirection := 0;
 // Направление: 1 - вверх, 2 - вправо, 3 - вниз, 4 - влево
 iIncStep := -1; // Дельта шага
 sResult := ;
 // Символы из матрицы считываем по спирали, начиная с центра
 for i := 1 to 121 do
 begin
 sResult := sResult + sgMatrix.Cells[c, r];
 sgMatrix.Cells[c, r] := ;
 // Визуализировать
 if chAnimation.Checked then
 begin
 Application.ProcessMessages;
 x := fmMain.Left + sgMatrix.Left + sgMatrix.CellRect(c, r).Left + iHalfCell;
 y := fmMain.Top + sgMatrix.Top + sgMatrix.CellRect(c, r).Top +
 iHalfCell + GetSystemMetrics(SM_CYCAPTION);
 SetCursorPos(x, y);
 sgMatrix.Repaint;
 Sleep(30);
 end;
 Inc(iWriteSymbols);
 { Если кол-во символов, которые нужно считать в одном
 направлении, достигло предела - тогда нужно поворачивать }
 if iWriteSymbols = iStep then
 begin
 // Определим следующее направление
 Inc(iDirection);
 if iDirection = 5 then
 iDirection := 1;
 iWriteSymbols := 0;
 Inc(iIncStep);
 if iIncStep = 2 then
 begin
 Inc(iStep);
 iIncStep := 0;
 end;
 end;
 // Определим следующую клетку считывания
 case iDirection of
 1: Dec(r);
 2: Inc(c);
 3: Inc(r);
 4: Dec(c);
 end;
 end;
 end
 else // Считываем по строкам
 begin
 for r := 0 to sgMatrix.RowCount - 1 do
 for c := 0 to sgMatrix.ColCount - 1 do
 begin
 sResult := sResult + sgMatrix.Cells[c, r];
 sgMatrix.Cells[c, r] := ;
 // Визуализировать
 if chAnimation.Checked then
 begin
 Application.ProcessMessages;
 x := fmMain.Left + sgMatrix.Left + sgMatrix.CellRect(c, r).Left + iHalfCell;
 y := fmMain.Top + sgMatrix.Top + sgMatrix.CellRect(c, r).Top +
 iHalfCell + GetSystemMetrics(SM_CYCAPTION);
 SetCursorPos(x, y);
 sgMatrix.Repaint;
 Sleep(30);
 end;
 end;
 end;
 Result := sResult;
 SetCursorPos(pCursor.x, pCursor.y);
end;
end.
Author: ___Nikolay
Source: http://delphiworld.narod.ru/
ID: 04012
Category:Алгоритмы
Category:Шифрование