Кодирование с помощью решетки

Кодирование с помощью решетки Автор: ___Nikolay

unit uMain;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Grids, StdCtrls, Gauges, ExtCtrls;
type
 TfmMain = class(TForm)
  sgGrid: TStringGrid;
  Label1: TLabel;
  sgText: TStringGrid;
  Label2: TLabel;
  Label3: TLabel;
  edNormal: TEdit;
  Label4: TLabel;
  edEncoded: TEdit;
  btEncode: TButton;
  btDecode: TButton;
  chAnimation: TCheckBox;
  Timer1: TTimer;
  procedure btEncodeClick(Sender: TObject);
  procedure btDecodeClick(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure Timer1Timer(Sender: TObject);
 private
  { Private declarations }
  procedure SetGrid(iState: integer); // Выставить решетку
  function EncodeStr(s: string): string; // Шифрование строки
  function DecodeStr(s: string): string; // Расшифрование строки
 public
  { Public declarations }
 end;
var
 fmMain: TfmMain;
implementation
{$R *.DFM}
{ TfmMain }
// Выставить решетку
procedure TfmMain.SetGrid(iState: integer);
var
 c, r, iColMin, iColMax, iRowMin, iRowMax: integer;
 x, y, iHalfCell: integer;
 pStart: TPoint;
begin
 Timer1.Enabled := false;
 GetCursorPos(pStart);
 iHalfCell := sgGrid.DefaultColWidth div 2; // Половина ширины ячейки
 case iState of
  1: begin
  iColMin := 5;
  iColMax := 9;
  iRowMin := 0;
  iRowMax := 4;
  end;
  2: begin
  iColMin := 5;
  iColMax := 9;
  iRowMin := 5;
  iRowMax := 9;
  end;
  3: begin
  iColMin := 0;
  iColMax := 4;
  iRowMin := 5;
  iRowMax := 9;
  end;
  4: begin
  iColMin := 0;
  iColMax := 4;
  iRowMin := 0;
  iRowMax := 4;
  end;
 end;
 for c := 0 to sgGrid.ColCount - 1 do
  for r := 0 to sgGrid.RowCount - 1 do
  begin
  if (c >= iColMin) and (c <= iColMax) and (r >= iRowMin) and (r <= iRowMax) then
  sgGrid.Cells[c, r] := '0'
  else
  sgGrid.Cells[c, r] := '1';
  // Визуализировать
  if chAnimation.Checked then
  begin
  Application.ProcessMessages;
  x := fmMain.Left + sgGrid.Left + sgGrid.CellRect(c, r).Left + iHalfCell;
  y := fmMain. + sgGrid. + sgGrid.CellRect(c, r). + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
  SetCursorPos(x, y);
  sgGrid.Repaint;
  Sleep(10);
  end;
  end;
 SetCursorPos(pStart.x, pStart.y);
end;
procedure TfmMain.btEncodeClick(Sender: TObject);
const
 sMsgLengthCheck = 'Длина текста должна быть равна 100';
var
 s: string;
begin
 s := Trim(edNormal.Text);
 if Length(s) <> 100 then
 begin
  MessageDlg(sMsgLengthCheck, mtInformation, [mbOk], 0);
  Exit;
 end;
 edEncoded.Text := '';
 edEncoded.Text := EncodeStr(s);
end;
// Шифрование строки
function TfmMain.EncodeStr(s: string): string;
label
 start;
var
 c, r, i, iGridState: integer;
 sResult: string;
 x, y, iHalfCell: integer;
 pStart: TPoint;
begin
 Timer1.Enabled := false;
 GetCursorPos(pStart);
 iHalfCell := sgGrid.DefaultColWidth div 2; // Половина ширины ячейки
 iGridState := 1;
 SetGrid(iGridState);
 i := 1;
 sResult := '';
 start:
 for r := 0 to sgText.RowCount - 1 do
  for c := 0 to sgText.ColCount - 1 do
  if not boolean(StrToInt(sgGrid.Cells[c, r])) then
  if sgText.Cells[c, r] = '' then
  begin
  sgText.Cells[c, r] := s[i];
  inc(i);
  // Визуализировать
  if chAnimation.Checked then
  begin
  Application.ProcessMessages;
  x := fmMain.Left + sgText.Left + sgText.CellRect(c, r).Left + iHalfCell;
  y := fmMain. + sgText. + sgText.CellRect(c, r). + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
  SetCursorPos(x, y);
  sgText.Repaint;
  Sleep(10);
  end;
  end;
 dec(i);
 if i < 100 then
  if i mod 25 = 0 then
  begin
  inc(iGridState);
  SetGrid(iGridState);
  inc(i);
  goto start;
  end;
 // Считываем по строкам
 for r := 0 to sgText.RowCount - 1 do
  for c := 0 to sgText.ColCount - 1 do
  begin
  sResult := sResult + sgText.Cells[c, r];
  sgText.Cells[c, r] := '';
  // Визуализировать
  if chAnimation.Checked then
  begin
  Application.ProcessMessages;
  x := fmMain.Left + sgText.Left + sgText.CellRect(c, r).Left + iHalfCell;
  y := fmMain. + sgText. + sgText.CellRect(c, r). + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
  SetCursorPos(x, y);
  sgText.Repaint;
  Sleep(10);
  end;
  end;
 Result := sResult;
 SetCursorPos(pStart.x, pStart.y);
end;
procedure TfmMain.btDecodeClick(Sender: TObject);
const
 sMsgLengthCheck = 'Длина текста должна быть равна 100';
var
 s: string;
begin
 s := Trim(edEncoded.Text);
 if Length(s) <> 100 then
 begin
  MessageDlg(sMsgLengthCheck, mtInformation, [mbOk], 0);
  Exit;
 end;
 edNormal.Text := '';
 edNormal.Text := DecodeStr(s);
end;
// Расшифрование строки
function TfmMain.DecodeStr(s: string): string;
label
 start;
var
 c, r, i, iGridState: integer;
 sResult: string;
 x, y, iHalfCell: integer;
 pStart: TPoint;
begin
 Timer1.Enabled := false;
 GetCursorPos(pStart);
 iHalfCell := sgGrid.DefaultColWidth div 2; // Половина ширины ячейки
 iGridState := 1;
 SetGrid(iGridState);
 i := 1;
 sResult := '';
 // Заносим по строкам
 for r := 0 to sgText.RowCount - 1 do
  for c := 0 to sgText.ColCount - 1 do
  begin
  sgText.Cells[c, r] := s[i];
  inc(i);
  // Визуализировать
  if chAnimation.Checked then
  begin
  Application.ProcessMessages;
  x := fmMain.Left + sgText.Left + sgText.CellRect(c, r).Left + iHalfCell;
  y := fmMain. + sgText. + sgText.CellRect(c, r). + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
  SetCursorPos(x, y);
  sgText.Repaint;
  Sleep(10);
  end;
  end;
 i := 1;
 start:
 for r := 0 to sgText.RowCount - 1 do
  for c := 0 to sgText.ColCount - 1 do
  if not boolean(StrToInt(sgGrid.Cells[c, r])) then
  begin
  sResult := sResult + sgText.Cells[c, r];
  sgText.Cells[c, r] := '';
  inc(i);
  // Визуализировать
  if chAnimation.Checked then
  begin
  Application.ProcessMessages;
  x := fmMain.Left + sgText.Left + sgText.CellRect(c, r).Left + iHalfCell;
  y := fmMain. + sgText. + sgText.CellRect(c, r). + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
  SetCursorPos(x, y);
  sgText.Repaint;
  Sleep(10);
  end;
  end;
  dec(i);
 if i < 100 then
  if i mod 25 = 0 then
  begin
  inc(iGridState);
  SetGrid(iGridState);
  inc(i);
  goto start;
  end;
 Result := sResult;
 SetCursorPos(pStart.x, pStart.y);
end;
procedure TfmMain.FormCreate(Sender: TObject);
begin
 Timer1.Enabled := true;
end;
procedure TfmMain.Timer1Timer(Sender: TObject);
begin
 SetGrid(1);
end;
end.
DelphiWorld 6.0

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

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