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

Материал из DRKB



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