Навигация
Главная
Поиск
Форум
FAQ's
Ссылки
Карта сайта
Чат программистов

Статьи
-Delphi
-C/C++
-Turbo Pascal
-Assembler
-Java/JS
-PHP
-Perl
-DHTML
-Prolog
-GPSS
-Сайтостроительство
-CMS: PHP Fusion
-Инвестирование

Файлы
-Для программистов
-Компонеты для Delphi
-Исходники на Delphi
-Исходники на C/C++
-Книги по Delphi
-Книги по С/С++
-Книги по JAVA/JS
-Книги по Basic/VB/.NET
-Книги по PHP/MySQL
-Книги по Assembler
-PHP Fusion MOD'ы
-by Kest
Professional Download System
Реклама
Услуги

Автоматическое добавление статей на сайты на Wordpress, Joomla, DLE
Заказать продвижение сайта
Программа для рисования блок-схем
Инженерный калькулятор онлайн
Таблица сложения онлайн
Популярные статьи
OpenGL и Delphi... 65535
Форум на вашем ... 65535
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Invision Power ... 65535
Пример работы с... 65535
Содержание сайт... 65535
ТЕХНОЛОГИИ ДОСТ... 65535
Организация зап... 65535
Вызов хранимых ... 65535
Создание отчето... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Модуль Forms 65535
21 ошибка прогр... 64023
Реклама
Сейчас на сайте
Гостей: 3
На сайте нет зарегистрированных пользователей

Пользователей: 13,136
новичок: Nika15
Новости
Реклама
Выполняем курсовые и лабораторные по разным языкам программирования
Подробнее - курсовые и лабораторные на заказ
Delphi, Turbo Pascal, Assembler, C, C++, C#, Visual Basic, Java, GPSS, Prolog, 3D MAX, Компас 3D
Заказать программу для Windows Mobile, Symbian

Калькулятор на Delphi с переводом в другую систему исчисления + Блок схемы
Метод конечных разностей для интерполяции/экстраполяции на Delphi
Моделирование процесса передачи данных по магистрали с основным и резерв...

Реклама



Подписывайся на YouTube канал о программировании, что бы не пропустить новые видео!

ПОДПИСЫВАЙСЯ на канал о программировании
Учительский практикум по Паскалю
1. Задачи на обработку клавиатуры.

1. Написать программу,
печатающую код нажимаемой клавиши и заканчивающей работу после нажатия клавиши
ESC. Определить все клавиши, не генерирующие кода и генерирующие расширенный
код.



Решение.
Эта программа очень проста:

Program VKB;

Uses Crt;

Var c,c2:char;

Begin




Repeat




c:=ReadKey;

If c=#0 then begin c2:=ReadKey;WriteLn('0 ',ord(c2)) end

else WriteLn(ord(c))




Until c=#27
{ 27 -код клавиши ESC }





End.


Не генерируют кода клавиши
смещения Shift, Alt, Ctrl и клавиши-переключатели Caps Lock, Num Lock, Break,
Scroll Lock, Print Screen. Генерируют расширенный код функциональные клавиши,
клавиши редактирования Ins и Del, клавиши передвижения курсора. Расширенный код
также генерируют некоторые комбинации клавиш, получаемые клавишами Alt и Ctrl.


2. Дана программа рисования
звездочки в центре экрана; при нажатии букв U, D, R, L рисуется звездочка выше,
ниже, правее, левее предыдущей звездочки соответственно. Программа заканчивает
работу по нажатии клавиши Esc.

Program Stars;

Uses Crt;

Var x,y:byte;

c: char;

Begin




ClrScr;
TextColor(7);

x:=40; y:=13; GotoXY(x,y); Write('*');

Repeat





c:=ReadKey;

Case c of

'R','r': Inc(x);

'L','l': Dec(x);

'D','d': Inc(y);

'U','u': Dec(y);

end;

GotoXY(x,y); Write('*')



Until c=#27





End.


Таким образом, программа
является очень упрощенной моделью графического редактора. Попытку выхода за
границу экрана она отрабатывает неправильно. Также не корректно она обрабатывает
нажатие некоторых клавиш. Например, нажатие клавиши F10 оказывает такой же
эффект, как и нажатие буквы D (так как 'D'=#68, а клавиша F10 генерирует
последовательность символов #0#68).


Усовеpшенствуйте программу так,
чтобы:

1. вместо клавиш U, D, R, L она реагировала на соответствующие клавиши
передвижения курсора...

2. ... и не реагировала бы на них при попытке выхода за границы экрана;

3. с помощью функциональных клавиш F1-F7 можно было бы менять цвет; номер цвета
вновь печатаемых звездочек должен устанавливаться в значение от 1 до 7
соответственно;

4. при нажатии на клавишу ESC должен очищаться экран;

5. при нажатии клавиш ALT+X программа заканчивает работу.



Решение.
Все усовершенствования касаются только основного цикла Repeat-Until. Главное
изменение заключается в том, чтобы обрабатывать правильно клавиши расширенного
кода. Тогда пункт 1) достигается заменой символов 'U' и 'u' на #0 и #72 во
внешнем и внутреннем операторах Case соответственно и т.д. Для пункта 2)
достаточно перед процедурами Inc и Dec поставить соответствующие условия. Пункты
3)-5) выполняются путем расширения списков обрабатываемых клавиш в операторах
Case. Вот как может выглядеть исправленная программа:



Program
SuperStars;

Uses Сrt;

Var x,y:byte;

c,c2:char;

Begin



ClrScr;
TextColor(7);

x:=40; y:=13; GotoXY(x,y); Write('*');

Repeat





c:=ReadKey;

Case c of

#27: ClrScr;

#0: Begin





c2:=ReadKey;

Case c2 of

#77: If x<80 then Inc(x); { #0#77 -код клавиши -> }

#75: If x>1 then Dec(x);

#80: If y<25 then Inc(y);

#72: If y>1 then Dec(y);

#59: TextColor(1); { #0#59 -код клавиши F1 }

#60: TextColor(2);

#61: TextColor(3);

#62: TextColor(4);

#63: TextColor(5);

#64: TextColor(6);

#65: TextColor(7);

end {case c2}

end {c=#0}




end; {case c}

GotoXY(x,y); Write('*')





Until c2=#45
{ #0#45 -код клавиш ALT+X }





End.


Семь строчек программы,
обрабатывающих клавиши F1-F7, можно заменить одной строкой #59..#65: TextColor(ord(c2)-58);


2. Задачи на рекурсию


3. В выражении

12894 * 4193 * 9510 * 8653 * 4381 * 2546 * 1158 * 8645 * 2587

заменить звездочки знаками "+" или "-" так, чтобы получившееся арифметическое
выражение равнялось 1989.



Решение.
Предположим, что k первых звездочек уже заменено знаками сложения и вычитания и
результат первых k операций (сумма s) нам известен (в начальный момент k=0, s=12894).
Тогда (k+1)-ю звездочку мы можем заменить двумя способами. Подсчитывая в обоих
случаях получающуюся сумму первых k+1 операций, мы приходим к исходной ситуации,
но с k, на единицу большим. Если же k=8, то надо проверить равенство s=1989 и
при его выполнении напечатать ответ. Запоминается k-ая операция в k-ом символе
строки z.



Program Sum_1989;

Const c:array[0..8] of integer =
(12894,4193,9510,8653,4381,2546,1158,8645,2587);

Var z: string[8];

Procedure ADD(s:longint; k: integer); { s -сумма после }

Var i: byte; { k первых операций }

Begin




If k = 8
then

If s = 1989 then begin

For i := 1 to 8 do Write(c[i-1],z[i]);

WriteLn(c[8],'=1989')

end

else

else begin

k:=k+1;

z[k]:='+'; ADD(s+c[k],k);

z[k]:='-'; ADD(s-c[k],k);

end




End;

Begin

ADD(c[0],0)

End.


4. В написанном выражении ((((1
? 2) ? 3) ? 4) ? 5) ? 6


вместо каждого знака "?"
вставить знак одного из четырех арифметических действий: +, -, *, / так, чтобы
результат вычислений равнялся 35 (при делении дробная часть в частном
отбрасывается).


Решение аналогично предыдущей
задаче.



Program Result_35;

Var z: string[5];

Procedure OPER(r,k: integer); { r -результат после }

Var i:byte; { k-1 операций }

Begin




If k = 6
then

If r = 35 then begin

Write('((((1 ',z[1],' ');

For i:=2 to 5 do Write(i,') ',z[i],' ');

WriteLn('6 = 35')

end

else

else begin

z[k]:='+'; OPER(r+k+1,k+1);

z[k]:='-'; OPER(r-k-1,k+1);

z[k]:='*'; OPER(r*(k+1),k+1);

z[k]:='/'; OPER(r div (k+1),k+1);

end




End;


Begin

OPER(1,1)

End.


5. Из заданных N предметов
выбрать такие, чтобы их суммарный вес был менее 30 кг, а стоимость - наибольшей.
Напечатать номера и суммарную стоимость выбранных предметов. Вес и стоимость
предметов заданы массивами A[1:N] и B[1:N].



Замечание.
Можно предполагать, что предметы уже расположены в порядке возрастания или
убывания веса A[i], стоимости B[i] или какого-либо иного признака.



Решение.
В отношении каждого предмета у нас два варианта действий: мы можем его выбрать
или не выбрать. Эта ситуация напоминает задачу 3: там тоже каждая звездочка
предоставляла два варианта действий. Но есть и отличия.

Во-первых, суммарная стоимость должна быть наибольшей. Чтобы ее
определить, надо перебрать всевозможные варианты выбора предметов с
одновременным запоминанием оптимального варианта. Лишь по окончании перебора
можно распечатать оптимальный вариант. (В третьей задаче приемлемость каждого
варианта расстановки знаков определялась независимо от других вариантов.)

Во-вторых и главных, чтобы выяснить, годится ли тот или иной набор
предметов, необязательно определять его до конца. Если несколько первых
предметов превысят 30 кг, то выбор остальных предметов можно прекратить.
Разумеется, можно составить алгоритм с полным определением каждого набора
предметов по аналогии с третьей задачей. Но в данной ситуации он может оказаться
неэффективным, особенно если будет много тяжелых предметов. Поэтому приведем
программу, в которой определение набора немедленно прерывается, как только вес
уже выбранных предметов превысит 30 кг. Набор кодируется в массиве M[1..N]
нулями и единицами, текущий самый тяжелый набор запоминается в массиве R[1..N].
Программа работает при любой упорядоченности предметов, но наиболее быстро при
упорядоченности их по убыванию веса. Алгоритм можно несколько усовершенствовать,
если предусмотреть предварительное изъятие из рассмотрения всех предметов
тяжелее 30 кг. Это усовершенствование мы оставим читателю.



Program Rukzak;

Const N = 5;

Var i: integer;

M,R: array[1..N] of integer;

A,B: array[1..N] of real;

Smax: real;

Procedure NABOR(k: integer; V,S: real);

Begin



If V>30
then M[k] := 0

else begin

If S>Smax then begin Smax := S; R := M end;

If k

M[k+1]:=1; NABOR(k+1,V+A[k+1],S+B[k+1]);

M[k+1]:=0; NABOR(k+1,V,S);

end end



End;

Begin




For i:=1 to
N do begin

Write('Введите вес и стоимость ',i,'-го предмета: ');

ReadLn(A[i],B[i]);

M[i]:=0 end;

Smax:=0;

NABOR(0,0,0);

Write('Номера выбранных предметов:');

For i:=1 to N do If R[i]=1 then Write(' ',i);

WriteLn; WriteLn('Суммарная стоимость: ',Smax);




End.


6. Написать программу,
реализующую рекурсивный алгоритм закраски замкнутой области цветом, совпадающим
с цветом границы области.



Решение.
Ядро простейшего алгоритма закраски составляет рекурсивная процедура, которая
проверяет цвет заданной точки и, если он отличен от цвета закраски, закрашивает
ее и вызывает себя для четырех соседних точек. В качестве примера реализации
алгоритма приводим программу, рисующую круг и закрашивающую его путем вызова
рекурсивной процедуры PAINT.



Program Painter;

Uses Graph;

Var d,r:integer;

Procedure PAINT(x,y,c:integer);

Begin




If GetPixel(x,y)<>c
then begin

PutPixel(x,y,c);

PAINT(x+1,y,c);

PAINT(x-1,y,c);

PAINT(x,y+1,c);

PAINT(x,y-1,c);

end




End;

Begin




d:=CGA;
r:=1; InitGraph(d,r,'BGI\');

SetColor(2);

Circle(120,100,24);

PAINT(120,100,2);

ReadLn




End.


С помощью данной процедуры
можно закрашивать только небольшие области. В противном случае возможен
настолько глубокий уровень рекурсивного вызова, что для выполнения программы не
хватит оперативной памяти.


7. Написать программу, рисующую
елочку с помощью рекурсивной процедуры.



Решение.
Общая схема рекурсивной процедуры может быть такой:

1. рисуется левая ветка снизу вверх;

2. если это была не самая верхняя ветка, то процедура обращается к себе;

3. рисуется правая ветка сверху вниз.


Таким образом, при выполнении
алгоритма сначала будут нарисованы все левые ветки елочки снизу вверх, а затем
все правые ветки сверху вниз. Условие определения верхней ветки может быть
различным. Например, по достижении определенного номера ветки или ее размера
процедура прерывает рекурсивное обращение к себе. Тем самым последняя
нарисованная левая ветка окажется верхней. Ниже приводится программа, в которой
заранее задано количество веток и размер веток в пикселях (n=3, R=100).



Program Tree;

Uses Graph;

Var d,r,n:integer;

Procedure VETKA(R,k:integer); {рисуется k-ая ветка размера R}

Begin




LineRel(-R,0);

LineRel(R,-R);

If k{ VETKA(2*R div 3, k+1) }

LineRel(R,R);

LineRel(-R,0);




End;

Begin




d:=VGA;
r:=2; InitGraph(d,r,'C:\TP5\BGI');

SetColor(2); MoveTo(240,400); n:=3;

VETKA(100,1);




End.


Если при вызове процедуры VETKA
первый параметр R заменить на 2*R div 3 (указано в комментариях), то только
первая ветка будет иметь размер 100, а каждая следующая ветка станет в полтора
раза меньше предыдущей.

Опубликовал Kest Октябрь 26 2008 15:39:25 · 2 Комментариев · 9218 Прочтений · Для печати

• Не нашли ответ на свой вопрос? Тогда задайте вопрос в комментариях или на форуме! •


Комментарии
юрий Август 18 2014 09:20:25
при выводе очередной звездочки в задании №2 предыдущие остаются на экране
юрий Август 18 2014 11:37:35
не слабо вам к первой задаче на рекурсию трассировку сделать а то не понятно как там все это считается
Добавить комментарий
Имя:



smiley smiley smiley smiley smiley smiley smiley smiley smiley
Запретить смайлики в комментариях

Введите проверочный код:* =
Рейтинги
Рейтинг доступен только для пользователей.

Пожалуйста, залогиньтесь или зарегистрируйтесь для голосования.

Нет данных для оценки.
Гость
Имя

Пароль



Вы не зарегистрированны?
Нажмите здесь для регистрации.

Забыли пароль?
Запросите новый здесь.
Поделиться ссылкой
Фолловь меня в Твиттере! • Смотрите канал о путешествияхКак приготовить мидии в тайланде?
Загрузки
Новые загрузки
iChat v.7.0 Final...
iComm v.6.1 - выв...
Visual Studio 200...
CodeGear RAD Stud...
Шаблон для новост...

Случайные загрузки
Библия хакера 2. ...
Pirc
Современное проек...
C++ Builder 6 СПР...
Пример работы с ф...
PHP/MySQL для нач...
Форма в форме
API (Применение A...
Delphi 2005 Секре...
Заставка. Изображ...
Язык программиров...
TDBF
SMLPack v1.0
AdBlaster v2.5 - ...
CoolDev TipsSyste...
GPSS World Studen...
Фильтры изображений
Переработанный пл...
3d Tank [Исходник...
Рисование PopupMenu

Топ загрузок
Приложение Клие... 100578
Delphi 7 Enterp... 93929
Converter AMR<-... 20130
GPSS World Stud... 16150
Borland C++Buil... 13496
Borland Delphi ... 9481
Turbo Pascal fo... 7154
Калькулятор [Ис... 5363
Visual Studio 2... 5060
FreeSMS v1.3.1 3581
Случайные статьи
5.4.3. Ввод программ
Вулкан 777
Элементы коллекции...
Презентации Prezi
Службы мета катало...
Листинг 14.4. Доба...
ПРИМЕРЫ ЗАПИСИ ПРИ...
4.1. Порождение ...
Потоки ввода-вывод...
Настройки чтения
INDEX (ИНДЕКСИРОВАТЬ)
Когда говорят про ...
Программа ,имитиру...
AVL-деревья
Кому адресована эт...
Аналоговый сигнал ...
Детализация блоков...
Тестирование: конс...
Доверяй, но проверяй
Составной оператор
получателям
Когда вы успешно п...
Header does not ma...
Ограничение возмож...
Композитные/S-Vide...
Статистика



Друзья сайта
Программы, игры


Полезно
В какую объединенную сеть входит классовая сеть? Суммирование маршрутов Занимают ли таблицы память маршрутизатора?