SHARE
TWEET

Untitled

a guest Sep 21st, 2019 83 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit LevonKurs;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, Grids, Buttons, Menus;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     StringGrid1: TStringGrid;
  12.     Edit1: TEdit;
  13.     Button1: TButton;
  14.     Button2: TButton;
  15.     StringGrid2: TStringGrid;
  16.     Button3: TButton;
  17.     BitBtn1: TBitBtn;
  18.     Label1: TLabel;
  19.     MainMenu1: TMainMenu;
  20.     N1: TMenuItem;
  21.     N2: TMenuItem;
  22.     N3: TMenuItem;
  23.     N4: TMenuItem;
  24.     procedure Button1Click(Sender: TObject);
  25.     procedure Button2Click(Sender: TObject);
  26.     procedure Button3Click(Sender: TObject);
  27.     procedure StringGrid1DrawCell(Sender: TObject;
  28.     ACol, ARow: Integer; Rect: TRect;
  29.     State: TGridDrawState);
  30.     procedure StringGrid2DrawCell(Sender: TObject;
  31.     ACol, ARow: Integer; Rect: TRect;
  32.     State: TGridDrawState);
  33.     procedure N3Click(Sender: TObject);
  34.     procedure N2Click(Sender: TObject);
  35.    
  36.  
  37.   private
  38.     { Private declarations }
  39.  
  40.   public
  41.     { Public declarations }
  42.   end;
  43.    type Tmatr=array [1..50] of array [1..50] of real;
  44. var
  45.   Form1: TForm1;
  46.   n,c:integer;
  47.   matr:Tmatr;
  48.   MaxCol, MaxRow : integer;
  49. implementation
  50.  
  51. uses Unit2;
  52.  
  53. {$R *.dfm}
  54.   function findmax(var Matr: TMatr; var row, col: integer): real;
  55. var i: integer; max: real;
  56. begin
  57. max := Matr[1,1]; row := 1; col := 1;
  58. for i := 1 to n do
  59.   begin
  60.    //на главной диагонали
  61.     if Matr[i, i] > max then
  62.        begin
  63.          max := Matr[i, i];
  64.          row := i;
  65.          col := i
  66.         end;
  67.    //на побочной диагонали
  68.     if Matr[i, n-i+1] > max then
  69.         begin
  70.           max := Matr[i, n-i+1];
  71.           row := i;
  72.           col := n-i+1
  73.          end;
  74.   end;
  75. findmax := max;
  76. end;
  77.  
  78.  
  79.   //создание и вывод матрицы на экран
  80. procedure TForm1.Button1Click(Sender: TObject);
  81.   var i,j:integer;
  82. begin
  83. randomize;
  84. repeat
  85. val(Edit1.Text,n,c);
  86. if c<>0 then
  87.  begin
  88.   showmessage('Введите начальные данные!'); //Выводит сообщение если введено что-то по мими чис
  89.   Edit1.Clear;
  90.   Edit1.SetFocus;
  91.   exit;
  92.  end;
  93. if StrToInt(Edit1.Text) > 50 then   //n не должно быть больше 50
  94.  begin
  95.   ShowMessage('Error!:Введите значения в диапозоне от 1 до 50');
  96.   edit1.text:='';
  97.   edit1.Setfocus;
  98.   exit;
  99.  end;
  100. n:=strtoint(edit1.text);
  101. if not odd(n) then  //n должно быть нечетным
  102.  begin
  103.   showmessage('Введено неверное значение. Проверьте введенные данные!');
  104.   edit1.text:=''; //Выводит текст если n четная
  105.   edit1.Setfocus;
  106.   exit;
  107.  end;
  108.  
  109.  
  110. until odd(n);
  111. for i:=1  to n do
  112. for j:=1 to n do
  113. Matr[i,j]:=random*198-99;
  114. findmax(matr,MaxRow,MaxCol);
  115. for i:= 1 to n do
  116. for j:=1 to n do
  117. StringGrid1.Cells[j-1+1,i-1+1]:=FloatToStrF(matr[i,j],ffFixed,5,4);
  118.  for i:=1 to n do begin
  119.  StringGrid1.cells[0,0]:='Массив №1';
  120.  StringGrid1.cells[0,i]:=''+inttostr(i);
  121.  StringGrid1.cells[i,0]:=''+inttostr(i);
  122.  StringGrid1.colCount:=n+1;
  123.  StringGrid1.RowCount:=n+1;
  124.  end;
  125.   end;
  126.  
  127.  
  128.  
  129. //обмен элементов и вывод результата на экран
  130. procedure TForm1.Button2Click(Sender: TObject);
  131.  var  buf:real;
  132.      i,j,row,col:integer;
  133. begin
  134.   if not odd(n) then   //n должно быть нечетным
  135.    begin
  136.      showmessage('Введено неверное значение. Проверьте введенные данные!');
  137.      edit1.text:=''; //Выводит текст если n четная
  138.      edit1.Setfocus;
  139.      exit;
  140.    end;
  141. buf := matr[n div 2 + 1, n div 2 + 1];
  142. matr[n div 2 + 1, n div 2 + 1] := findmax(matr,row,col);
  143. matr[row, col] := buf;
  144. for i:= 1 to n do
  145. for j:=1 to n do
  146. StringGrid2.Cells[j-1+1,i-1+1]:=FloatToStrF(matr[i,j],ffFixed,5,4);
  147. for i:=1 to n do begin
  148.  StringGrid2.cells[0,0]:='Массив №2';
  149.  StringGrid2.cells[0,i]:=''+inttostr(i);
  150.  StringGrid2.cells[i,0]:=''+inttostr(i);
  151.  StringGrid2.colCount:=n+1;
  152.  StringGrid2.RowCount:=n+1;
  153. end;
  154.  end;
  155.  
  156. //Окрашивание макс. зн. в первой матрице
  157.    procedure TForm1.StringGrid1DrawCell(Sender: TObject;
  158.   ACol, ARow: Integer; Rect: TRect;
  159.   State: TGridDrawState);
  160. begin
  161.    if (MaxCol =0) or (MaxRow=0) then Exit;
  162.    if ((ACol= MaxCol)and(ARow= MaxRow)) then
  163.   begin
  164.   StringGrid1.Canvas.Brush.Color:=clRed;
  165.   StringGrid1.Canvas.FillRect(Rect);
  166.   StringGrid1.Canvas.TextOut(Rect.Left,Rect.Top,StringGrid1.Cells[Acol,Arow]);
  167.    end;
  168. end;
  169.  
  170.  
  171. //Окрашивание центра второй матрицы
  172.    procedure TForm1.StringGrid2DrawCell(Sender: TObject;
  173.   ACol, ARow: Integer; Rect: TRect;
  174.   State: TGridDrawState);
  175. begin
  176.   if (MaxCol =0) or (MaxRow=0) then Exit;
  177.   if ((ACol= n div 2+1)and(ARow= n div 2+1)) then
  178.   begin
  179.   StringGrid2.Canvas.Brush.Color:=clRed;
  180.   StringGrid2.Canvas.FillRect(Rect);
  181.   StringGrid2.Canvas.TextOut(Rect.Left,Rect.Top,StringGrid2.Cells[Acol,Arow]);
  182.    end;
  183. end;
  184.  
  185. //Очистка данных
  186. procedure TForm1.Button3Click(Sender: TObject);
  187.  var i: integer;
  188. begin
  189.     Edit1.clear;
  190. with StringGrid1  do
  191.   for i:=0 to ColCount-1 do
  192.     Cols[i].Clear;
  193. with StringGrid2  do
  194.   for i:=0 to ColCount-1 do
  195.     Cols[i].Clear;
  196. end;
  197.  
  198.  
  199. procedure TForm1.N3Click(Sender: TObject);
  200. begin
  201. Close;
  202. end;
  203.  
  204. procedure TForm1.N2Click(Sender: TObject);
  205. begin
  206. Form2.Show;
  207. end;
  208.  
  209. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top