Advertisement
Vladislav8653

delphi 5.3

Apr 15th, 2023
161
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 10.16 KB | None | 0 0
  1. unit Unit1;
  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.StdCtrls, Vcl.Grids, Vcl.Menus, System.Math;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Edit1: TEdit;
  12.     Edit2: TEdit;
  13.     StringGrid1: TStringGrid;
  14.     Label1: TLabel;
  15.     Label2: TLabel;
  16.     Label3: TLabel;
  17.     Label4: TLabel;
  18.     Button1: TButton;
  19.     OpenDialog1: TOpenDialog;
  20.     SaveDialog1: TSaveDialog;
  21.     MainMenu1: TMainMenu;
  22.     PopupMenu1: TPopupMenu;
  23.     N1: TMenuItem;
  24.     N2: TMenuItem;
  25.     N3: TMenuItem;
  26.     N5: TMenuItem;
  27.     procedure Edit1Change(Sender: TObject);
  28.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  29.     procedure Button1Click(Sender: TObject);
  30.     procedure Edit2KeyPress(Sender: TObject; var Key: Char);
  31.     procedure Edit2Change(Sender: TObject);
  32.     procedure N5Click(Sender: TObject);
  33.     procedure N2Click(Sender: TObject);
  34.     procedure N3Click(Sender: TObject);
  35.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  36.   private
  37.     { Private declarations }
  38.   public
  39.     { Public declarations }
  40.   end;
  41.  
  42. type
  43.     TArr = Array of Integer;
  44. var
  45.   Form1: TForm1;
  46.   N : Integer;
  47.   Arr : TArr;
  48.   IsCorrect, IsFileOpen : Boolean;
  49.   Path, Result : String;
  50.  
  51. implementation
  52.  
  53. {$R *.dfm}
  54.  
  55. function DeleteRepetitions (Arr : TArr) : TArr;
  56. var
  57.     I, J, Counter : Integer;
  58.     IsRepetitionExist : Boolean;
  59.     ArrWithoutRepeats : TArr;
  60. begin
  61.     SetLength(ArrWithoutRepeats, Length(Arr));
  62.     Counter := 0;
  63.     For I := Low(Arr) To High(Arr) Do
  64.     begin
  65.         IsRepetitionExist := False;
  66.         For J := Low(ArrWithoutRepeats) to High(ArrWithoutRepeats) Do
  67.         Begin
  68.             If Arr[I] = ArrWithoutRepeats[J] then
  69.                 IsRepetitionExist := True;
  70.         End;
  71.         If Not(IsRepetitionExist) then
  72.         Begin
  73.             ArrWithoutRepeats[Counter] := Arr[I];
  74.             Inc(Counter);
  75.         End;
  76.     end;
  77.     SetLength(ArrWithoutRepeats, Counter);
  78.     DeleteRepetitions := ArrWithoutRepeats;
  79. end;
  80.  
  81. procedure TForm1.Button1Click(Sender: TObject);
  82. Const
  83.     WIDE = 82;
  84.     HEIGHT = 35;
  85.     SCROLLBAR = 17;
  86. Var
  87.      I, J, Number, K, Index, Max, LastI: Integer;
  88.      Str, Element: String;
  89.      IsSmthWrong, WillAdd: Boolean;
  90. begin
  91.     If IsCorrect then
  92.     begin
  93.         IsSmthWrong := True;
  94.         SetLength(Arr, N);
  95.         StringGrid1.ColCount := N + 1;
  96.         StringGrid1.Width := WIDE * 6 +  + SCROLLBAR;
  97.         StringGrid1.ScrollBars := ssBoth;
  98.         If N < 6 then
  99.         Begin
  100.             StringGrid1.ScrollBars := ssVertical;
  101.             case N of
  102.                 1: StringGrid1.Width := WIDE * 1;
  103.                 2: StringGrid1.Width := WIDE * 2 + 1;
  104.                 3: StringGrid1.Width := WIDE * 3;
  105.                 4: StringGrid1.Width := WIDE * 4 + SCROLLBAR;
  106.                 5: StringGrid1.Width := WIDE * 5 - 10;
  107.  
  108.             end;
  109.         End;
  110.         For I := 0 to StringGrid1.RowCount - 1 do
  111.             For J := 0 to StringGrid1.ColCount - 1 do
  112.                 StringGrid1.Cells[J, I] := '';
  113.  
  114.         Str := Trim(Edit2.Text);
  115.         Str := Str + ' ';
  116.         I := 1;
  117.         K := 0;
  118.         try
  119.             While (I <> (Length(Str) + 1)) and (IsSmthWrong) Do
  120.             Begin
  121.                 If (Str[I] <> ' ') then
  122.                     Element := Element + Str[I]
  123.                 else
  124.                 Begin
  125.                     Number := StrToInt(Element);
  126.                     try
  127.                         Arr[K] := Number;
  128.                     except
  129.                         IsSmthWrong := False;
  130.                     end;
  131.                     Inc(K);
  132.                     Element := '';
  133.                 End;
  134.                 Inc(I);
  135.                 If ((K) > N) then
  136.                 begin
  137.                     MessageBox(Form1.Handle, Pchar('Вы ввели больше ' + Edit1.Text + ' элементов.'), 'Ошибка', MB_ICONSTOP);
  138.                     IsSmthWrong := False;
  139.                     Edit2.Text := '';
  140.                     StringGrid1.Visible := False;
  141.                 end;
  142.             End;
  143.         except
  144.             Edit2.Text := '';
  145.             IsSmthWrong := False;
  146.             StringGrid1.Visible := False;
  147.             MessageBox(Form1.Handle, Pchar('Проверьте последовательность, там должны быть только положительные цифры.'), 'Ошибка', MB_ICONSTOP);
  148.         end;
  149.  
  150.         If ((K) < N) and IsSmthWrong then
  151.         begin
  152.             MessageBox(Form1.Handle, Pchar('Вы ввели меньше ' + Edit1.Text + ' элементов.'), 'Ошибка', MB_ICONSTOP);
  153.             IsSmthWrong := False;
  154.             Edit2.Text := '';
  155.             StringGrid1.Visible := False;
  156.         end;
  157.  
  158.         If IsSmthWrong then
  159.         Begin
  160.             LastI := 0;
  161.             Arr := DeleteRepetitions(Arr);
  162.             Max := Trunc(Power(2, Length(Arr)));
  163.             For I := 0 To (Max - 1) Do
  164.             Begin
  165.                 WillAdd := False;
  166.                 K := I;
  167.                 J := 0;
  168.                 Index := 0;
  169.                 While (K > 0) Do
  170.                 begin
  171.                     If (K and 1) = 1 then
  172.                     Begin
  173.                         StringGrid1.Cells[J, I - 1] := IntToStr(Arr[Index]);
  174.                         Inc(J);
  175.                         WillAdd := True;
  176.                     End;
  177.                     K := K div 2;
  178.                     Inc(Index);
  179.                 end;
  180.                 If WillAdd then
  181.                     StringGrid1.RowCount := StringGrid1.RowCount + 1;
  182.                 LastI := I;
  183.             End;
  184.             StringGrid1.Cells[0, LastI] := '{ }';
  185.             StringGrid1.Visible := True;
  186.             N3.Enabled := True;
  187.         End;
  188.     end;
  189. end;
  190.  
  191. procedure TForm1.Edit1Change(Sender: TObject);
  192. begin
  193.     IsCorrect := True;
  194.     StringGrid1.Visible := False;
  195.     N3.Enabled := False;
  196.     StringGrid1.RowCount := 1;
  197.     try
  198.         N := StrToInt(Edit1.Text);
  199.     except
  200.         IsCorrect := False;
  201.     end;
  202.     If (Edit1.Text <> '') and (Edit2.Text <> '') then
  203.         Button1.Enabled := True
  204.     else
  205.         Button1.Enabled := False;
  206. end;
  207.  
  208. procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
  209. begin
  210.     If (Key = #13) and (Button1.Enabled) then
  211.         Button1.Click;
  212.     If (Not(Key In ['1'..'9', #08, #46])) Then
  213.         Key := #0;
  214. end;
  215.  
  216. procedure TForm1.Edit2Change(Sender: TObject);
  217. begin
  218.     If (Edit1.Text <> '') and (Edit2.Text <> '') then
  219.         Button1.Enabled := True
  220.     else
  221.         Button1.Enabled := False;
  222.     StringGrid1.RowCount := 1;
  223.     N3.Enabled := False;
  224. end;
  225.  
  226. procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
  227. begin
  228.     If (Key = #13) and (Button1.Enabled) then
  229.         Button1.Click;
  230.     If (Not(Key In ['0'..'9', #08, #46, #32])) Then
  231.         Key := #0;
  232. end;
  233.  
  234. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  235. begin
  236.     CanClose := Application.MessageBox('Вы действительно хотите выйти?', 'Выход', MB_YESNO + MB_ICONQUESTION) = ID_YES;
  237. end;
  238.  
  239. procedure TForm1.N5Click(Sender: TObject);
  240. begin
  241.     Application.MessageBox('Арефин Владислав гр.251004', 'Разрабочик', 0);
  242. end;
  243.  
  244. Function CheckFileData(Num: String): Boolean;
  245. Const
  246.     MAX_LIM = 9;
  247.     MIN_LIM = 1;
  248. Var
  249.     NewNum: Integer;
  250.     IsCorrect: Boolean;
  251. Begin
  252.     NewNum := 0;
  253.     IsCorrect := True;
  254.     Try
  255.         NewNum := StrToInt(Num);
  256.     Except
  257.         MessageBox(Form1.Handle, Pchar('Проверьте корректность данных.'), 'Ошибка', MB_ICONSTOP);
  258.         IsCorrect := False;
  259.     End;
  260.     If(IsCorrect And ((NewNum > MAX_LIM) Or (NewNum < MIN_LIM))) Then
  261.     Begin
  262.         Num := IntToStr(NewNum);
  263.         MessageBox(Form1.Handle, Pchar('Недопустимое значение!'), 'Ошибка', MB_ICONSTOP);
  264.         IsCorrect := False;
  265.     End;
  266.     CheckFileData := IsCorrect;
  267. End;
  268.  
  269. Function Open (): String;
  270. Begin
  271.     With Form1 Do
  272.     Begin
  273.         If OpenDialog1.Execute Then
  274.         Begin
  275.             Path := OpenDialog1.FileName;
  276.             IsFileOpen := True;
  277.         End
  278.         Else
  279.             IsFileOpen := False;
  280.     End;
  281.     Open := Path;
  282. End;
  283.  
  284. Function TakeDataFromFile( Var FileOutput: TextFile): String;
  285. Var
  286.     IsRight : Boolean;
  287.     Str : String;
  288. Begin
  289.     IsRight := True;
  290.     Try
  291.         Readln(FileOutput, Str);
  292.         IsRight := CheckFileData(Str);
  293.     Except
  294.     End;
  295.     If(Not(IsRight)) Then
  296.         TakeDataFromFile := ''
  297.     Else
  298.         TakeDataFromFile := Str;
  299. End;
  300.  
  301. Function Take2FromFile(Var FileOutput: TextFile): String;
  302. Var
  303.     IsRight : Boolean;
  304.     Str : String;
  305. Begin
  306.     IsRight := True;
  307.     Try
  308.         Readln(FileOutput, Str);
  309.     Except
  310.         IsRight := False;
  311.     End;
  312.      If(Not(IsRight)) Then
  313.         Take2FromFile := ''
  314.     Else
  315.         Take2FromFile := Str;
  316.  
  317. End;
  318.  
  319. procedure TForm1.N2Click(Sender: TObject);
  320. Var
  321.     FileInput: TextFile;
  322.     Str1, Str2: String;
  323. begin
  324.     Path := Open;
  325.     AssignFile(FileInput, Path);
  326.     AssignFile(FileInput, Path);
  327.     If ExtractFileExt(Path) <> '.txt' then
  328.         raise Exception.Create('Файл должен быть текстовым. Проверьте исходные данные.');
  329.     Reset(FileInput);
  330.     If(IsFileOpen) Then
  331.     Begin
  332.         Str1 := TakeDataFromFile(FileInput);
  333.         Str2 := Take2FromFile(FileInput);
  334.     End;
  335.     if (Length(Str1) > 0) then
  336.     Begin
  337.         Edit1.Text := Str1;
  338.     End
  339.     Else
  340.         Edit1.Text := #0;
  341.     if (Length(Str2) > 0) and ((Length(Str1) > 0))then
  342.     Begin
  343.         Edit2.Text := Str2;
  344.     End
  345.     Else
  346.         Edit2.Text := #0;
  347.     CloseFile(FileInput);
  348. end;
  349.  
  350. procedure TForm1.N3Click(Sender: TObject);
  351. Var
  352.     FileOutput: TextFile;
  353. begin
  354.     Path := Open;
  355.     If (IsFileOpen) Then
  356.     Begin
  357.         AssignFile(FileOutput, Path);
  358.         Rewrite(FileOutput);
  359.         Write(FileOutput, Result);
  360.         Application.MessageBox('Запись файла выполнена успешно.', 'Результат', 0);
  361.         CloseFile(FileOutput);
  362.     End;
  363. end;
  364.  
  365. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement