Dale
Участник
|
      
Lenin, давайте по порядку:
1) Пожалуйста, переведите текст задач с украинского на русский, это нужно для четкого понимания условия задачи
(кстати, с вашей ссылки ничего не скачивается)
2)Модуль, который выводит меню, делает это в графическом режиме; гораздо проще и понятней будет написать меню в текстовом, с использованием модуля crt. Это реализуется элементарно:
Code Sample:
uses crt;
const kol=4;{ количество пунктов в меню}
var k,i:integer;
menu:array[1..kol] of string;
c:char;
procedure ris(item:integer);{Рисуем меню, item - number selected item}
begin
TextBackGround(0);
clrscr;
sound(3000);
delay(100);
nosound;
for i:=1 to kol do begin
if i=item then begin
TextBackGround(7); Textcolor(0);
end else begin
TextBackGround(0); Textcolor(7);
end;
writeln(menu[ i ]);
end;{for}
end;
Procedure OnLoad_1;
begin
{Здесь должна быть задча 1}
clrscr;
writeln('Задача 1');
readkey;
end;
Procedure OnLoad_2;
begin
{Здесь должна быть задча 2}
clrscr;
writeln('Задача 2');
readkey;
end;
Procedure OnLoad_3;
begin
{Здесь должна быть задча 3}
clrscr;
writeln('Задача 3');
readkey;
end;
procedure vipoln(item:integer); {Выполняем выбранный пункт меню}
begin
case item of
1:OnLoad_1;
2:OnLoad_2;
3:OnLoad_3;
4:Halt;{Выход из программы}
end;
end;
begin
menu[1]:='Здача 1';
menu[2]:='Здача 2';
menu[3]:='Здача 3';
menu[4]:='Выход';
k:=1;
ris(k);
while true do begin
c:=readkey;
case c of
#72:{up} if k=1 then k:=kol else k:=k-1;
#80:{down}if k=kol then k:=1 else k:=k+1;
#13:{enter}Vipoln(k);
end;
ris(k);
end;{while}
end.
внешняя ссылка удалена
Как видите, текст программы по сравнению с вашими модулями короток, и более нагляден.
Здесь достаточно написать в процедурах OnLoad_1, OLoad_2, OnLoad_3 ваши задачи(не убирая readkey), и все будет работать.
Здесь из модуля crt используется 7 подпрограмм:
clrscr - используется для очистки экрана перед прорисовкой меню и перед выполнением подпрограмм для решения задач
sound - используется для воспроизведения звукового сигнала во время прорисовки меню(процедура ris(item:integer))
delay - используется для паузы после начала воспроизведения звукового сигнала в процедуре ris(item:integer)
nosound - используется для остановки воспроизведения звукового сигнала в процедуре ris(item:integer)
textcolor - используется во время прорисовки меню(процедура ris(item:integer)) для изменения цвета текста выводимой строки меню
textbackground - используется во время прорисовки меню(процедура ris(item:integer)) для изменения цвета фона выводимой строки меню
readkey - используется в тексте основной программы для определения характера нажатой клавиши (стрелка вверх, стрелка вниз, enter).
главные моменты всего меню описать, с помощью чего, что у нас там происходит
1)Пункты меню содержатся в строковом массиве menu, нумерация элементов начинается с единицы. Количество пунктов меню находится в константе kol. В переменной k хранится номер выбранного пункта меню.
2)Процедура ris(item:integer) выводит меню, в качестве параметра item в нее поступает номер выделенного элемента. Прорисовка состоит из следующих этапов:
a) очистка экрана
б) В цикле for выводятся значения массива menu. Перед выводом каждой новой строки меняется цвет фона и цвет текста в зависимости от переданного параметра item.
3)Процедура vipoln(item:integer) определяет действия, выполняемые пунктом меню, номер которого передается процедуре через параметр item. Первым трем пунктам назначается выполнение процедур, соответствующих выполнению выбранных задач. Четвертому пункту меню соответствует выход из программы.
4)В начале работы программы задаются значения пунктов меню и переменной k, после чего происходит вывод меню.
Затем запускается "бесконечный" цикл while:
while true do
В теле цикла с помощью процедуры readkey происходит ожидание нажатия клавиши пользователем, после нажатия зaдается переменная c символьного типа. Затем, в зависимости от того, какую кнопку нажал пользователь, выполняется изменение переменной k и выполняется процедура прорисовки меню, в качестве параметра процедуре передается переменная k. Если происходит нажатие клавиши enter, выполняется процедура vipoln(item:integer) , в качестве параметра item передается k.
----------------------------------
В вашем же модуле очень много лишнего.
В добавок ко всему, блок-схему составить будет гораздо проще.
Кстати, на счет блок-схемы: если у вас есть пример, выкладывайте.
Если есть вопросы, общайтесь.
(Сообщение отредактировал Dale 21 июня 2009 21:36)
|
Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 21 июня 2009 19:49 | IP
|
|
Lenin
Новичок
|
Dale, вот мои задачи
внешняя ссылка удалена
А вообще мне кажется если я вам полностью скину курсовую роботу, с блок схемами и т.д. вам будет проще орентироватся что к чему.
|
Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 21 июня 2009 22:56 | IP
|
|
Arturka91
Новичок
|
помогите пожалуйста решить две задачи кому не трудно!!! просто очень срочно нужно!!! а я не успеваю 
1) Дана последовательность целых цисел,представленная списком, упорядочена по не убыванию, удалить повторяющиеся элементы, а последовательность упорядочить по убыванию.
2)используя рекурсивную процедуру получить массив каждый элемент которого равен своему индексу.
Буду очень признателен!!!!
|
Всего сообщений: 5 | Присоединился: июнь 2009 | Отправлено: 22 июня 2009 21:07 | IP
|
|
Dale
Участник
|
Lenin,
А вообще мне кажется если я вам полностью скину курсовую роботу, с блок схемами и т.д. вам будет проще орентироватся что к чему.
поверьте, я при желании легко смогу разобраться в этой огромной куче кода, и вот что я понял при беглом просмотре: в этом примере куча всяких наворотов, с применением графического режима, показом заставки перед началом работы программы... Очевидно, что автор этого курсача делал его не один день, постепенно реализуя свои собственные идеи за счет средств языка pascal. А вам оно надо? Зачем лезть в графику, зачем использовать кучу модулей, зачем писать столько кода? Ведь простота - залог успеха. Весь курсач прекрасно поместился в предыдущем ответе, я его написал за пол-часа. Вы не смогли разобраться в своем примере. Теперь посмотрите на мой код, почитайте пояснения - и вы, скорее всего, поймете, что и как там работает и как все это просто. Осталось только вписать решения трех простых задачек, и ваш курсач готов! Если хотите ввести "навороты", например, вывод меню в центре окна в красивой рамке - достаточно приписать несколько строк (если хотите, я укажу, где и какие)
Итак, подвожу итоги:
1) Я не буду разбираться в вашей курсовой, но вы легко сможете разобраться в моем варианте вашей курсовой, а если нет - можете задавать вопросы, и я с удовольствием на них отвечу.
2)Если вы не смотря ни на что намерены использовать ТОТ код, то я ни чем не смогу вам помочь
3)Если вы все же решили использовать мой код, я готов помочь вам с решениями задач составлением блок-схем. Если у вас есть какие-то идеи по поводу наворотов меню, пишите, и мы их реализуем.Если есть какие-нибудь дополнительные требования к курсовой, кроме использования >5 подпрограмм модуля crt, - перечислите их.
(Сообщение отредактировал Dale 23 июня 2009 1:14)
(Сообщение отредактировал Dale 23 июня 2009 1:17)
|
Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 23 июня 2009 1:03 | IP
|
|
Lenin
Новичок
|
Dale, давайте попорядку. Я согласен что простота залог успеха, но требованияк курсовой роботе таковы:
1) Заставка (предлогаю заставку сделать самой простенькой, написать большим шрифтом на весь экран "KNUBA")
2) 5 процедур и функций модуля CRT: keypressed, clrscr, textcolor (color), delay (F), gotoxy (x,y). (порядок не имеет значения,как лутше так и ставьте)
3) Меню которое состоит из 4-ех пунктов:
1 задача№1
2 задача№2
3 задача№3
4 выход
4) Блок-схемы для каждой задачи отдельно и одна на всю курсовую роботу!
5) Описание всей курсовой роботы.
6) Описание процедур и функций.
Кое-что у нас уже есть! Задачи я дал выше. Делаем задачи и прописываем их в курсовой. Составляем Блок-Схемы и оформляем в текстовом режиме!
Dale, вы пожалуйста советуйте помогайте, а я буду к вам подстраиватся и включатся в тему! Пожалуйста
(Сообщение отредактировал Lenin 23 июня 2009 11:31)
|
Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 23 июня 2009 10:39 | IP
|
|
Arturka91
Новичок
|
у кого есть минутка посмотрите пожалуйста мои задачи
|
Всего сообщений: 5 | Присоединился: июнь 2009 | Отправлено: 23 июня 2009 21:40 | IP
|
|
Dale
Участник
|
Arturka91
1) Code Sample:
uses crt;
var cnucok:array[1..100] of integer;
col,i,j,nycToU_CTAKAH:integer;
begin
{}
clrscr;
cnucok[1]:=1;
cnucok[2]:=2;
cnucok[3]:=2;
cnucok[4]:=3;
cnucok[5]:=4;
cnucok[6]:=5;
cnucok[7]:=5;
cnucok[8]:=6;
cnucok[9]:=6;
cnucok[10]:=6;
cnucok[11]:=7;
col:=11;
writeln('Массив: ');
for i:=1 to col do write(cnucoK[ i ],' ');
i:=2;
while i<col do begin
if cnucok[i-1]=cnucok[ i ] then begin
for j:=i to col-1 do cnucok[ j ]:=cnucok[j+1];
col:=col-1;
end else i:=i+1;
end;{while}
writeln;
writeln('Массив после удаления одинаковых элементов:');
for i:=1 to col do write(cnucoK[ i ],' ');
for i:=1 to col-1 do
for j:=1 to col-i do
if cnucok[ j ]<cnucok[j+1] then begin
nycToU_CTAKAH:=cnucok[ j ];
cnucok[ j ]:=cnucok[j+1];
cnucok[j+1]:=nycToU_CTAKAH;
end;
writeln;
writeln('Массив после сортирови:');
for i:=1 to col do write(cnucoK[ i ],' ');
readkey;
end.
внешняя ссылка удалена
2)Code Sample:
uses crt;
const N=15;
var m:array[1..N] of integer;
i:integer;
procedure AAA(i:integer);
begin
m[ i ]:=i;
i:=i+1;
if i=N+1 then exit else AAA(i);
end;
begin
AAA(1);
clrscr;
for i:=1 to N do write(m[ i ],' ');
readkey;
end.
внешняя ссылка удалена
Если есть вопросы, задавайте!
(Сообщение отредактировал Dale 24 июня 2009 0:43)
(Сообщение отредактировал Dale 24 июня 2009 1:41)
|
Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 24 июня 2009 0:38 | IP
|
|
Dale
Участник
|
Lenin ,
5 процедур и функций модуля CRT: keypressed, clrscr, textcolor (color), delay (F), gotoxy (x,y)
Неужели процедуру keypressed использовать обязательно? Я ее запихал в intro, но вообще подобное применение придает приложению оттенок несерьезности :-)
Итак, в соответствие с вашими пожеланиями я дополнил приложение процедурой для вывода текстовых файлов. Кроме вывода заставки перед программой она пригодится для решения третей задачи.
описание:
WriteFile(ADPEC:string; intro:boolean);
ADPEC - адрес файла;
intro - если равно true, то программа выводит файл построчно с воспроизведением звука, выводя любые символы кроме пробела как пробел цветом текста заместо цвета фона.
WriteFile(ADPEC:string; intro:boolean);
Кроме того, я добавил решение второй задачи.
============================================
uses crt;
const kol=4;{ количество пунктов в меню}
txtColor=1;
bkColor=6;
var k,i,j,i1,j1:integer;
menu:array[1..kol] of string;
c:char;
procedure WriteFile(ADPEC:string; intro:boolean);
var f:text;
cumBoJI:char;
begin
writeln;
textbackground(bkColor);clrscr;
assign(f,ADPEC);
reset(f);
while not eof(f) do begin
read(f,CUMBOJI);
if intro then
case CUMBOJI of
#10,#13:begin
sound(3214);
delay(5000);
nosound;
end;
' ':begin
Textcolor(txtColor); TextBackGround(bkColor);
end;
else begin
Textcolor(bkColor); TextBackGround(txtColor);
CUMBOJI:=' ';
end;
end;{case}
write(CUMBOJI);
end;
close(f);
writeln;
textcolor(txtcolor); textbackground(bkcolor);
{Сюда я впихнул keypressed}
while not keypressed do begin
textcolor(random(10));
gotoxy(1,1);
write('Нажмите любую клавишу');
delay(30000);
end ;
end;
procedure ris(item:integer);{Рисуем меню, item - number selected item}
begin
TextBackGround(bkColor);
clrscr;
sound(3000);
delay(100);
nosound;
for i:=1 to kol do begin
if i=item then begin
TextBackGround(txtColor); Textcolor(bkColor);
end else begin
TextBackGround(bkColor); Textcolor(txtColor);
end;
writeln(menu[ i ]);
end;{for}
end;
Procedure OnLoad_1;
begin
{Здесь должна быть задча 1}
clrscr;
writeln('Задача 1');
readkey;
end;
Procedure OnLoad_2;
const n=5;m=8;
var mas:array[1..m,1..n] of integer;
f,don:boolean;
min:array[1..m] of integer;
max:integer;
begin
{Здесь должна быть задча 2}
clrscr;
writeln('Задача 2');
writeln;
{Заполняем матрицу случайными неравными числами}
randomize;
for i:=1 to m do
for j:=1 to n do begin
f:=true;
while f do begin
mas[i,j]:=random(m*n)+1;
f:=false;
for i1:=1 to m do
for j1:=1 to n do begin
don:=not((i=i1) and (j=j1));
if (mas[i,j]=mas[i1,j1]) and (don) then f:=true;
end;
end;
end;{for j}
{Выводим массив}
for i:=1 to m do begin
for j:=1 to n do write(mas[i,j],' ');
writeln;
end;
{Выб. мин. элементы}
for i:=1 to m do min[ i ]:=1;
for i:=1 to m do
for j:=2 to n do if mas[i,min[ i }}>mas[i,j] then min[ i ]:=j;
{Выводим минимумы}
writeln('Минимальные элементы:');
for i:=1 to m do writeln(i,' - я строка: ',mas[i,min[ i }});
{ищем максимум}
max:=1;
for i:=2 to n do if mas[i,min[ i }}>mas[max,min[max}} then max:=i;
{Выв. максимум и его индексы}
writeln;
writeln('Максимальный элемент равен ', mas[max,min[max}});
writeln('Его индексы ', max,' строка, ',min[max],' столбец');
readkey;
end;
Procedure OnLoad_3;
begin
{Здесь должна быть задча 3}
clrscr;
writeln('Задача 3');
readkey;
end;
procedure vipoln(item:integer); {Выполняем выбранный пункт меню}
begin
case item of
1:OnLoad_1;
2:OnLoad_2;
3:OnLoad_3;
4:Halt;{Выход из программы}
end;
end;
begin
writefile('Knuba.txt',true);
readkey;
menu[1]:='Здача 1';
menu[2]:='Здача 2';
menu[3]:='Здача 3';
menu[4]:='Выход';
k:=1;
ris(k);
while true do begin
c:=readkey;
case c of
#72:{up} if k=1 then k:=kol else k:=k-1;
#80:{down}if k=kol then k:=1 else k:=k+1;
#13:{enter}Vipoln(k);
end;
ris(k);
end;{while}
end.
================================================
внешняя ссылка удалена
Для наглядности жирным я выделил изменения, красным - процедуру keypressed
В каталоге с программой (bin) должен находится файл, что-то типа этого
внешняя ссылка удалена
Ну теперь включайтесь и вы, задавайте вопросы!
(Сообщение отредактировал Dale 24 июня 2009 7:03)
|
Всего сообщений: 139 | Присоединился: май 2009 | Отправлено: 24 июня 2009 6:55 | IP
|
|
anton94
Новичок
|
Игра "Камень ножницы бумага". Играют 3 игрока. Кмень тупит ножницы, ножницы режут бумагу, бумага кроет камень. Нужно смоделировать задачу игры с помощью модуля CRT. Помогите, срочно надо!!!плиз.
(Сообщение отредактировал anton94 24 июня 2009 11:10)
|
Всего сообщений: 1 | Присоединился: июнь 2009 | Отправлено: 24 июня 2009 10:24 | IP
|
|
Lenin
Новичок
|
Dale, так, с меню понятно! Теперь осталось сделать задачи и составить блоксхемы.
Если я найду какието наброски поповоду задач я скину, а если ненайду придется здесь перерывать ветку сообщений.
|
Всего сообщений: 12 | Присоединился: май 2009 | Отправлено: 24 июня 2009 10:40 | IP
|
|
|
Форум
Решение задач на Pascal. Форум 2
