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

Кодирование по спирали Автор: ___Nikolay

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. + sgMatrix. + sgMatrix.CellRect(c, r). + 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. + sgMatrix. + sgMatrix.CellRect(c, r). + 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. + sgMatrix. + sgMatrix.CellRect(c, r). + 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. + sgMatrix. + sgMatrix.CellRect(c, r). + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
  SetCursorPos(x, y);
  sgMatrix.Repaint;
  Sleep(30);
  end;
  end;
 end;
 Result := sResult;
 SetCursorPos(pCursor.x, pCursor.y);
end;
end.
DelphiWorld 6.0

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...