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

Previous  Top  Next

    
 

Автор: ___Nikolay

Code:

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.

©Drkb::04012

http://delphiworld.narod.ru/

DelphiWorld 6.0