9.3. Функции

 

Функция	Назначение	Пример вызова	Значения
eof(file)	условие «конец файла»	if eof(f) then ...	[true; false]
eoln(file)	условие «конец строки»	if eoln(f) then ...	[true; false]
filepos(file)	получить номер позиции для обмена	if filepos(f) > 0 then ...	[0;n]
filesize(file)	получить размер файла [количество записей]	seek(f, filesize(f))	[0;n]
ioresult	номер ошибки ввода-вывода ({$I-})	if ioresult = 0 then ...	[0;n]

 

10. СПЕЦИАЛЬНЫЕ ОПЕРАЦИИ И ТИПЫ ДАННЫХ

10.1. ДИНАМИЧЕСКИЕ СТРУКТУРЫ ДАННЫХ

 

10.1.1. ТИП ДАННЫХ УКАЗАТЕЛЬ. ПЕРЕМЕННАЯ-УКАЗАТЕЛЬ

 

type тип-указатель = ^тип-переменной;

var переменная-указатель: тип-указатель;

 

10.1.2. ДИНАМИЧЕСКАЯ ПЕРЕМЕННАЯ. АДРЕС ВЕЛИЧИНЫ.

 

Переменная-объект	Переменная-указатель (ссылка)
P ^	P
Q	@ Q

 

10.1.3. ПРИМЕР РАБОТЫ С УКАЗАТЕЛЯМИ. БОЛЬШОЙ ОБЪЕМ ТЕКСТА.

 

type pstring = ^string;

var a: array [1..1000] of pstring; ....

new(a[1]); readln(a[1]^);

writeln(‘1=‘, a[1]^[1]);

 

10.1.4. ПРОЦЕДУРЫ ДЛЯ РАБОТЫ С ДИНАМИЧЕСКИМИ ПЕРЕМЕННЫМИ

 

Процедура	Назначение	Пример вызова	Результат
new(указатель)	создать переменную	new(s)	создана s^
dispose(указатель)	удалить переменную	dispose(a[i])	удалена a[i]^

 

10.2. ДРУГИЕ СПЕЦИАЛЬНЫЕ ПРОЦЕДУРЫ И ФУНКЦИИ

 

Процедура (функция)	Назначение	Пример вызова	Результат
sizeof(величина)	размер поля [байт]	sn := sizeof(n) {n - число integer}	sn = 2
fillchar(a,n,d)	заполнить n байт поля a значениями d (d: char или byte)	fillchar(a,sizeof(a),0) {a - массив чисел типа integer}	все элементы массива равны нулю
move(a,b,n)	передать n байтов из поля данных a в поле данных b	move(a, b, sizeof(a)) {a и b - массивы одного типа}	массивы равны (равны все эле- менты)

 

11. Основы машинной графики dos - bgi

11.1. Стандартный модуль (graph)

 

Пример: uses graph, crt;

 

11.2. Основные процедуры и функции

 

Процедура (функция)	Назначение	Пример вызова	Примечания
d := detect	Определить тип гра-фического режима (номер драйвера)	d := detect	d = драйвер экрана (bgi) (integer)
initgraph(d, m, путь-bgi)	Установить графиче-ский режим экрана	initgraph(d, m, ’c:\bgi’)	m = режим экрана (vga) (integer)
cleardevice	Очистить экран и отменить установки цвета	cleardevice
setcolor(цвет)	Установить цвет линии (рисунка)	setcolor(magenta)
setbkcolor(цвет)	Установить цвет фона (очистки)	setbkcolor(0)
putpixel(x,y,цвет)	Точка (x,y)	putpixel(5, 5, red)
line(x1,y1,x2,y2)	Линия (x1,y1)-(x2,y2)	line(10,10,20,200)
lineto(x,y)	Чертить линию в (x,y)	lineto(100,200)
moveto(x,y)	Вести перо в (x,y)	moveto(nx, ny)
circle(x,y,радиус)	Окружность (x,y,r)	circle(x, y, 20)
arc(x,y,угл1,угл2,радиус)	Дуга окружности (x,y,r) от угла1 до угла2 (радиан)	arc(10,10,0,pi,5)
setfillstyle(s,цвет-заливки)	Установить стиль и цвет заливки	setfillstyle(1,green)
floodfill(x,y,цветграницы)	Залить область с границей (цвет) цветом заливки	floodfill(p,q, 10)
rectangle(x1,y1,x2,y2)	Прямоугольник (x1,y1)-(x2,y2)	rectangle(2,2,5,10)
bar(x1,y1,x2,y2)	Прямоугольник (x1,y1)-(x2,y2) с заливкой цвета	bar(2, 2, m, n)
bar3d(x1,y1,x2,y2,z,n)	3-мерный прямоуголь-ник (колонка) (x1,y1)-(x2,y2)	bar3d(2,2,20,20, 10,true)	z = глубина n = boolean true = крыша колонки
x := getmaxx	макс. граница для x	mx := getmaxx	0..639 (vga)
y := getmaxy	макс. граница для y	my := getmaxy	0..479 (vga)
closegraph	Закрыть графический режим экрана	closegraph

 

ПРИМЕЧАНИЯ

 

Настоящий сборник справочных материалов по языку программирования Паскаль (версия 7.0.) предназначен для получения краткой справочной информации по вопросам состава и синтаксиса базовых конструкций языка - операторов, описаний, процедур, функций и т.д.

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

Назначение сборника состоит в том, чтобы упростить и ускорить процесс получения справки о назначении и правилах написания той или иной конструкции. Данные об основных конструкциях собраны в виде таблиц или коротких тематических разделов, имеют иерархический порядок нумерации и оглавление. Поиск нужной информации производится значительно быстрее, чем в документации или в учебном пособии - при этом размер сборника составляет всего 10 страниц текста! Сборник содержит только самые основные конструкции, но они вполне достаточны для решения большинства реальных учебных задач - от чисто вычислительных алгоритмов до серьезных задач в области графики и анимации, работы с файлами и указателями.

ЗАДАЧИ

 

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, а каждая следующая ветка станет в полтора раза меньше предыдущей.