Помогите пожалуйста исправить меню. 1) Нужно, чтобы когда запускаешь программу, на экране появлялась какая-то картинка на 15 секунд, а затем открывалось меню. 2) Нужно, чтобы после вызванной задачи, программа не закрывалась, а открывалось заново меню выбора.
Код к задаче: «Чтобы после вызванной задачи, программа не закрывалась, а открывалось заново меню выбора»
Листинг программы
Program Kurs; Uses Crt; Var pynkt: Byte; procedure proc1; type a=array[1..30,1..30] of integer; var mas:a; b,n,m:integer; i,j:byte; procedure vvod(var mas:a;n,m:integer); var i,j:byte; begin for i:=1 to n do for j:=1 to m do begin mas[i,j]:=random(25); mas[i,j]:=mas[i,j]-10; end; end; Procedure vivod(mas:a); var i,j:byte; begin writeln(‘Матрица:’); for i:=1 to n do begin for j:=1 to m do write(mas[i,j]:4); writeln; end; end; begin repeat writeln(‘Кол.строк:’); readln(n); writeln(‘Кол.столбцов:’); readln(m); until (n in[1..30]) and (m in[1..30]); vvod(mas,n,m); vivod(mas); for j:=1 to m do begin for i:=1 to n do if mas[i,j]>0 then inc(b); writeln(‘Столбец: ‘,j,’ Кол.: ‘,b); b:=0; end; readkey; end; procedure proc2; const rus=[‘А’..’Я’,’а’..’я’]; eng=[‘A’..’Z’,’a’..’z’]; var str:string; procedure sumbol(var str:string); var resstr:string; i:byte; begin for i:=1 to length(str) do if not((str[i] in rus) or(str[i] in eng)) then resstr:=resstr+str[i]; for i:=1 to length (resstr) do while pos(resstr[i],str)<> 0 do delete(str,pos(resstr[i],str),1); end; Begin write(‘Рядок:’); readln (str); sumbol(str); writeln(‘Результат:’,str); readkey; end; procedure proc3; Type book=Record num: Integer; gor: String; tim: String; end; Var x: Array[1..100] of book; i,n,k: Integer; s: String; BEGIN Writeln(‘Кол.поездов: ‘); Readln(n); For i:=1 to n do begin Writeln(‘Номер поезда: ‘); Readln(x[i].num); Writeln(‘Город : ‘); Readln(x[i].gor); Writeln(‘Время: ‘); Readln(x[i].tim); end; Writeln(‘Нужный город: ‘); Readln(s); For i:=1 to n do If x[i].gor=s Then Inc(k); Writeln(‘Кол.поездов которые едут в нужный город ‘,s,’ — ‘,k); Readln end; procedure meny; begin repeat Write(‘Введите пункт меню:’); ReadLn(pynkt); Case pynkt of 1: begin proc1; readkey; end; 2: begin proc2; readkey; end; 3: begin proc3; readkey; end; 4: exit; end; until pynkt <>0; end; var q:boolean; begin textbackground(0); clrscr; textbackground(3); textcolor(17); clrscr; WriteLn(‘1 задача ‘); WriteLn(‘2 задача ‘); WriteLn(‘3 задача ‘); WriteLn(‘4 Выход’); Writeln(‘Програма. ‘); repeat meny; q:=true; until q<>true; end.
Источник: studassistent.ru
PascalABC.NET Обзор IDE / Скачать, установить, удалить / pascal abc .net / Net FrameWork / 2022
Как сделать чтобы программа не закрывалась после выполнения паскаль
Сообщений: 9
[Pascal ABC] Что можно сделать, чтобы после окончания игры, окно с игрой закрывалось и пользователь переходил к меню? Может есть какой то оператор?
МОЯ ПЕРВАЯ ИГРА!(и она на языке Pascal ABC) «Hit the Casino».
Что можно сделать, чтобы после окончания игры, окно с игрой закрывалось и пользователь переходил к меню? Может есть какой то оператор?
program Graphika; Uses GraphABC; var kol, v, raz, cordix, cordiy, k, x, y: integer; x1, y1, winx, winy, cordx, cordy: real; ch: char; f: text; procedure Shablon(i, x, Nasechka, y: integer); begin Line(0, 300, 800, 300); Line(800, 300, 780, 290); Line(800, 300, 780, 310); Line(400, 0, 400, 600); Line(400, 0, 380, 20); Line(400, 0, 420, 20); for i := 1 to 9 do begin x := i * 80; Line(x, 304, x, 296); TextOut((x — 5), 310, inttostr(Nasechka)); Nasechka := Nasechka + 1; end; for i := 0 to 9 do begin<> <> y := i * 60; Line(396, y, 404, y); TextOut(380, (y — 5), inttostr(Nasechka)); Nasechka := Nasechka — 1; end; end; procedure Spravka(f: text); var s: string; begin assign(f, ‘Spravka.txt’); reset(f); while not eof(f) do begin readln(f, s); writeln(s); end; readln; end; procedure Game(r: real; var k: integer; winx, winy, x, y, cordx, cordy: real); begin repeat read(x, y); x1 := x + 5; y1 := y + 5; cordx := x1 * 80; cordy := y1 * 60; r := sqrt(sqr(x — winx) + sqr(y — winy)); raz := round(r); cordix := round(cordx); cordiy := round(cordy); case raz of 0: begin<> Pen.Color := clGreen; Circle(cordix, (600 — cordiy), 5); Pen.Color := clBlack; end; 1: begin Pen.Color := clRed; Circle(cordix, (600 — cordiy), 5); Pen.Color := clBlack; end; 2: begin<> Pen.Color := clOrange; Circle(cordix, (600 — cordiy), 5); Pen.Color := clBlack; end; 3..4: begin<> Pen.Color := clBlue; Circle(cordix, (600 — cordiy), 5); Pen.Color := clBlack; end; 5..99: begin<> Pen.Color := clPurple; Circle(cordix, (600 — cordiy), 5); Pen.Color := clBlack; end; end; k := k + 1 until (raz = 0) or (k > 9); end; begin Randomize; SetWindowSize(800, 600); ch := ‘y’; writeln(‘1 Запуск программы’); writeln(‘2 Инструкция’); writeln(‘3 Выход’); repeat readln(v); case v of 1: begin Pen.Color := clWhite; Rectangle(0, 0, 800, 100); Pen.Color := clBlack;<> end; 2: Spravka(f); 3: halt; end; until (v = 1) or (v = 4); repeat Clearwindow; Shablon(1, 0, -4, 0); winx := random(10) — 5; winy := random(10) — 5; kol := 0; writeln(winx); writeln(winy); Game(0, kol, winx, winy, x, y, cordx, cordy); if raz = 0 then begin TextOut(420, 380, ‘Вы угдали! Количество попыток составило’); TextOut(420, 400, inttostr(kol)); end else TextOut(420, 380, ‘Вы не угадали’); TextOut(420, 420, ‘Хотите сыграть еще?(y/n)’); readln(ch); readln; until ch = ‘n’; end.
_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор
Последний раз редактировалось Serge_Bliznykov; 14.06.2018 в 21:04 .
Источник: www.programmersforum.ru
Как задерживать консоль чтобы она не закрывалась. Pascal. Lazarus — Остановка, удержание окна программы
Если вы используете среду разработки, которая для вывода данных использует стандартную консоль ОС, то чтобы задержать её используйте пару операторов считывания данных, перед последней закрывающей операторной скобкой, например:
var // объявление переменных begin // тут ваш код readln(); readln(); // два вызова readln() для задержки консоли end.
При таком подходе для закрытия консоли и завершения работы программы придётся один или два раза нажать Enter.
Key Words for FKN + antitotal forum (CS VSU):
Источник: fkn.ktu10.com