Advertisement
Guest User

Untitled

a guest
Mar 17th, 2018
84
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 3.83 KB | None | 0 0
  1. unit F_LAB_5_2;
  2.  
  3. interface
  4.  
  5. uses
  6.    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  7.    System.Classes, Vcl.Graphics,
  8.    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, MyUtils,
  9.    ClipBrd, Vcl.Menus, AboutDev;
  10.  
  11. type
  12.    T2DArray = array of array of Integer;
  13.  
  14.    TForm1 = class(TForm)
  15.       sgA: TStringGrid;
  16.       edtN: TEdit;
  17.       btnBuild: TButton;
  18.       btnClear: TButton;
  19.       MainMenu1: TMainMenu;
  20.       N4: TMenuItem;
  21.       N5: TMenuItem;
  22.       N6: TMenuItem;
  23.       procedure edtNKeyPress(Sender: TObject; var Key: Char);
  24.       procedure btnBuildClick(Sender: TObject);
  25.       procedure FormCreate(Sender: TObject);
  26.       procedure btnClearClick(Sender: TObject);
  27.       procedure N5Click(Sender: TObject);
  28.       procedure N6Click(Sender: TObject);
  29.    private
  30.       { Private declarations }
  31.    public
  32.       { Public declarations }
  33.    end;
  34.  
  35. var
  36.    Form1: TForm1;
  37.  
  38. const
  39.    MAX_GRID_RANK = 12;
  40.  
  41. implementation
  42.  
  43. {$R *.dfm}
  44.  
  45. procedure TForm1.btnBuildClick(Sender: TObject);
  46. var
  47.    N, i, j, p, Temp: Integer;
  48.    A: T2DArray;
  49.    S: String;
  50. begin
  51.    try
  52.       N := StrToInt(edtN.Text);
  53.       if not(N mod 4 = 0) then
  54.          MessageBox(0, PChar('Квадрат должен быть четного порядка!'),
  55.            'Warning!', MB_OK + MB_ICONERROR)
  56.       else
  57.       begin
  58.          SetLength(A, N, N);
  59.          sgA.ColCount := N;
  60.          sgA.RowCount := N;
  61.          CorrectStringGridView(sgA, MAX_GRID_RANK, MAX_GRID_RANK);
  62.          for i := 0 to N - 1 do
  63.             for j := 0 to N - 1 do
  64.             begin
  65.                A[i, j] := i * N + j + 1;
  66.             end;
  67.          for i := 0 to N div 4 - 1 do
  68.             for j := 0 to N div 4 - 1 do
  69.             begin
  70.                for p := 0 to 1 do
  71.                begin
  72.                   Temp := A[i * 4 + p, j * 4 + p];
  73.                   A[i * 4 + p, j * 4 + p] :=
  74.                     A[N - (i * 4 + p) - 1, N - (j * 4 + p) - 1];
  75.                   A[N - (i * 4 + p) - 1, N - (j * 4 + p) - 1] := Temp;
  76.                   Temp := A[i * 4 + p, j * 4 + 3 - p];
  77.                   A[i * 4 + p, j * 4 + 3 - p] :=
  78.                     A[N - (i * 4 + p) - 1, N - (j * 4 + 3 - p) - 1];
  79.                   A[N - (i * 4 + p) - 1, N - (j * 4 + 3 - p) - 1] := Temp;
  80.                end;
  81.             end;
  82.          for i := 0 to N - 1 do
  83.          begin
  84.             for j := 0 to N - 1 do
  85.             begin
  86.                sgA.Cells[j, i] := IntToStr(A[i, j]);
  87.                S := S + sgA.Cells[j, i] + #9;
  88.             end;
  89.             S := S + #13;
  90.          end;
  91.          Clipboard.AsText := S;
  92.       end;
  93.    except
  94.       MessageBox(0, PChar('Некорректные данные в поле ввода.'), 'Warning!',
  95.         MB_OK + MB_ICONERROR);
  96.       btnClear.Click;
  97.  
  98.    end;
  99. end;
  100.  
  101. procedure TForm1.btnClearClick(Sender: TObject);
  102. begin
  103.    edtN.Text := '';
  104.    sgA.ColCount := 0;
  105.    sgA.RowCount := 0;
  106.    sgA.Cells[0, 0] := '';
  107. end;
  108.  
  109. procedure TForm1.edtNKeyPress(Sender: TObject; var Key: Char);
  110. begin
  111.    CorrectNaturalInput(edtN, Key);
  112.    sgA.ColCount := 0;
  113.    sgA.RowCount := 0;
  114.    sgA.Cells[0, 0] := '';
  115.    CorrectStringGridView(sgA, MAX_GRID_RANK, MAX_GRID_RANK);
  116. end;
  117.  
  118. procedure TForm1.FormCreate(Sender: TObject);
  119. begin
  120.    CorrectStringGridView(sgA, MAX_GRID_RANK, MAX_GRID_RANK);
  121. end;
  122.  
  123. procedure TForm1.N5Click(Sender: TObject);
  124. begin
  125.    MessageBox(0, PChar('Задача:' + #13#13 +
  126.      'Построение магического квадрата четно-четного порядка (4×4, 8×8, 12×12 и т.д.) методом Рауз-Болла.'
  127.      + #10#13 + 'Ответ доролнительно копируется в буфер обмена'),
  128.      PChar('О программе'), MB_OK);
  129. end;
  130.  
  131. procedure TForm1.N6Click(Sender: TObject);
  132. begin
  133.    AboutMe.Show;
  134. end;
  135.  
  136. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement