Навигация
Главная
Поиск
Форум
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
Имитационное мо... 60044
Реклама
Сейчас на сайте
Гостей: 4
На сайте нет зарегистрированных пользователей

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

База данных студентов на Turbo Pascal (Списки) + Пояснительная записка
Моделирование интернет кафе на GPSS + Отчет
Двунаправленный динамический список на 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 October 26 2008 15:39:25 · 2 Комментариев · 8879 Прочтений · Для печати

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


Комментарии
юрий August 18 2014 09:20:25
при выводе очередной звездочки в задании №2 предыдущие остаются на экране
юрий August 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...
Шаблон для новост...

Случайные загрузки
Autorunner
Правила программи...
THttpScan v4.1
Zoom [Исходник на...
PolyFlow
Plasma
AboutSystem
3D Тетрис [Исходн...
Синтаксический ан...
Ics
C++ Builder: Книг...
Text3D
Converter AMR<->W...
Indy in Depth Глу...
DateEdit
PBEditPack
Советы от Даниилы...
Progressbar
Стелтинг Стивен, ...
PHP глазами хакера

Топ загрузок
Приложение Клие... 100519
Delphi 7 Enterp... 91066
Converter AMR<-... 20097
GPSS World Stud... 15104
Borland C++Buil... 12859
Borland Delphi ... 9068
Turbo Pascal fo... 7102
Калькулятор [Ис... 5151
Visual Studio 2... 5026
FreeSMS v1.3.1 3556
Случайные статьи
Политика реагирования
Шашки на Strawberr...
Дружественные клас...
Работа с транзакта...
Эффективное исполь...
Что входит в Servi...
Механизмы доступа ...
Вся правда о тИЦ
Пишем PHP код, уст...
Сжатие и кодирован...
Сигналы. Знакомств...
Реализация интерфе...
Выизучили все пара...
Есть две причины, ...
7.8. Использован...
Создание файла сод...
Упорядоченный дина...
Продолжаем разбирать
Описание полей в т...
Тестирование, поис...
Приходящий системн...
6.3. Принципы
Предварительный пр...
Выбор типа XHTML-д...
Вкладка Configure ...
Статистика



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


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