Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Main;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.Grids;
- type
- TForm1 = class(TForm)
- MainMenu1: TMainMenu;
- FileButton: TMenuItem;
- AboutButton: TMenuItem;
- ReadButton: TMenuItem;
- SaveButton: TMenuItem;
- OpenDialog1: TOpenDialog;
- SaveDialog1: TSaveDialog;
- Start: TButton;
- NEdit: TEdit;
- MEdit: TEdit;
- NLabel: TLabel;
- MLabel: TLabel;
- procedure AboutButtonClick(Sender: TObject);
- procedure OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
- procedure SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
- procedure EditChange(Sender: TObject);
- procedure ReadButtonClick(Sender: TObject);
- procedure SaveButtonClick(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure EditKeyPress(Sender: TObject; var Key: Char);
- procedure StartClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- PLinkedList = ^TLinkedList;
- TLinkedList = record
- Data : Integer;
- Next : PLinkedList;
- end;
- {$R *.dfm}
- var
- Form1: TForm1;
- N, M, Size: Integer;
- AList, Head: PLinkedList;
- Ans: String;
- const
- MIN_SIZE = 1;
- MAX_SIZE = 20;
- implementation
- procedure ShowAns(Ans: String); stdcall; external 'MyDll.dll';
- procedure TForm1.EditChange(Sender: TObject);
- var
- IsValid1, IsValid2: Boolean;
- i: Integer;
- begin
- IsValid1 := False;
- IsValid2 := False;
- SaveButton.Enabled := False;
- if NEdit.Text <> '' then
- IsValid1 := True;
- if MEdit.Text <> '' then
- IsValid2 := True;
- if (IsValid1) and (IsValid2) then
- Start.Enabled := True
- else
- Start.Enabled := False;
- end;
- procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- begin
- CanClose := MessageDlg('Вы уверены, что хотите выйти из программы?' +
- #10#13 + 'Все несохраненные данные будут утеряны.',
- mtConfirmation, [mbYes, mbNo], 0) = mrYes;
- end;
- procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char);
- const
- Digit: set of Char = ['0'..'9', #8];
- begin
- with (Sender as TEdit) do
- begin
- if not(Key in Digit) then
- Key := #0;
- end;
- SaveButton.Enabled := False;
- end;
- procedure TForm1.AboutButtonClick(Sender: TObject);
- var
- Task: String;
- begin
- Task := 'N ребят встали в круг. Каждый раз, начиная с первого, из круга выводится каждый M-й. '
- + 'Вывести номера в порядке выбывания и номер последнего оставшегося.' + #10#13;
- Task := Task + 'Автор - Пестунов Илья, гр. 051007';
- MessageDlg(Task, mtInformation, [mbOK], 0);
- end;
- procedure TForm1.ReadButtonClick(Sender: TObject);
- var
- MyFile: TextFile;
- i, Value, j: Integer;
- begin
- MEdit.Text := '';
- NEdit.Text := '';
- Start.Enabled := False;
- if OpenDialog1.Execute then
- begin
- AssignFile(MyFile, OpenDialog1.FileName);
- Reset(MyFile);
- Read(MyFile, N, M);
- NEdit.Text := IntToStr(N);
- MEdit.Text := IntToStr(M);
- CloseFile(MyFile);
- Start.Enabled := True;
- end;
- end;
- procedure TForm1.SaveButtonClick(Sender: TObject);
- var
- MyFile: TextFile;
- i, j: Integer;
- begin
- if SaveDialog1.Execute then
- begin
- AssignFile(MyFile, SaveDialog1.FileName);
- Rewrite(MyFile);
- Writeln(MyFile, Ans);
- CloseFile(MyFile);
- MessageDlg('Результат успешно сохранён', mtCustom, [mbOK], 0);
- end;
- end;
- procedure TForm1.OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
- var
- IsValid: Boolean;
- N, i, Value, Err, j: Integer;
- MyFile: TextFile;
- Check: String;
- const
- Digit: set of Char = ['1'..'9', '0', ' ', '-'];
- begin
- IsValid := True;
- N := Length(OpenDialog1.FileName);
- if (OpenDialog1.FileName[N] = 't') and (OpenDialog1.FileName[N - 1] = 'x')
- and (OpenDialog1.FileName[N - 2] = 't') then
- begin
- AssignFile(MyFile, OpenDialog1.FileName);
- Reset(MyFile);
- Read(MyFile, Check);
- CloseFile(MyFile);
- if Length(Check) = 0 then
- begin
- MessageDlg('Файл пуст', mtWarning, [mbOK], 0);
- IsValid := False;
- end
- else
- begin
- AssignFile(MyFile, OpenDialog1.FileName);
- Reset(MyFile);
- try
- Readln(MyFile, N, M);
- except
- IsValid := False;
- MessageDlg('Числа N и M должны быть натуральными от 1 до 20', mtWarning, [mbOK], 0);
- end;
- if ((IsValid) and (N < MIN_SIZE)) or ((IsValid) and (N > MAX_SIZE))
- or ((IsValid) and (M < MIN_SIZE)) or ((IsValid) and (M > MAX_SIZE)) then
- begin
- IsValid := False;
- MessageDlg('Числа N и M должны быть натуральными от 1 до 20', mtError, [mbOK], 0);
- end;
- CloseFile(MyFile);
- end;
- end
- else
- begin
- MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
- IsValid := False;
- end;
- if not(IsValid) then
- CanClose := False;
- end;
- procedure TForm1.SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
- var
- N: Integer;
- begin
- N := Length(SaveDialog1.FileName);
- if (SaveDialog1.FileName[N] = 't') and (SaveDialog1.FileName[N - 1] = 'x')
- and (SaveDialog1.FileName[N - 2] = 't') then
- CanClose := True
- else
- begin
- CanClose := False;
- MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
- end;
- end;
- procedure Add(Info: Integer);
- var
- AddList: PLinkedList;
- begin
- New(AddList);
- AddList.Data := Info;
- AddList.Next := nil;
- if Head = nil then
- begin
- Head := AddList;
- AList := AddList;
- end
- else
- begin
- AList := Head;
- while not (AList.Next = nil) do
- AList := AList.Next;
- AList.Next := AddList;
- end;
- AList := Head;
- end;
- procedure DeleteList(List: PLinkedList);
- var
- Temp: PLinkedList;
- begin
- Temp := Head;
- while not (Temp.Next = AList) do
- Temp := Temp.Next;
- Temp.Next := Temp.Next.Next;
- Head := Temp.Next;
- AList := Head;
- end;
- procedure CreateList(N: Integer);
- var
- i: Integer;
- begin
- for i := 0 to N - 1 do
- Add(i + 1);
- while not (AList.Next = nil) do
- AList := AList.Next;
- AList.Next := Head;
- AList := Head;
- end;
- procedure TForm1.StartClick(Sender: TObject);
- var
- Err, i, Now: Integer;
- Temp: PLinkedList;
- begin
- Head := nil;
- Val(NEdit.Text, N, Err);
- Val(MEdit.Text, M, Err);
- if (N < MIN_SIZE) or (N > MAX_SIZE) or (M < MIN_SIZE) or (M > MAX_SIZE) then
- MessageDlg('Введите N и M в указанном диапазоне', mtError, [mbOK], 0)
- else
- begin
- CreateList(N);
- Now := 0;
- Ans := 'Номера в порядке выбывания: ' + #10#13;
- while N > 1 do
- begin
- Inc(Now);
- if Now = M then
- begin
- Ans := Ans + IntToStr(AList.Data) + ' ';
- DeleteList(AList);
- Now := 0;
- Dec(N);
- end
- else
- AList := AList.Next;
- end;
- Ans := Ans + #10#13 + 'Номер последнего оставшегося: ' + IntToStr(AList.Data);
- ShowAns(Ans);
- SaveButton.Enabled := True;
- end;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement