Delphi World - Кодирование по спирали
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Кодирование по спирали


Автор: ___Nikolay
WEB-сайт: http://delphiworld.narod.ru

Друг рассказал о случае на своей работе в Канаде:
- У нас тут несколько русских программистов, и пара американцев рядом с нами сидят. Так один американец долго сидел, слушал русских, потом спрашивает - "Why do you call Visual Studio `your bunny`"? (почему вы называете студию "твой кролик" (е банни)

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.
Скачать весь проект
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования