Тема 8: «Типизированные файлы»

Длина любого компонента типизированного файла строго постоянна, что дает возможность организовать прямой доступ к каждому из них (т.е. доступ к компоненту по его порядковому номеру).

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

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

Процедура READ.

Обеспечивает чтение очередных компонентов типизированного файла. Формат обращения:

READ (<ф.п.>,<сп.ввода>)

Здесь <cn.вводa> - список ввода, содержащий одну или более переменных такого же типа, что и компоненты файла.

Файловая переменная <ф.п.> должна быть объявлена предложением FILE OF... и связана с именем файла процедурой ASSIGN. Файл необходимо открыть процедурой RESET. Если файл исчерпан, обращение к READ вызовет ошибку ввода-вывода.

Процедура WRITE.

Используется для записи данных в типизированный файл. Формат обращения:

WRITE (<ф.п.>,<сп.вывода>)

Здесь <сп.вывода> - список вывода, содержащий одно или более выражений того же типа, что и компоненты файла.

Процедура SEEK.

Смещает указатель файла к требуемому компоненту. Формат обращения:

SEEK (<ф.п.>,<N компонента>)

Здесь <N компонента> - выражение типа LONGINT, указывающее номер компонента файла.

Первый компонент файла имеет номер 0. Процедуру нельзя применять к текстовым файлам.

Функция FILESIZE.

Возвращает значение типа LONGINT, которое содержит количество компонентов файла. Формат обращения: '

FILESIZE (<ф.п.>)

Функцию нельзя использовать для текстовых файлов. Чтобы переместить указатель в конец типизированного файла, можно написать:

seek (FileVar, FileSize(FileVar));

где FILEVAR - файловая переменная.

Функция.FILEPOS.

Возвращает значение типа LONGINT, содержащее порядковый номер компонента файла, который будет обрабатываться следующей операцией ввода-вывода. Формат обращения:

FILEPOS (<ф.п.>)

Функцию нельзя использовать для текстовых файлов. Первый компонент файла имеет порядковый номер 0.

Тема 9: «Модуль Graph»

Пример перехода к графическому режиму

var

Driver, Mode, Error:Integer;

begin

Driver := Detect;{Автоопределение драйвера}

InitGraph(Driver, Mode,' ');{Инициируем графику}

Error := GraphResult;{Получаем результат}

if Error <> grOk then{Проверяем ошибку}

begin{Ошибка в процедуре инициации}

WriteLn(GraphErrorMsg(Error));{Выводим сообщение}

.......

end

else{Нет ошибки}

.......

Procedure ClearViewPort Очищает окно. Если тип адаптера ПК неизвестен или если программа рассчитана на работу с любым адаптером, используется обращение к процедуре с требованием автоматического определения типа драйвера:

Driver := Detect;

InitGraph(Driver, Mode, 'C:\TP\BGI');

После такого обращения устанавливается графический режим работы экрана, а при выходе из процедуры переменные Driver и Mode содержат целочисленные значения, определяющие тип драйвера и режим его работы. При этом для адаптеров, способных работать в нескольких режимах, выбирается старший режим, т.е. тот, что закодирован максимальной цифрой. Так, при работе с CGA -адаптером обращение к процедуре со значением Driver = Detect вернет в переменной Driver значение 1 (CGA) и в Mode -значение 4 (CGAHi), а такое же обращение к адаптеру VGA вернет Driver = 9 (VGA) и Mode = 2 (VGAHi).

Функция GraphResult. Возвращает значение типа Integer, в котором закодирован результат последнего обращения к графическим процедурам. Если ошибка не обнаружена, значением функции будет ноль, в противном случае - отрицательное число, имеющее следующий смысл:

const

grOk = 0;{Нет ошибок}

grlnitGraph =-1;{He инициирован графический режим}

grNotDetected =-2;{Не определен тип драйвера}

grFileNotFind =-3;{Не найден графический драйвер}

grlnvalidDriver =-4;{Неправильный тип драйвера}

grNoLoadMem =- 5;{Нет памяти для размещения драйвера}

grNoScanMem = - 6;{Нет памяти для просмотра областей}

grNoFloodMem =- 7;{Нет памяти для закраски областей}

grFontNotFound = -8;{Не найден файл со шрифтом}

grNoFontMem =- 9;{Нет памяти для размещения шрифта}

grlnvalidMode =-10;{Неправильный графический режим}

grError =-11;{Общая ошибка}

grIOError =-12;{Ошибка ввода-вывода}

grlnvalidFont =-13;{Неправильный формат шрифта}

grInvalidFontNum=-14; {Неправильный номер шрифта}

После обращения к функции GraphResult признак ошибки сбрасывается, поэтому повторное обращение к ней вернет ноль.

Функция GraphErrorMsg. Возвращает значение типа String, в котором по указанному коду ошибки дается соответствующее текстовое сообщение. Заголовок функции:

Function GraphErrorMsg(Code: Integer): String;

Здесь Code - код ошибки, возвращаемый функцией GraphResult.

Например, типичная последовательность операторов для инициации графического режима с автоматическим определением типа драйвера и установкой максимального разрешения имеет следующий вид:

var

Driver, Mode, Error:Integer;

begin

Driver := Detect;{Автоопределение драйвера}

InitGraph(Driver, Mode,' ');{Инициируем графику}

Error := GraphResult;{Получаем результат}

if Error <> grOk then{Проверяем ошибку}

begin{Ошибка в процедуре инициации}

WriteLn(GraphErrorMsg(Error));{Выводим сообщение}

.......

end

else{Нет ошибки}

.......

Чаще всего причиной возникновения ошибки при обращении к процедуре InitGraph является неправильное указание местоположения файла с драйвером графического адаптера (например, файла CGA.BGI для адаптера CGA). Настройка на местоположение драйвера осуществляется заданием маршрута поиска нужного файла в имени драйвера при вызове процедуры InitGraph. Если, например, драйвер зарегистрирован в подкаталоге DRIVERS каталога PASCAL на диске D, то нужно использовать вызов:

InitGraph(Driver, Mode, 'd:\Pascal\Drivers');

Замечание. Во всех следующих примерах процедура InitGraph вызывается с параметром Driver в виде пустой строки. Такая форма обращения будет корректна только в том случае, когда нужный файл графического драйвера находится в текущем каталоге. Для упрощения повторения примеров скопируйте файл, соответствующий адаптеру Вашего ПК, в текущий каталог.

Процедура CloseGraph. Завершает работу адаптера в графическом режиме и восстанавливает текстовый режим работы экрана. Заголовок:

Procedure CloseGraph;

Процедура RestoreCRTMode. Служит для кратковременного возврата в текстовый режим. В отличие от процедуры CloseGraph не сбрасываются установленные параметры графического режима и не освобождается память, выделенная для размещения графического драйвера. Заголовок:

Procedure RestoreCRTMode;

Функция GetGraphMode. Возвращает значение типа Integer, в котором содержится код установленного режима работы графического адаптера. Заголовок:

Function GetGraphMode: Integer;

Процедура SetGraphMode. Устанавливает новый графический режим работы адаптера. Заголовок:

Procedure SetGraphMode(Mode: Integer);

Здесь Mode - код устанавливаемого режима.

Следующая программа иллюстрирует переход из графического режима в текстовый и обратно:

Uses Graph;

var .

Driver, Mode, Error : Integer;

begin

{Инициируем графический режим}

Driver := Detect;

InitGraph(Driver, Mode, '');

Error := GraphResult; {Запоминаем результат}

i£ Error <> grOk then {Проверяем ошибку}

WriteLn(GraphErrorMsg(Error)) {Есть ошибка}

else

begin {Нет ошибки}

WriteLn ('Это графический режим');

WriteLn ('Нажмите "Enter"...':20);

ReadLn;

{Переходим в текстовый режим}

RestoreCRTMode;

WriteLn (' А это текстовый...');

ReadLn;

{Возвращаемся в графический режим}

SetGraphMode (GetGraphMode);

WriteLn ('Опять графический режим...');

ReadLn;

CloseGraph

end

end.

В этом примере для вывода сообщений как в графическом, так и в текстовом режиме используется стандартная процедура WriteLn. Если Ваш ПК оснащен нерусифицированным адаптером CGA, вывод кириллицы в графическом режиме таким способом невозможен, в этом случае замените соответствующие сообщения так, чтобы использовать только латинские буквы.

Процедура DetectGraph. Возвращает тип драйвера и режим его работы. Заголовок:

Procedure DetectGraph(var Driver,Mode: Integer);

Здесь Driver - тип драйвера; Mode - режим работы.

В отличие от функции GetGraphMode описываемая процедура возвращает в переменной Mode максимально возможный для данного адаптера номер графического режима.

Функция GetDriverName. Возвращает значение типа String, содержащее имя загруженного графического драйвера. Заголовок:

Function GetDriverName: String;

Функция GetMaxMode. Возвращает значение типа Integer, содержащее количество возможных режимов работы адаптера. Заголовок:

Function GetMaxMode: Integer;

Функция GetModeName. Возвращает значение типа String, содержащее разрешение экрана и имя режима работы адаптера по его номеру. Заголовок:

Function GetModName(ModNumber: Integer): String;

Здесь ModNumber - номер режима.

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

Uses Graph;

var

a,b: Integer;

begin

a := Detect;

InitGraph(a, b, '');

WriteLn(GetDriverName);

for a := 0 to GetMaxMode do

WriteLn(GetModeName(a):10);

ReadLn;

CloseGraph

end.

Процедура GetModeRange. Возвращает диапазон возможных режимов работы заданного графического адаптера. Заголовок:

Procedure GetModeRange(Drv: Integer; var Min, Max: Integer);

Здесь Drv - тип адаптера; Min - переменная типа Integer, в которой возвращается нижнее возможное значение номера режима; Мах - переменная того же типа, верхнее значение номера.

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

Uses Graph;

var

D,L,H: Integer;

const

N: array [1..11] of String [8] =

('CGA ', 'MCGA ', 'EGA ',

'EGA64 ', 'EGAMono ', ЧВМ8514 ',

'HercMono', 'ATT400 ', 'VGA ',

'PC3270 ', 'Ошибка ');

begin

WriteLn('Адаптер Мин. Макс.');

for D := 1 to 11 do

begin

GetModeRange(D, L, H);

WriteLn(N[D], L:7, H:10)

end

end.

КООРДИНАТЫ, ОКНА, СТРАНИЦЫ

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

Функции GetMaxX и GetMaxY. Возвращают значения типа Word, содержащие максимальные координаты экрана в текущем режиме работы соответственно по горизонтали и вертикали. Например:

Uses Graph;

var

a,b: Integer;

begin

a := Detect; InitGraph(a, b, '');

WriteLn(GetMaxX, GetMaxY:5);

ReadLn;

CloseGraph

end.

Функции GetX и GetY. Возвращают значения типа Integer, содержащие текущие координаты указателя соответственно по горизонтали и вертикали. Координаты определяются относительно левого верхнего угла окна или, если окно не установлено, экрана.

Процедура SetViewPort. Устанавливает прямоугольное окно на графическом экране. Заголовок:

Procedure SetViewPort(XI,Y1,X2,Y2: Integer; ClipOn: Boolean);

Здесь X1...Y2 - координаты левого верхнего (XI,Y1) и правого нижнего (X2,Y2) углов окна; СНрОп - выражение типа Boolean, определяющее «отсечку» не умещающихся в окне элементов изображения.

Координаты окна всегда задаются относительно левого верхнего угла экрана. Если параметр ClipOn имеет значение True, элементы изображения, не умещающиеся в пределах окна, отсекаются, в противном случае границы окна игнорируются. Для управления этим параметром можно использовать такие определенные в модуле константы:

const

ClipOn = True; {Включить отсечку}

ClipOff = False; {He включать отсечку}

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

Uses Graph,CRT;

var

x,y,e: Integer;

xll,yll,xl2,yl2, {Координаты 1-го окна}

x21,x22, {Левый верхний угол 2-го}

R, {Начальный радиус}

k: Integer;

begin

DirectVideo := False {Блокируем прямой доступ к видеопамяти в модуле CRT}

{Инициируем графический режим}

х := Detect; InitGraph(x, у, '');

{Проверяем результат}

е := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg (e) ) {Ошибка}

else

begin {Нет ошибки}

{Вычисляем координаты с учетом разрешения экрана}

x11:=GetMaxX div 60;

x12:=GetMaxX div 3;

y11:=GetMaxY div 4; y12:=2*y11;

R:=(x12-x11) div 4; x21:=x12*2;

x22:=x21+x12-x11;

{Рисуем окна}

WriteLnt'ClipOn:':10,'ClipOff:':40);

Rectangle(x11, y11, x12, y12); Rectangle(x21, y11 x22, y12);

{Назначаем 1-е окно и рисуем четыре окружности}

SetViewPort(x11, y11, x12, y12, ClipOn);

for k := 1 to 4 do

Circle(0,y11,R*k);

{Назначаем 2-е окно и рисуем окружности}

SetViewPort(x21, y11, x22, y12, ClipOff);

for k := 1 to 4 do

Circle(0,y11,R*k);

{Ждем нажатия любой клавиши}

if ReadKey=#0 then k := ord(ReadKey);

CloseGraph

end

end.

Процедура GetViewSettings. Возвращает координаты и признак отсечки текущего графического окна. Заголовок:

Procedure GetViewSettings(var Viewlnfo: ViewPortType);

Здесь Viewlnfo - переменная типа ViewPortType. Этот тип в модуле Graph определен следующим образом:

type

ViewPortType = record

x1,y1,x2,y2: Integer; {Координаты окна}

Clip : Boolean {Признак отсечки}

end ;

Процедура MoveTo. Устанавливает новое текущее положение указателя. Заголовок:

Procedure MoveTo(X,Y: integer);

Здесь X, Y - новые координаты указателя соответственно по горизонтали и вертикали.

Координаты определяются относительно левого верхнего угла окна или, если окно не установлено, экрана.

Процедура MoveRel. Устанавливает новое положение указателя в относительных координатах.

Procedure MoveRel(DX,DY: Integer);

Здесь DX.DY- приращения новых координат указателя соответственно по горизонтали и вертикали.

Приращения задаются относительно того положения, которое занимал указатель к моменту обращения к процедуре.

Процедура ClearDevice. Очищает графический экран. После обращения к процедуре указатель устанавливается в левый верхний угол экрана, а сам экран заполняется цветом фона, заданным процедурой SetBkColor. Заголовок:

Procedure ClearDevice;

Процедура ClearViewPort. Очищает графическое окно, а если окно не определено к этому моменту - весь экран. При очистке окно заполняется цветом с номером О из текущей палитры. Указатель перемещается в левый верхний угол окна. Заголовок:

Procedure ClearViewPort;

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

Uses CRT,Graph;

var

x1,y1,x2,y2,Err: Integer;

begin

{Инициируем графический режим}

xl := Detect; InitGraph(xl,x2,'');

Err := GraphResult; if ErrogrOk then

WriteLn(GraphErrorMsg(Err))

else

begin

{Определяем координаты окна с учетом разрешения экрана}

x1 := GetMaxX div 4,-y1 := GetMaxY div 4;

x2 := 3*x1; y2 := 3*y1;

{Создаем окно}

Rectangle(x1,y1,x2,y2);

SetViewPort(x1+1,y1+1,x2-1,y2-1,ClipOn);

{Заполняем окно случайными окружностями}

repeat

Сirclе(Random(Ge tMaxX),Random(Ge tMaxX)

Random(GetMaxX div 5))

until KeyPressed;

{Очищаем окно и ждем нажатия Enter}

ClearViewPort;

OutTextXY(0,0,'Press Enter...1);

ReadLn;

CloseGraph

end

end.

Процедура GetAspectRatio. Возвращает два числа, позволяющие оценить соотношение сторон экрана. Заголовок:

Procedure GetAspectRatio(var X,Y: Word);

Здесь X, Y - переменные типа Word. Значения, возвращаемые в этих переменных, позволяют вычислить отношение сторон графического экрана в пикселях. Найденный с их помощью коэффициент может использоваться при построении правильных геометрических фигур, таких как окружности, квадраты и т.п. Например, если Вы хотите построить квадрат со стороной L пикселей по вертикали, Вы должны использовать операторы

GetAspectRatio (Xasp, Yasp);

Rectangle(x1, y1, x1+L*round (Yasp/Xasp), y1+L);

а если L определяет длину квадрата по горизонтали, то используется оператор

Rectangle (x1,y1,x1+L,y1+L*round(Xasp/Yasp));

Процедура SetAspectRatio. Устанавливает масштабный коэффициент отношения сторон графического экрана. Заголовок:

Procedure SetAspectRatio(X,Y: Word);

Здесь X, Y- устанавливаемые соотношения сторон.

Следующая программа строит 20 окружностей с разными соотношениями сторон экрана

Uses Graph,CRT;

const

R =.50;

dx = 1000;

var

d,m,e,k : Integer;

Xasp,Yasp: Word;

begin

d := Detect;

InitGraph(d, m,.'');

e : = GraphResult;

if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

GetAspectRatio(Xasp, Yasp);

for k := 0 to 20 do

begin

SetAspectRatio(Xasp+k*dx,Yasp);

Circle(GetMaxX div 2,GetMaxY div 2,R)

end;

if ReadKey=#0 then k := ord(ReadKey);

CloseGraph

end

end.

Процедура SetActivePage. Делает активной указанную страницу видеопамяти. Заголовок:

Procedure SetActivePage(PageNum: Word);

Здесь PageNum - номер страницы.

Процедура может использоваться только с адаптерами, поддерживающими многостраничную работу (EGA, VGA и т.п.). Фактически процедура просто переадресует графический вывод в другую область видеопамяти, однако вывод текстов с помощью Write/WriteLn всегда осуществляется только на страницу, которая является видимой в данный момент (активная страница может быть невидимой). Нумерация страниц начинается с нуля.

ПроцедураSetVisualPage. Делает видимой страницу с указанным номером. Обращение:

Procedure SetVisualPAge(PageNum: Word);

Здесь PageNum - номер страницы.

Процедура может использоваться только с адаптерами, поддерживающими многостраничную работу (EGA, VGA и т.п.). Нумерация страниц начинается с нуля.

Следующая программа сначала рисует квадрат в видимой странице и окружность -в невидимой. После нажатия на Enter происходит смена видимых страниц.

Uses Graph;

var

d,m,e: Integer;

s : String;

begin

d := Detect; InitGraph(d, m, '');

e := GraphResult; if e <> grOk then

WriteLn (GraphErrorMsg(e))

else {Нет ошибки. Проверяем, поддерживает ли драйвер многостраничную работу с видеопамятью:}

if d in [HercMono,EGA,EGA64,MCGA,VGA] then

begin {Используем многостраничный режим}

if d<>HercMono then

SetGraphMode(m-1);

{Заполняем видимую страницу}

Rectangle(10,10,GetMaxX div 2,GetMaxY div 2);

OutTextXY(0,0,'Page 0. Press Enter...');

{Заполняем невидимую}

SetActivePage (1);

Circle(GetMaxX div 2, GetMaxY div 2, 100);

OutTextXY(0,GetMaxY-10,'Page 1. Press Enter...');

{Демонстрируем страницы}

ReadLn;

SetVisualPage(1);

ReadLn;

SetVisualPage (0);

ReadLn;

CloseGraph

end

else

begin {Драйвер не поддерживает многостраничный режим}

s := GetDriverName; CloseGraph;

WriteLn('Адаптер ',s,' использует только 1 страницу')

end

end.

Обратите внимание на оператор

if doHercMono then

SetGraphMode(m-1);

С его помощью гарантированно устанавливается многостраничный режим работы на адаптерах EGA, MCGA, VGA. Как уже говорилось, после инициации графики с Driver=Detect устанавливается режим работы с максимально возможным номером; перечисленные адаптеры в этом режиме могут работать только с одной графической страницей, чтобы обеспечить работу с двумя страницами, следует уменьшить номер режима.

ЛИНИИ И ТОЧКИ

Процедура PutPixel. Выводит заданным цветом точку по указанным координатам. Заголовок:

Procedure PutPixel(X,Y: Integer; Color: Word);

Здесь X, Y- координаты точки; Color - цвет точки.

Координаты задаются относительно левого верхнего угла окна или, если окно не установлено, относительно левого верхнего угла экрана.

Следующая программа периодически выводит на экран «звездное небо» и затем гасит его. Для выхода из программы нажмите любую клавишу.

Uses CRT, Graph;

type

PixelType = record

x, у : Integer; end;

const

N = 5000; {Количество "звезд"}

var

d,r,e,k: Integer;

x1,y1,x2,y2: Integer;

a: array [1..N] of PixelType; {Координаты}

begin

{Инициируем графику}

d := Detect; InitGraph(d, r, ' ') ;

e := GraphResult; if e<>grOk then

WriteLn(GraphErrorMsg(e))

else

begin

{Создаем окно в центре экрана}

x1 := GetMaxX div 4;

y1 := GetMaxY div 4;

x2 := 3*x1;

y2 := 3*y1;

Rectangle(x1,y1,x2,y2);

SetViewPort(x1+1,y1+1,x2-1,y2-1,ClipOn);

{Создаем и запоминаем координаты всех "звезд"}

for k := 1 to N do with a[k] do begin

x := Random(x2-x1);

у := Random(y2-y1)

end;

{Цикл вывода}

repeat

for k := 1 to N do

with a[k] do {Зажигаем "звезду"}

PutPixel(x,y,white);

if not KeyPressed then

for k := N downto 1 do with a[k] do {Гасим "звезду"}

PutPixel(x,y,black)

until KeyPressed;

while KeyPressed do k := ord(ReadKey);

CloseGraph

end;

end.

Функция GetPixel. Возвращает значение типа Word, содержащее цвет пикселя с указанными координатами. Заголовок:

Function GetPixel(X,Y: Integer): Word;

Здесь X, Y - координаты пикселя.

Процедура Line. Вычерчивает линию с указанными координатами начала и конца. Заголовок:

Procedure Line(X1,Y1,X2,Y2: Integer);

Здесь XL. .Yl - координаты начала (XI, Y1) и конца (Х2, Y2) линии.

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

Uses CRT, Graph;

var

d,r,e : Integer;

x1,y1,x2,y2: Integer;

begin

{Инициируем графику}

d := Detect; InitGraph(d, r, '');

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

{Создаем окно в центре экрана}

x1 := GetMaxX div 4;

y1 := GetMaxY div 4;

x2 := 3*x1;

y2 := 3*y1;

Rectangle(x1,y1,x2,y2);

SetViewPort(x1+1,y1+1,x2-1,y2-1,ClipOn);

{Цикл вывода случайных линий}

repeat

SetColor(succ(Random(16))); {Случайный цвет}

Line(Random(x2-x1), Random(y2-y1),

Random(x2-x1), Random(y2-y1))

until KeyPressed;

if ReadKey=#0 then d:= ord(ReadKey);

CloseGraph

end

end.

Процедура LineTo. Вычерчивает линию от текущего положения указателя до положения, заданного его новыми координатами. Заголовок:

Procedure LineTo(X,Y: Integer);

Здесь X, Y - координаты нового положения указателя, они же - координаты второго конца линии.

Процедура LineRel. Вычерчивает линию от текущего положения указателя до положения, заданного приращениями его координат. Заголовок:

Procedure LineRel (DX, DY: Integer);

Здесь DX, DY- приращения координат нового положения указателя. В процедурах LineTo и LineRel линия вычерчивается текущим стилем и текущим цветом.

Процедура SetLineStyle. Устанавливает новый стиль вычерчиваемых линий. Заголовок:

Procedure SetLineStyle(Type,Pattern,Thick: Word)

Здесь Type, Pattern, Thick - соответственно тип, образец и толщина линии. Тип линии может быть задан с помощью одной из следующих констант:

const

SolidLn= 0; {Сплошная линия}

DottedLn= 1; {Точечная линия}

CenterLn= 2; {Штрих-пунктирная линия}

DashedLn= 3; {Пунктирная линия}

UserBitLn= 4; {Узор линии определяет пользователь}

Параметр Pattern учитывается только для линий, вид которых определяется пользователем (т.е. в случае, когда Туре = UserBitLn). При этом два байта параметра Pattern определяют образец линии: каждый установленный в единицу бит этого слова соответствует светящемуся пикселю в линии, нулевой бит - несветящемуся пикселю. Таким образом, параметр Pattern задает отрезок линии длиной в 16 пикселей. Этот образец периодически повторяется по всей длине линии.

Параметр Thick может принимать одно из двух значений:

const

NormWidth = 1; {Толщина в один пиксель}

ThickWidth = 3; {Толщина в три пикселя}

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

В следующем примере демонстрируются линии всех стандартных стилей, затем вводятся слово-образец и линия с этим образцом заполнения (рис. 14.4). Для выхода из программы введите ноль.

Uses CRT, Graph;

const

style: array [0..4] of String [9] = (

'SolidLn ', 'DottedLn ', 'CenterLn 'DashedLn', 'UserBitLn');

var

d,r,e,i,j,dx,dy: Integer;

p: Word;

begin

{Инициируем графику}

d := Detect; InitGraph(d, r, '');

e := GraphResult; if e <> grOk then

WriteLn (GraphErrorMsg(e))

else

begin

{Вычисляем смещение линий}

dx := GetMaxX div 6;

dy := GetMaxY div 10;

{Выводим стандартные линии}

for j := 0 to 1 do {Для двух толщин}

begin

for i := 0 to 3 do {Четыре типа линий}

begin

SetLineStyle(i, 0, j*2+1);

Line(0,(i+j*4+l)*dy,dx,(i+j*4+l)*dy);

OutTextXY(dx+10, (i+j*4+l)*dy,style [i])

end

end;

{Вводим образец и чертим линию}

j := 0;

dy := (GetMaxY+1) div 25;

repeat

OutTextXY(320,j*dy,'Pattern: ');

GotoXY(50,j+1);

ReadLn(p); if p <> 0 then

begin

SetLineStyle(UserBitLn,p,NormWidth);

Line(440,j*dy+4, 600, j*dy+4);

inc(j)

end

until p = 0;

CloseGraph

end

end.

Процедура GetLineSettings. Возвращает текущий стиль линий. Заголовок:

Procedure GetLineSettings(var Stylelnfo: LineSettingsType)

Здесь Stylelnfo - переменная типа LineSettingsType, в которой возвращается текущий стиль линий.

Тип LineSettingsType определен в модуле Graph следующим образом:

type

LineSettingsType = record

LineStyle: Word; {Тип линии}

Pattern : Word; {Образец}

Thickness: Word {Толщина}

end;

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

Procedure SetWriteMode(Mode);

Здесь Mode - выражение типа Integer, задающее способ взаимодействия выводимых линий с изображением.

Если параметр Mode имеет значение 0, выводимые линии накладываются на существующее изображение обычным образом (инструкцией МОV центрального процессора). Если значение 1, то это наложение осуществляется с применением логической операции XOR (исключительное ИЛИ): в точках пересечения выводимой линии с имеющимся на экране изображением светимость пикселей инвертируется на обратную, так что два следующих друг за другом вывода одной и той же линии на экран не изменят его вид.

Режим, установленный процедурой SetWriteMode, распространяется на процедуры Drawpoly, Line, LineRel, LineTo и Rectangle. Для задания параметра Mode можно использовать следующие определенные в модуле константы:

const

CopyPut = 0;{Наложение операцией MOV}

XORPut = 1;{Наложение операцией XOR}

В следующем примере на экране имитируется вид часового циферблата (рис. 1.4.5). Для наглядной демонстрации темп хода «часов» ускорен в 600 раз (см. оператор Delay (100)). При желании Вы сможете легко усложнить программу, связав ее показания с системными часами и добавив секундную стрелку. Для выхода из программы нажмите на любую клавишу.

Uses Graph, CRT;

var

d,r,r1,r2,rr,k,

x1,y1,x2,y2,x01,y01: Integer;

Xasp,Yasp : Word;

begin

{Инициируем графику}

d := detect; InitGraph(d, r, '');

k := GraphResult; if k <> grOK then

WriteLn(GraphErrorMSG(k))

else

begin

{Определяем отношение сторон и размеры экрана}

x1 := GetMaxX div 2;

y1 := GetMaxY div 2;

GetAspectRatio(Xasp, Yasp);

{Вычисляем радиусы:}

r:= round(3*GetMaxY*Yasp/8/Xasp);

r1 := round(0.9*r); {Часовые деления}

г2 := round(0.95*r); {Минутные деления}

{Изображаем циферблат}

Circle(x1,y1,r); {Первая внешняя окружность}

Circle(x1,y1,round(1.02*г) ); {Вторая окружность}

for k := 0 to 59 do {Деления циферблата}

begin

if k mod 5=0 then

rr := r1 {Часовые деления}

else

rr : = r2; {Минутные деления}

{Определяем координаты концов делений}

x0l := x1+Round(rr*sin(2*pi*k/60));

y0l := y1-Round(rr*Xasp*cos(2*pi*k/60)/Yasp);

x2 := x1+Round(r*sin(2*pi*k/60));

y2 := y1-Round(r*Xasp*cos(2*pi*k/60)/Yasp);

Line(x01,y01,x2,y2) {Выводим деление}

end;

{Готовим вывод стрелок}

SetWriteMode(XORPut);

SetLineStyle(SolidLn,0,ThickWidth);

{Счетчик минут в одном часе}

{k = минуты}

r := 0;

{Цикл вывода стрелок}

repeat

for k := 0 to 59 do if not KeyPressed then begin

(Координаты часовой стрелки} x2 := x1+Round(0.85*r1*sin(2*pi*r/60/12));

y2 := y1-Round(0.85*r1*Xasp*cos(2*pi*r/60/12)/Yasp);

{Координаты минутной стрелки}

x01 := x1+Round(r2*sin(2*pi*k/60));

y01 := y1-Round(r2*Xasp*cos(2*pi*k/60)/Yasp);

{Изображаем стрелки}

Line(x1,y1,x2,y2);

Line(x1,y1,x01,y01) ;

Delay(100); {Для имитации реального темпа нужно установить задержку 60000}

{Для удаления стрелок выводим их еще раз!}

Line(x1,y1,x01,y01);

Line(x1,y1,х2,у2);

{Наращиваем и корректируем счетчик минут в часе}

inc(r); if r=12*60 then

r := 0

end

until KeyPressed;

if ReadKey=#0 then k := ord(ReadKey);

CloseGraph

end

end.

МНОГОУГОЛЬНИКИ

Процедура Rectangle. Вычерчивает прямоугольник с указанными координатами углов. Заголовок:

Procedure Rectangle(X1,Y1,X2,Y2: Integer);

Здесь X1... Y2 - координаты левого верхнего (X1, Y1) и правого нижнего (Х2, Y2) углов прямоугольника. Прямоугольник вычерчивается с использованием текущего цвета и текущего стиля линий.

В следующем примере на экране вычерчиваются 10 вложенных друг в друга прямоугольников.

Uses Graph, CRT;

var

d,r,e,xl,yl, x2,y2,dx,dy: Integer;

begin

{Инициируем графику}

d := Detect; InitGraph(d, r, ' ') ;

e := GraphResult; if e <> grOK then

WriteLn(GraphErrorMsg(e))

else

begin

{Определяем приращения сторон}

dx := GetMaxX div 20;

dy := GetMaxY div 20;

{Чертим вложенные прямоугольники}

for d := 0 to 9 do

Rectangle(d*dx,d*dy,GetMaxX-d*dx,GetMaxY-d*dy);

if ReadKey=#0 then d := ord(ReadKey);

CloseGraph

end

end.

Процедура DrawPoly. Вычерчивает произвольную ломаную линию, заданную координатами точек излома.

Procedure DrawPoly(N: Word; var Points)

Здесь N - количество точек излома, включая обе крайние точки; Points - переменная типа PointType, содержащая координаты точек излома.

Координаты точек излома задаются парой значений типа Word: первое определяет горизонтальную, второе - вертикальную координаты. Для них можно использовать следующий определенный в модуле тип:

type

PointType = record

х, у : Word

end;

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

Uses Graph;

const

N = 100; {Количество точек графика}

var

d, r, e: Integer;

m : array [O..N+1] of PointType; k : Word;

begin

{Инициируем графику}

d := Detect; InitGraph(d, r, '');

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

{Вычисляем координаты графика}

for k := 0 to N do with m[k] do

begin

x := trunc(k*GetMaxX/N);

у := trunc(GetMaxY*(-sin(2*Pi*k/N)+1)/2)

end;

{Замыкаем график прямой линией}

m[succ(N)].x := m[0] .x;

m[succ(n)].y := m[0] .у;

DrawPoly(N + 2, m);

ReadLn;

CloseGraph

end

end.

В этом примере для проведения горизонтальной прямой используется «замыкание» ломаной - первая и последняя координаты ее точек излома совпадают.

Замечу, что хотя количество точек излома N - выражение типа Word, на самом деле внутри процедуры на этот параметр накладываются ограничения, связанные с конечным размером используемой буферной памяти. Вы можете убедиться в этом с помощью, например, изменения N в предыдущем примере: при N=678 график перестанет выводиться на экран, а функция GraphResult будет возвращать значение -6 (не хватает памяти для просмотра областей). Таким образом, для этой программы пороговое значение количества точек излома составляет 679. В то же время для программы

Uses Graph;

const

N=510; {Предельное значение, при котором на экране еще видна диагональная линия}

var

d,k: Integer;

Coo: array [1..N] of PointType;

begin

d := Detect; InitGraph(d,k,' ') ;

for k := 1 to N do with Coo[k] do

if odd(k) then

begin

X := 0;

Y := 0

end

else

begin

X := GetMaxX;

Y := GetMaxY

end;

DrawPoly(N,Coo);

ReadLn;

CloseGraph

end.

это значение равно 510. В этой программе ломаная задается в виде многократно накладывающихся друг на друга диагональных линий.

ДУГИ, ОКРУЖНОСТИ, ЭЛЛИПСЫ

Процедура Circle. Вычерчивает окружность. Заголовок:

Procedure Circle(X,Y: Integer; R: Word);

ЗдесьX, Y- координаты центра; R - радиус в пикселях.

Окружность выводится текущим цветом. Толщина линии устанавливается текущим стилем, вид линии всегда SolidLn (сплошная). Процедура вычерчивает правильную окружность с учетом изменения линейного размера радиуса в зависимости от его направления относительно сторон графического экрана, т.е. с учетом коэффициента GetAspectRatio. В связи с этим параметр R определяет количество пикселей в горизонтальном направлении.

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

Uses Graph, CRT;

var

d,r,e,x,y: Integer;

begin.

{Инициируем графику}

d i= Detect; InitGraph(d, r, '');

e := GraphResult; if e <> grOK then

WriteLn(GraphErrorMsg(e))

else

begin

{Создаем окно в центре экрана}

х := GetMaxX div 4;

у := GetMaxY div 4;

Rectangle(х,у,3*х,3*у);

SetViewPort(x+1,y+1,3*x-1,3*y-1,ClipOn);

{Цикл вывода случайных окружностей}

repeat

SetColor(succ(Random(white))); {Случайный цвет}

SetLineStyle(0,0,2*Random(2)+1); {и стиль линии}

х := Random(GetMaxX); {Случайное положение}

у := Random(GetMaxY); {центра окружности}

Circle(х,у,Random(GetMaxY div 4));

until KeyPressed;

if ReadKey=#0 then x := ord(ReadKey);

CloseGraph

end

end.

Процедура Arc. Чертит дугу окружности. Заголовок:

Procedure Arc(X,Y: Integer; BegA,EndA,R: Word);

Здесь X, Y - координаты центра; BegA, EndA - соответственно начальный и конечный углы дуги; R - радиус.

Углы отсчитываются против часовой стрелки и указываются в градусах. Нулевой угол соответствует горизонтальному направлению вектора слева направо. Если задать значения начального угла 0 и конечного - 359, то будет выведена полная окружность. При вычерчивании дуги окружности используются те же соглашения относительно линий и радиуса, что и в процедуре Circle.

Вот как выглядят две дуги: одна с углами 0 и 90, вторая 270 и 540 градусов (рис. 14.6):

Следующая программа создает это изображение:

Uses Graph, CRT;

var

d, r, е : Integer;

Xasp,Yasp: Word;

begin

{Инициируем графику}

d := Detect;

InitGraphtd, r, '');

e := GraphResult; if e <> grOK then

WriteLn(GraphErrorMsg(e))

else

begin

GetAspectRatio(Xasp,Yasp);

{R = 1/5 от вертикального размера экрана}

r := round(Yasp*GetMaxY/5/XAsp);

d := GetMaxX div 2; {Смещение второго графика}

e : = GetMaxY div 2; {Положение горизонтальной оси}

{Строим левый график}

Line (0,e,5*r div 2,e); {Горизонтальная ось}

Line (5*r div 4,e div 2,5*r div 4,3*e div 2) ;

Arc (5*r div 4,e,0,90,R); {Дуга}

OutTextXY(0,e+e div 8,'0 - 90'); {Надпись}

{Правый график}

Line (d,e,d+5*r div 2,e);

Line (d+5*r div 4,e div 2, d+5*r div 4,3*e div 2);

Arc (d+5*r div 4,e,270,540,R);

OutTextXY(d,e+e div 8,'270 - 540');

{Ждем нажатия на любую клавишу}

if ReadKey=#0 then d := ord(ReadKey);

CloseGraph

end

end.

Процедура GetArcCoords. Возвращает координаты трех точек: центра, начала и конца дуги. Заголовок:

Procedure GetArcCoords(var Coords: ArcCoordsType);

Здесь Coords - переменная типа ArcCoordsType, в которой процедура возвращает координаты центра, начала и конца дуги.

Тип ArcCoordsType определен в модуле Graph следующим образом:

type

ArcCoordsType = record

X,Y : Integer; {Координаты центра}

Xstart,Ystart: Integer; {Начало дуги}

Xend,Yend : Integer; {Конец дуги}

end;

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

Uses Graph,CRT;

const

RadX = 50; {Горизонтальный радиус}

lx = 400; {Ширина}

ly = 100; {Высота}

var

d,r,e: Integer;

coo : ArcCoordsType;

x1,y1: Integer;

xa,ya: Word;

RadY : Integer; {Вертикальный радиус}

begin

{Инициируем графику}

d := Detect; InitGraph(d, r, ' ') ;

e := GraphResult; if e <> grOK then

WriteLn(GraphErrorMsg(e))

else

begin

GetAspectRatio(xa,ya) ; {Получаем отношение сторон}

{Вычисляем вертикальный радиус и положение фигуры с учетом отношения сторон экрана}

RadY := round (RadX *( xa /ya) );

x1 := (GetMaxX-lx) div 2;

y1 := (GetMaxY-2*RadY-ly) div 2;

{Вычерчиваем фигуру}

Line (x1,y1,x1+lx,y1); {Верхняя горизонтальная}

Arc (x1+lx,y1+RadY,0,90,RadX) ; {Скругление}

GetArcCoords(coo);

with coo do

begin

Line(Xstart,Ystart,Xstart,Ystart+ly);

{Правая вертикальная}

Arc(Xstart-RadX,Ystart+ly,270,0,RadX);

GetArcCoords (coo);

Line(Xstart,Ystart,Xstart-lx,Ystart);

{Нижняя горизонтальная}

Arc(Xstart-lx,Ystart-RadY,180,270,RadX);

GetArcCoords(coo);

Line(Xstart,Ystart,Xstart,Ystart-ly);

Arc(Xstart+RadX,Ystart-ly,90,180,RadX)

end ;

if ReadKey=#0 then d := ord(ReadKey);

CloseGraph

end

end.

Процедура Ellipse. Вычерчивает эллипсную дугу. Заголовок:

Procedure Ellipse(X,Y: Integer; BegA,EndA,RX,RY: Word);

Здесь X, Y - координаты центра; BegA, EndA - соответственно начальный и конечный углы дуги; RX, RY- горизонтальный и вертикальный радиусы эллипса в пикселях.

При вычерчивании дуги эллипса используются те же соглашения относительно линий, что и в процедуре Circle, и те же соглашения относительно углов, что и в процедуре Arc. Если радиусы согласовать с учетом масштабного коэффициента GetAspectRatio, будет вычерчена правильная окружность.

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

Uses Graph, CRT;

var

d,r,e: Integer;

xa,ya: Word;

begin

{Инициируем графику}

d := Detect; InitGraph(d, r, '');

e := GraphResult; if e <> grOK then

WriteLn(GraphErrorMsg(e))

else

begin

{Первый график}

OutTextXY(5 0,4 0,'RX = RY'); {Надпись}

Line (0,100,160,100); {Ось X}

Line (80,55,80,145); {Ось Y}

Ellipse (80,100,180,90,40,40);

{Второй график}

OutTextXY(260,40,'RX = 5*RY');

Line (190,100,410,100);

Line (300,55,300,145);

Ellipse (300,100,0,359,100,20);

{Третий график}

OutTextXY(465,40,'Aspect Ratio');

Line (440,100,600,100);

Line (520,55,520,145);

GetAspectRatio(xa, ya);

Ellipse (520,100,0,270,40,round(40*(xa/ya)));

if ReadKey=#0 then

d := ord(ReadKey);

CloseGraph

end

end.