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

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.