SHARE
TWEET

Untitled

a guest Jan 24th, 2020 101 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit Unit2;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls, Vcl.Menus, Math;
  8.  
  9. type
  10.   TAleksey = class(TForm)
  11.     TaskMemo: TMemo;
  12.     MainMenu: TMainMenu;
  13.     FileMenu: TMenuItem;
  14.     OpenMenu: TMenuItem;
  15.     SaveFile: TMenuItem;
  16.     InformationMenu: TMenuItem;
  17.     TaskMenu: TMenuItem;
  18.     AboutMeMenu: TMenuItem;
  19.     InputNumOfPoint: TEdit;
  20.     Label1: TLabel;
  21.     NumButton: TButton;
  22.     InputPoint: TStringGrid;
  23.     ResultButton: TButton;
  24.     Label2: TLabel;
  25.     AnswerLabel: TLabel;
  26.     StaticTextX: TStaticText;
  27.     StaticTextY: TStaticText;
  28.     SaveFileDialog: TSaveDialog;
  29.     OpenFile: TOpenDialog;
  30.     procedure TaskMenuClick(Sender: TObject);
  31.     procedure AboutMeMenuClick(Sender: TObject);
  32.     procedure ConfirmExit(Sender: TObject; var CanClose: Boolean);
  33.     procedure InputKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  34.     procedure InputKeyPress(Sender: TObject; var Key: Char);
  35.     procedure InputChange(Sender: TObject);
  36.     procedure InputKeyPressArray(Sender: TObject; var Key: Char);
  37.     procedure NumButtonClick(Sender: TObject);
  38.     procedure ResultButtonClick(Sender: TObject);
  39.     procedure SaveFileClick(Sender: TObject);
  40.     procedure OpenMenuClick(Sender: TObject);
  41.  
  42.  
  43.  
  44.  
  45.   private
  46.     { Private declarations }
  47.   public
  48.     { Public declarations }
  49.   end;
  50.  
  51. var
  52.   Aleksey: TAleksey;
  53.  
  54. implementation
  55.  
  56. {$R *.dfm}
  57.  
  58. Type Point = record
  59.     X,Y: integer;
  60. end;
  61.  
  62. procedure TAleksey.AboutMeMenuClick(Sender: TObject);
  63. begin
  64.     ShowMessage('Данная программа разработана студентом 951007 группы Вышемирским Алексеем Владиславовичем.');
  65. end;
  66.  
  67. procedure TAleksey.TaskMenuClick(Sender: TObject);
  68. begin
  69.     ShowMessage('Вычислить A1 + 2A2 + 3A3 + … + NAN');
  70. end;
  71.  
  72. procedure TAleksey.ConfirmExit(Sender: TObject; var CanClose: Boolean);
  73. begin
  74.     case Application.MessageBox('Вы уверены, что хотите выйти из программы?', 'Выход', MB_YESNO) of ID_YES: ;
  75.     else
  76.         CanClose := False;
  77.     end;
  78. end;
  79.  
  80. procedure TAleksey.InputKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  81. begin
  82.     if (Key = VK_INSERT) then
  83.         Key := 0;
  84. end;
  85.  
  86. procedure TAleksey.InputKeyPress(Sender: TObject; var Key: Char);
  87. begin
  88.     if not (Key in ['0'..'9', #8])then
  89.         Key := #0;
  90. end;
  91.  
  92. procedure TAleksey.InputChange(Sender: TObject);
  93. begin
  94.     if (Sender as TEdit).Text = '00' then
  95.         (Sender as TEdit).Clear
  96. end;
  97.  
  98. procedure TAleksey.InputKeyPressArray(Sender: TObject; var Key: Char);
  99. begin
  100.     if not (Key in ['0'..'9', #8, '-'])then
  101.         Key := #0;
  102. end;
  103.  
  104.  
  105. procedure TAleksey.NumButtonClick(Sender: TObject);
  106. Var
  107.     NCol: integer;
  108. begin
  109.     if ((InputNumOfPoint.Text <> '') and (StrToInt(InputNumOfPoint.Text) < 9) and (StrToInt(InputNumOfPoint.Text) > 2)) then
  110.     Begin
  111.         InputPoint.ColCount := StrToInt(InputNumOfPoint.Text);
  112.         InputPoint.EditorMode := True;
  113.         InputPoint.Options:= InputPoint.Options + [goEditing] + [goTabs];
  114.         for NCol := 0 to InputPoint.ColCount - 1  do
  115.             InputPoint.Cells[NCol, 0] := IntToStr(NCol + 1) + ' точка';
  116.         ResultButton.Enabled := True;
  117.     End
  118.     else
  119.         ShowMessage('Ошибка! Указана недопустимая длина массива.');
  120. end;
  121.  
  122. function getAngle(Point1, Point2, Point3: Point): Double;
  123. var
  124.     Line1, Line2, Line3: Double;
  125. Begin
  126.     Line1 := sqrt((Point2.y - Point1.y) * (Point2.y - Point1.y) +
  127.         (Point2.x - Point1.x) * (Point2.x - Point1.x));
  128.     line2 := sqrt((Point3.y - Point2.y) * (Point3.y - Point2.y) +
  129.         (Point3.x - Point2.x) * (Point3.x - Point2.x));
  130.     line3 := sqrt((Point1.y - Point3.y) * (Point1.y - Point3.y) +
  131.         (Point1.x - Point3.x) * (Point1.x - Point3.x));
  132.     getAngle := Round(radtodeg(ArcCos((sqr(Line1) + sqr(Line2) - sqr(Line3)) / (2 * Line1 * Line2))));
  133. end;
  134.  
  135. function getPoint(point1, point2: integer): Point;
  136. begin
  137.     Result.X := point1;
  138.     Result.Y := point2;
  139. end;
  140.  
  141. procedure TAleksey.ResultButtonClick(Sender: TObject);
  142. Var
  143.     i, Num: Integer;
  144.     PointArr: array of Point;
  145.     AngleArr: array of Real;
  146.     Sum: Real;
  147.     EmptyArray: boolean;
  148. begin
  149.     Num := StrToInt(InputNumOfPoint.Text);
  150.     setLength(PointArr, Num);
  151.     setLength(AngleArr, Num);
  152.     Sum := 0;
  153.     EmptyArray := False;
  154.     for i := 0 to High(PointArr) do
  155.     begin
  156.         if ((InputPoint.Cells[i,1] = '') or (InputPoint.Cells[i,2] = '')) then
  157.         Begin
  158.             EmptyArray := True;
  159.             InputPoint.Cells[i,1] := IntToStr(RandomRange(-20,20));
  160.             InputPoint.Cells[i,2] := IntToStr(RandomRange(-20,20));
  161.         End;
  162.         pointArr[i] := getPoint(strToInt(InputPoint.Cells[i,1]),strToInt(InputPoint.Cells[i,2]));
  163.     end;
  164.     if(EmptyArray) then
  165.         ShowMessage('Таблица содержит пустые поля, они были заменены рандомными  значениями от -20 до 20');
  166.     for i := 0 to High(PointArr) do
  167.         Sum := Sum + getAngle(pointArr[i],
  168.             pointArr[(i + 1) mod Length(PointArr)],
  169.             pointArr[(i + 2) mod Length(PointArr)]);
  170.     if (Sum = 180 * (Num - 2)) then
  171.         AnswerLabel.Caption :=  'Выпуклый'
  172.     else
  173.         AnswerLabel.Caption := 'Не выпуклый';
  174.     SaveFile.Enabled := True;
  175. end;
  176.  
  177. function FileExtensionChek(var NameOfFile: string): Boolean;
  178. var
  179.    Extension: string;
  180.    i, j: Integer;
  181.  
  182. begin
  183.    if(pos('.',NameOfFile) = 0)then
  184.    begin
  185.       ShowMessage('Так как во введённом имени файла не указано расширение, автоматически присвоено расширение ".txt".');
  186.       NameOfFile := NameOfFile + '.txt';
  187.       FileExtensionChek := True;
  188.    end
  189.    else
  190.    begin
  191.       Extension := '';
  192.       j := length(NameOfFile);
  193.       for i := pos('.',NameOfFile) to j do
  194.          Extension := Extension + NameOfFile[i];
  195.       if (Extension <> '.txt') and (Extension <> '.doc') and (Extension <> '.text') then
  196.       begin
  197.          ShowMessage('Внимание, произошла ошибка! Файл с данным расширением не может быть использован. Программа поддерживает расширения : ".txt", ".doc", ".text".');
  198.          FileExtensionChek := False;
  199.       end
  200.       else
  201.          FileExtensionChek := True;
  202.    end;
  203. end;
  204.  
  205. procedure TAleksey.SaveFileClick(Sender: TObject);
  206. var
  207.     FileF: TextFile;
  208.     FileName: string;
  209.     IsInvalidInput: Boolean;
  210. begin
  211.     if SaveFileDialog.Execute then
  212.     begin
  213.         FileName := SaveFileDialog.FileName;
  214.         IsInvalidInput := True;
  215.         IsInvalidInput := FileExtensionChek(FileName);
  216.         if FileExists(FileName) and IsInvalidInput then
  217.         begin
  218.             AssignFile(FileF, SaveFileDialog.FileName);
  219.             Rewrite(FileF);
  220.             Write(FileF,TaskMemo.Text);
  221.             Write(FileF,'Многоугольник: ' + AnswerLabel.Caption);
  222.             CloseFile(FileF);
  223.         end
  224.         else if IsInvalidInput then
  225.             ShowMessage('Ошибка! Данный файл не найден.');
  226.     end;
  227. end;
  228.  
  229. function CheckSize(FileName: string): String;
  230. var
  231.     Error: Boolean;
  232.     Temp, Count: Integer;
  233.     TempFile: TextFile;
  234. begin
  235.     Error := False;
  236.     Count := 0;
  237.     try
  238.         AssignFile(TempFile, FileName);
  239.         Reset(TempFile);
  240.         while (not (EOLn(TempFile))) do
  241.         begin
  242.             Read(TempFile, Temp);
  243.             Inc(Count);
  244.         end;
  245.     except
  246.       Error := True;
  247.     end;
  248.     if Error then
  249.         CheckSize := '0'
  250.     else
  251.         CheckSize := IntToStr(Count);
  252. end;
  253.  
  254. procedure TAleksey.OpenMenuClick(Sender: TObject);
  255. var
  256.     NumbFile: TextFile;
  257.     Temp, I: Integer;
  258.     Error: Boolean;
  259. begin
  260.    Error := False;
  261.    if OpenFile.Execute then
  262.    begin
  263.       try
  264.          InputNumOfPoint.Text := CheckSize(OpenFile.FileName);
  265.          NumButtonClick(Sender);
  266.          AssignFile(NumbFile, OpenFile.FileName);
  267.          Reset(NumbFile);
  268.          if SeekEof(NumbFile) then
  269.             MessageDlg('Похоже, файл пустой. Повторите попытку', mtError, [mbRetry], 0)
  270.          else
  271.          begin
  272.             for I := 0 to StrToInt(InputNumOfPoint.Text) - 1 do
  273.             begin
  274.                Read(NumbFile, Temp);
  275.                InputPoint.Cells[I, 1] := IntToStr(Temp);
  276.             end;
  277.             for I := 0 to StrToInt(InputNumOfPoint.Text) - 1 do
  278.             Begin
  279.                 Read(NumbFile,Temp);
  280.                 InputPoint.Cells[I, 2] := IntToStr(Temp);
  281.             End;
  282.          end;
  283.       except
  284.          Error := True;
  285.       end;
  286.       CloseFile(NumbFile);
  287.    end;
  288.    if (Error)then
  289.    begin
  290.       MessageDlg('Ошибка ввода, повторите попытку', mtError, [mbRetry], 0);
  291.       NumButtonClick(Sender);
  292.    end;
  293. end;
  294.  
  295. 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