Advertisement
MadCortez

Untitled

Mar 27th, 2021
452
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 7.64 KB | None | 0 0
  1. unit Main;
  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.Menus, Vcl.StdCtrls, Vcl.Grids;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     FileButton: TMenuItem;
  13.     AboutButton: TMenuItem;
  14.     ReadButton: TMenuItem;
  15.     SaveButton: TMenuItem;
  16.     OpenDialog1: TOpenDialog;
  17.     SaveDialog1: TSaveDialog;
  18.     Start: TButton;
  19.     NEdit: TEdit;
  20.     MEdit: TEdit;
  21.     NLabel: TLabel;
  22.     MLabel: TLabel;
  23.     procedure AboutButtonClick(Sender: TObject);
  24.     procedure OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  25.     procedure SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  26.     procedure EditChange(Sender: TObject);
  27.     procedure ReadButtonClick(Sender: TObject);
  28.     procedure SaveButtonClick(Sender: TObject);
  29.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  30.     procedure EditKeyPress(Sender: TObject; var Key: Char);
  31.     procedure StartClick(Sender: TObject);
  32.   private
  33.     { Private declarations }
  34.   public
  35.     { Public declarations }
  36.   end;
  37.  
  38.    PLinkedList = ^TLinkedList;
  39.    TLinkedList = record
  40.     Data : Integer;
  41.     Next : PLinkedList;
  42.    end;
  43.  
  44. var
  45.   Form1: TForm1;
  46.   N, M, Size: Integer;
  47.   AList, Head: PLinkedList;
  48.   Ans: String;
  49. const
  50.    MIN_SIZE = 1;
  51.    MAX_SIZE = 20;
  52. {$R *.dfm}
  53.  
  54. implementation
  55.  
  56. procedure TForm1.EditChange(Sender: TObject);
  57. var
  58.    IsValid1, IsValid2: Boolean;
  59.    i: Integer;
  60. begin
  61.    IsValid1 := False;
  62.    IsValid2 := False;
  63.    SaveButton.Enabled := False;
  64.    if NEdit.Text <> '' then
  65.       IsValid1 := True;
  66.    if MEdit.Text <> '' then
  67.       IsValid2 := True;
  68.    if (IsValid1) and (IsValid2) then
  69.       Start.Enabled := True
  70.    else
  71.       Start.Enabled := False;
  72. end;
  73.  
  74. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  75. begin
  76.    CanClose := MessageDlg('Вы уверены, что хотите выйти из программы?' +
  77.       #10#13 + 'Все несохраненные данные будут утеряны.',
  78.       mtConfirmation, [mbYes, mbNo], 0) = mrYes;
  79. end;
  80.  
  81. procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char);
  82. const
  83.    Digit: set of Char = ['0'..'9', #8];
  84. begin
  85.    with (Sender as TEdit) do
  86.    begin
  87.       if not(Key in Digit) then
  88.          Key := #0;
  89.    end;
  90.    SaveButton.Enabled := False;
  91. end;
  92.  
  93. procedure TForm1.AboutButtonClick(Sender: TObject);
  94. var
  95.    Task: String;
  96. begin
  97.    Task := 'N ребят встали в круг. Каждый раз, начиная с первого, из круга выводится каждый M-й. '
  98.       + 'Вывести номера в порядке выбывания и номер последнего оставшегося.' + #10#13;
  99.    Task := Task + 'Автор - Пестунов Илья, гр. 051007';
  100.    MessageDlg(Task, mtInformation, [mbOK], 0);
  101. end;
  102.  
  103. procedure TForm1.ReadButtonClick(Sender: TObject);
  104. var
  105.    MyFile: TextFile;
  106.    i, Value, j: Integer;
  107. begin
  108.    MEdit.Text := '';
  109.    NEdit.Text := '';
  110.    Start.Enabled := False;
  111.    if OpenDialog1.Execute then
  112.    begin
  113.       AssignFile(MyFile, OpenDialog1.FileName);
  114.       Reset(MyFile);
  115.       Read(MyFile, N, M);
  116.       NEdit.Text := IntToStr(N);
  117.       MEdit.Text := IntToStr(M);
  118.       CloseFile(MyFile);
  119.       Start.Enabled := True;
  120.    end;
  121. end;
  122.  
  123. procedure TForm1.SaveButtonClick(Sender: TObject);
  124. var
  125.    MyFile: TextFile;
  126.    i, j: Integer;
  127. begin
  128.    if SaveDialog1.Execute then
  129.    begin
  130.       AssignFile(MyFile, SaveDialog1.FileName);
  131.       Rewrite(MyFile);
  132.       Writeln(MyFile, Ans);
  133.       CloseFile(MyFile);
  134.       MessageDlg('Результат успешно сохранён', mtCustom, [mbOK], 0);
  135.    end;
  136. end;
  137.  
  138. procedure TForm1.OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  139. var
  140.    IsValid: Boolean;
  141.    N, i, Value, Err, j: Integer;
  142.    MyFile: TextFile;
  143.    Check: String;
  144. const
  145.    Digit: set of Char = ['1'..'9', '0', ' ', '-'];
  146. begin
  147.    IsValid := True;
  148.    N := Length(OpenDialog1.FileName);
  149.    if (OpenDialog1.FileName[N] = 't') and (OpenDialog1.FileName[N - 1] = 'x')
  150.    and (OpenDialog1.FileName[N - 2] = 't') then
  151.    begin
  152.       AssignFile(MyFile, OpenDialog1.FileName);
  153.       Reset(MyFile);
  154.       Read(MyFile, Check);
  155.       CloseFile(MyFile);
  156.       if Length(Check) = 0 then
  157.       begin
  158.          MessageDlg('Файл пуст', mtWarning, [mbOK], 0);
  159.          IsValid := False;
  160.       end
  161.       else
  162.       begin
  163.          AssignFile(MyFile, OpenDialog1.FileName);
  164.          Reset(MyFile);
  165.          try
  166.             Readln(MyFile, N, M);
  167.          except
  168.             IsValid := False;
  169.             MessageDlg('Числа N и M должно быть натуральным от 1 до 20', mtWarning, [mbOK], 0);
  170.          end;
  171.          if ((IsValid) and (N < MIN_SIZE)) or ((IsValid) and (N > MAX_SIZE))
  172.          or ((IsValid) and (M < MIN_SIZE)) or ((IsValid) and (M > MAX_SIZE)) then
  173.          begin
  174.             IsValid := False;
  175.             MessageDlg('Числа N и M должно быть натуральным от 1 до 20', mtError, [mbOK], 0);
  176.          end;
  177.          CloseFile(MyFile);
  178.       end;
  179.    end
  180.    else
  181.    begin
  182.       MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
  183.       IsValid := False;
  184.    end;
  185.    if not(IsValid) then
  186.       CanClose := False;
  187. end;
  188.  
  189. procedure TForm1.SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
  190. var
  191.    N: Integer;
  192. begin
  193.    N := Length(SaveDialog1.FileName);
  194.    if (SaveDialog1.FileName[N] = 't') and (SaveDialog1.FileName[N - 1] = 'x')
  195.    and (SaveDialog1.FileName[N - 2] = 't') then
  196.       CanClose := True
  197.    else
  198.    begin
  199.       CanClose := False;
  200.       MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
  201.    end;
  202. end;
  203.  
  204. procedure Add(Info: Integer);
  205. var
  206.    AddList: PLinkedList;
  207. begin
  208.    New(AddList);
  209.    AddList.Data := Info;
  210.    AddList.Next := nil;
  211.    if Head = nil then
  212.    begin
  213.       Head := AddList;
  214.       AList := AddList;
  215.    end
  216.    else
  217.    begin
  218.       AList := Head;
  219.       while not (AList.Next = nil) do
  220.          AList := AList.Next;
  221.       AList.Next := AddList;
  222.    end;
  223.    AList := Head;
  224. end;
  225.  
  226. procedure DeleteList(List: PLinkedList);
  227. var
  228.    Temp: PLinkedList;
  229. begin
  230.    Temp := Head;
  231.    while not (Temp.Next = AList) do
  232.       Temp := Temp.Next;
  233.    Temp.Next := Temp.Next.Next;
  234.    Head := Temp.Next;
  235.    AList := Head;
  236. end;
  237.  
  238. procedure CreateList(N: Integer);
  239. var
  240.    i: Integer;
  241. begin
  242.    for i := 0 to N - 1 do
  243.       Add(i + 1);
  244.    while not (AList.Next = nil) do
  245.       AList := AList.Next;
  246.    AList.Next := Head;
  247.    AList := Head;
  248. end;
  249.  
  250. procedure TForm1.StartClick(Sender: TObject);
  251. var
  252.    Err, i, Now: Integer;
  253.    Temp: PLinkedList;
  254. begin
  255.    Head := nil;
  256.    Val(NEdit.Text, N, Err);
  257.    Val(MEdit.Text, M, Err);
  258.    if (N < MIN_SIZE) or (N > MAX_SIZE) or (M < MIN_SIZE) or (M > MAX_SIZE) then
  259.       MessageDlg('Введите N и M в указанном диапазоне', mtError, [mbOK], 0)
  260.    else
  261.    begin
  262.       CreateList(N);
  263.       Now := 0;
  264.       Ans := 'Номера в порядке выбывания: ' + #10#13;
  265.       while N > 1 do
  266.       begin
  267.          Inc(Now);
  268.          if Now = M then
  269.          begin
  270.             Ans := Ans + IntToStr(AList.Data) + ' ';
  271.             DeleteList(AList);
  272.             Now := 0;
  273.             Dec(N);
  274.          end
  275.          else
  276.             AList := AList.Next;
  277.       end;
  278.       Ans := Ans + #10#13 + 'Номер последнего оставшегося: ' + IntToStr(AList.Data);
  279.       ShowMessage(Ans);
  280.       SaveButton.Enabled := True;
  281.    end;
  282. end;
  283.  
  284. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement