- 14.1. Переход в графический режим и возврат в текстовый
- 14.1.1. Краткая характеристика графических режимов работы дисплейных адаптеров
- 14.1.2. Процедуры и функции
- 14.2. Координаты, окна, страницы
- 14.3. Линии и точки
- 14.4. Многоугольники
- 14.5. Дуги, окружности, эллипсы
- 14.6. Краски, палитры, заполнения
- 14.7. Сохранение и выдача изображений
- 14.8. Вывод текста
- 14.9. Включение драйвера и шрифтов в тело программы

Начиная с версии 4.0, в состав Турбо Паскаля включена мощная библиотека графических подпрограмм Graph, остающаяся практически неизменной во всех последующих версиях. Библиотека содержит в общей сложности более 50 процедур и функций, предоставляющих программисту самые разнообразные возможности управления графическим экраном. Для облегчения знакомства с библиотекой все входящие в нее процедуры и функции сгруппированы по функциональному принципу.

14.1. ПЕРЕХОД В ГРАФИЧЕСКИЙ РЕЖИМ И ВОЗВРАТ В ТЕКСТОВЫЙ

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

14.1.1. Краткая характеристика графических режимов работы дисплейных адаптеров

Настройка графических процедур на работу с конкретным адаптером достигается за счет подключения нужного графического драйвера. Драйвер - это специальная программа, осуществляющая управление теми или иными техническими средствами ПК. Графический драйвер, как это не трудно догадаться, управляет дисплейным адаптером в графическом режиме. Графические драйверы разработаны фирмой Borland практически для всех типов адаптеров. Обычно они располагаются на диске в отдельном подкаталоге BGI в виде файлов с расширением BGI (от англ.: Borland Graphics Interface - графический интерфейс фирмы Borland). Например, CGA.BGI - драйвер для CG4-адаптера, EGA VGA.BGI - драйвер для адаптеров EGA и VGA и т.п.

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

Графические возможности конкретного адаптера определяются разрешением экрана, т.е. общим количеством пикселей, а также количеством цветов (оттенков), которыми может светиться любой из них. Кроме того, многие адаптеры могут работать с несколькими графическими страницами. Графической страницей называют область оперативной памяти, используемая для создания «карты» экрана, т.е. содержащая информацию о светимости (цвете) каждого пикселя. Ниже приводится краткая характеристика графических режимов работы наиболее распространенных адаптеров.

Адаптер CGA (Color Graphics Adapter - цветной графический адаптер) имеет 5 графических режимов. Четыре режима соответствуют низкой разрешающей способности экрана (320 пикселей по горизонтали и 200 по вертикали, т.е. 320x200) и отличаются только набором допустимых цветов - палитрой. Каждая палитра состоит из трех цветов, а с учетом черного цвета несветящегося пикселя - из четырех: палитра 0 (светло-зеленый, розовый, желтый), палитра 1 (светло-бирюзовый, малиновый, белый), палитра 2 (зеленый, красный, коричневый) и палитра 3 (бирюзовый, фиолетовый, светло-серый). Пятый режим соответствует высокому разрешению 640x200, но каждый пиксель в этом случае может светиться либо каким-то одним заранее выбранным и одинаковым для всех пикселей цветом, либо не светиться вовсе, т.е. палитра этого режима содержит два цвета. В графическом режиме адаптер CGA использует только одну страницу.

Адаптер EGA (Enhanced Graphics Adapter - усиленный графический адаптер) может полностью эмулировать графические режимы адаптера CGA. Кроме того, в нем возможны режимы: низкого разрешения (640x200, 16 цветов, 4 страницы) и высокого разрешения (640x350, 16 цветов, 1 страница). В некоторых модификациях используется также монохромный режим (640x350, 1 страница, 2 цвета).

Адаптер MCGA (Multi-Color Graphics Adapter - многоцветный графический адаптер) совместим с CGA и имеет еще один режим - 640x480, 2 цвета, 1 страница. Такими адаптерами оснащались младшие модели серии ПК PS/2 фирмы IBM. Старшие модели этой серии оснащаются более совершенными адаптерами VGA (Video Graphics Array -графический видеомассив. Адаптер VGA эмулирует режимы адаптеров CGA и EGA и дополняет их режимом высокого разрешения (640x480, 16 цветов, 1 страница).

Не так давно появились так называемые cynep-VGA адаптеры (SVGA) с разрешением 800x600 и более, использующие 256 и более цветовых оттенков. В настоящее время эти адаптеры получили повсеместное распространение, однако в библиотеке Graph для них нет драйверов. Поскольку SVGA совместимы с VGA, для управления современными графическими адаптерами приходится использовать драйвер EGAVGA.BGI и довольствоваться его относительно скромными возможностями.

Несколько особняком стоят достаточно популярные адаптеры фирмы Hercules. Адаптер HGC имеет разрешение 720x348, его пиксели могут светиться одним цветом (обычно светло-коричневым) или не светиться вовсе, т.е. это монохромный адаптер. Адаптер HGC+ отличается несущественными усовершенствованиями, а адаптер HIСС (Hercules In Color Card) представляет собой 16-цветный вариант HGC+.

14.1.2. Процедуры и функции

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

Procedure InitGraph(var Driver,Mode: Integer; Path: String);

Здесь Driver - переменная типа Integer, определяет тип графического драйвера; Mode - переменная того же типа, задающая режим работы графического адаптера; Path - выражение типа String, содержащее имя файла драйвера и, возможно, маршрут его поиска.

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

const

Detect=0;{Режим автоопределения типа}

CGA=1;

MCGA=2;

EGA=3;

EGA64=4;

EGAMono=5;

IBM8514=6;

HercMono=7;

ATT400=8;

VGA=9;

PC3270=10;

Большинство адаптеров могут работать в различных режимах. Для того, чтобы указать адаптеру требуемый режим работы, используется переменная Mode, значением которой в момент обращения к процедуре могут быть такие константы:
const

{ Адаптер CGA : }

CGACO = 0;
{Низкое разрешение, палитра
0}

CGAC1 = 1;
{Низкое разрешение, палитра
1}

CGAC2 = 2;
{Низкое разрешение, палитра
2}

CGAC3 = 3;
{Низкое разрешение, палитра
3}

CGAHi = 4;
{Высокое разрешение}

{Адаптер MCGA:}

MCGACO = 0;
{Эмуляция CGACO}

MCGAC1 = 1;
{Эмуляция CGAC1}

MCGAC2 = 2;
{Эмуляция CGAC2}

MCGAC3 = 3;
{Эмуляция CGAC3}

MCGAMed = 4;
{Эмуляция CGAHi}

MCGAHi = 5;
{640x480}

{Адаптер EGA :}

EGALo = 0;
{640x200, 16 цветов}

EGAHi = 1;
{640x350, 16 цветов}

EGAMonoHi = 3;
{640x350, 2 цвета}

{Адаптеры HGC и
HGC+:}

HercMonoHi = 0;
{720x348}

{АдаптерАТТ400:}

ATT400CO = 0;
{Аналог режима CGACO}

ATT400C1 = 1;
(Аналог режима CGAC1}

ATT400C2 = 2;
{Аналог режима CGAC2}

ATT400C3 = 3;
{Аналог режима CGAC3}

ATT400Med = 4;
{Аналог режима CGAHi}

ATT400H1 = 5;
{640x400, 2 цвета}

{Адаптер VGA:}

VGALo = 0; {640x200}

VGAMed = 1; {640x350}

VGAHi = 2; {640x480}

PC3270H1 = 0; {Аналог HercMonoHi}

{Адаптер 1ВМ8514}

IBM8514LO =0; {640x480, 256 цветов}

IBM8514H1 = 1; {1024x768, 256 цветов}

Пусть, например, драйвер CGA.BGI находится в каталоге TP\BGI на диске С и устанавливается режим работы 320x200 с палитрой 2. Тогда обращение к процедуре будет таким:

Uses Graph;

var

Driver, Mode : Integer;

begin

Driver := CGA;{Драйвер}

Mode := CGAC2;{Режим работы}

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

.......

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

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.

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

Многие графические процедуры и функции используют указатель текущей позиции на экране, который в отличие от текстового курсора невидим. Положение этого указателя, как и вообще любая координата на графическом экране, задается относительно левого верхнего угла, который, в свою очередь, имеет координаты 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 включать отсечку}

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

Рис. 14.1. Отсечка изображения в окне

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;

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

Рис. 14.2. Окно со случайными окружностями

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 окружностей с разными соотношениями сторон экрана (рис. 14.3).

Рис.14.3. Окружности при разных отношениях сторон экрана

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 устанавливается режим работы с максимально возможным номером; перечисленные адаптеры в этом режиме могут работать только с одной графической страницей, чтобы обеспечить работу с двумя страницами, следует уменьшить номер режима.

14.3. ЛИНИИ И ТОЧКИ

Процедура 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). Для выхода из программы введите ноль.

Рис.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)). При желании Вы сможете легко усложнить программу, связав ее показания с системными часами и добавив секундную стрелку. Для выхода из программы нажмите на любую клавишу.

Рис. 14.5. Часовой циферблат

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.

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

Процедура 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. В этой программе ломаная задается в виде многократно накладывающихся друг на друга диагональных линий.

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

Процедура 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):

Рис.14.6. Иллюстрация процедуры Arc

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

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, будет вычерчена правильная окружность.

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

Рис.14.7. Эллипсные дуги

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.

14.6. КРАСКИ, ПАЛИТРЫ, ЗАПОЛНЕНИЯ

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

Procedure SetColor(Color: Word);

Здесь Color - текущий цвет.

В модуле Graph определены точно такие же константы для задания цвета, как и в модуле СИГ (см. п.13.2).

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

Function GetColor: Word;

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

Function GetMaxColor: Word;

Процедура SetBkColor. Устанавливает цвет фона. Заголовок:

Procedure SetBkColor(Color: Word);

Здесь Color - цвет фона.

В отличие от текстового режима, в котором цвет фона может быть только темного оттенка, в графическом режиме он может быть любым. Установка нового цвета фона немедленно изменяет цвет графического экрана. Это означает, что нельзя создать изображение, два участка которого имели бы разный цвет фона. Для CGA -адаптера в режиме высокого разрешения установка цвета фона изменяет цвет активных пикселей. Замечу, что после замены цвета фона на любой, отличный от 0 (Black) цвет, Вы не сможете более использовать цвет 0 как черный, он будет заменяться на цвет фона, т.к. процедуры модуля Graph интерпретируют цвет с номером 0 как цвет фона. Это означает, в частности, что Вы уже не сможете вернуть фону черный цвет!

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

Uses Graph, CRT;

const

NC: array [0..15] of String [12] =

('Black','Blue','Green','Cyan','Red','Magenta',

' Brown','LightGray','DarkGray','LightBlue',

'LightGreen1,'LightCyan1,'LightRed',

'LightMagenta','Yellow','White');

var

d, r, e, k, color, dx, dy: Integer;

begin

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

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

e := GraphResult; if e <> grOK then

WriteLn(GraphErrorMsg(e))

else

begin

{Выводим текст в центре экрана}

OutTextXY(200,GetMaxY div 2,'BACKGROUND COLOR');

dx := GetMaxX div 30; {Приращение длины}

dy := GetMaxY div 25; {Приращение высоты}

for k := 0 to 9 do{Выводим 10 прямоугольников}

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

color := black; {Начальный цвет фона}

repeat {Цикл смены фона}

SetBkColor(color) ;

SetFillStyle(0,Color);

Bar(345,GetMaxY div 2,440,GetMaxY div 2+8);

OutTextXY(345,GetMaxY div 2,NC[color]);

delay(1000);

inc(color);

if color > White then

color := Black until KeyPressed;

if ReadKey=#0 then

k := ord(ReadKey);

CloseGraph

end

end.

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

Function GetBkColor: Word;

Процедура SetPalette. Заменяет один из цветов палитры на новый цвет. Заголовок:

Procedure SetPalette(N: Word; Color: Shortlnt);

Здесь N - номер цвета в палитре; Color - номер вновь устанавливаемого цвета.

Данная процедура может работать только с адаптерами EGA или VGA. Она не должна использоваться с IBM8514 или 256-цветным вариантом VGA - для этих адаптеров предназначена особая процедура SetRGBPalette (см. ниже). Первоначальное размещение цветов в палитрах EGA/VGA соответствует последовательности их описания константами Black,....White, т.е. цвет с индексом 0 - черный, 1 - синий, 2 - зеленый и т.д. После обращения к процедуре все фрагменты изображения, выполненные цветом с индексом N из палитры цветов, получат цвет Color. Например, если выполнить оператор

SetPalette(2,White);

то цвет с индексом 2 (первоначально это - бирюзовый цвет Cyan) будет заменен на белый. Замечу, что цвет с индексом 0 отождествляется с цветом фона и может изменяться наряду с любым другим цветом.

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

Uses Graph, CRT;

var

d,r,e,N,k,color: Integer;

Palette : PaletteTyper;

begin

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

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

e := GraphResult; if e <> grOK then

WriteLn(GraphErrorMsg(e))

else

begin

{Выбираем толстые сплошные линии}

SetLineStyle(SolidLn, 0, ThickWidth);

GetPalette(Palette) ; {Текущая палитра}

for Color := 0 to Palette.Size-1 do

begin

SetColor(Color);

Line(GetMaxX div 3,Color*10,2*GetMaxX div 3,Color*10)

end;

{Меняем палитру и ждем инициативы пользователя}

while not KeyPressed do

for e := 0 to Palette.Size-1 do

SetPalette(e,Random(Palette.Size));

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

CloseGraph

end

end.

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

Procedure GetPalette(var Palettelnfo: PaletteType);

Здесь Palettelnfo - переменная типа PaletteType, возвращающая размер и цвета палитры.

В модуле Graph определена константа

const

MaxColors =15;

и тип

type

PaletteType = record

Size : Word; {Количество цветов в палитре}

Colors : array [0..MaxColors] of Shortlnt

{Номера входящих в палитру цветов}

end;

С помощью следующей программы можно вывести на экран номера всех возможных цветов из текущей палитры.

Uses Graph;

var

Palette: PaletteType;

d,r,e,k: Integer;

begin

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

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

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

GetPalette(Palette); {Получаем палитру}

CloseGraph; {Возвращаемся в текстовый режим}

with Palette do {Выводим номера цветов}

for k := 0 to pred(Size) do

Write(Colors[k]:5);

end

end.

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

Procedure SetAllPalette(var Palette);

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

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

Uses Graph, CRT;

var

Palette: array [0..MaxColors] of Shortint;

d,r,e,k: Integer;

begin

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

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

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

{Выбираем толстые сплошные линии}

SetLineStyle(SolidLn, 0, ThickWidth);

{Выводим линии всеми доступными цветами}

for k := 1 to GetMaxColor do

begin

SetColor(k);

Line(GetMaxX div 3,k*10,2*GetMaxX div 3,k*10)

end;

Palette[0] := MaxColors; {Размер палитры}

repeat {Цикл смены палитры}

for k := 1 to MaxColors do

Palette[k] := Random(succ(MaxCoLors));

SetAllPalette(Palette)

until KeyPressed;

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

CloseGraph

end

end.

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

Function GetPaletteSize: Integer;

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

Procedure GetDefaultPalette(var Palette: PaletteType);

Здесь Palette - переменная типа PaletteType (см. процедуру GetPalette), в которой возвращаются размер и цвета палитры.

Процедура SetFillStyle. Устанавливает стиль (тип и цвет) заполнения. Заголовок:

Procedure SetFillStyle(Fill,Color: Word);

Здесь Fill - тип заполнения; Color - цвет заполнения.

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

const

EmptyFill = 0;{Заполнение фоном (узор отсутствует)}

SolidFill = 1;{Сплошное заполнение}

LineFill = 2;{Заполнение -------}

LtSlashFill = 3;{Заполнение ///////}

SlashFill = 4;{Заполнение утолщенными ///}

BkSlashFill = 5;{Заполнение утолщенными \\\}

LtBkSlashFill = 6;{Заполнение \\\\\\\}

HatchFill = 7;{Заполнение +++++++}

XHatchFill = 8;{Заполнение ххххххх}

InterleaveFill= 9;{Заполнение прямоугольную клеточку}

WideDotFill = 10;{Заполнение редкими точками}

CloseDotFill = 11;{Заполнение частыми точками}

UserFill = 12;{Узор определяется пользователем}

Программа из следующего примера продемонстрирует Вам все стандартные типы заполнения.

Uses Graph, CRT;

var

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

begin

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

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

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

x := GetMaxX div 6;{Положение графика}

у := GetMaxY div 5;{на экране}

for j := 0 to 2 do{Два ряда}

for k := 0 to 3 do{По четыре квадрата}

begin

Rectangle((k+1)*x,(j+1)*y,(k+2)*x,(j+2)*y);

SetFillStyle(k+j*4,j+1);

Bar((k+1)*x+1,(j+1)*y+1,(k+2)*x-1,(j+2)*y-1)

end;

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

CloseGraph

end

end.

Если параметр Fill имеет значение 12 (UserFill), то рисунок узора определяется программистом путем обращения к процедуре SetFillPattern.

Процедура SetFillPattern. Устанавливает образец рисунка и цвет штриховки. Заголовок:

Procedure SetFillPattern(Pattern: FillPatternType;Color: Word);

Здесь Pattern - выражение типа FillPatternType; устанавливает образец рисунка для Fill - UserFill в процедуре SetFillStyle; Color - цвет заполнения.

Образец рисунка задается в виде матрицы из 8x8 пикселей и может быть представлен массивом из 8 байт следующего типа:

type

FillPatternType = array [1..8] of Byte;

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

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

Следующая программа заполняет этими образцами две прямоугольных области экрана.

Рис.14.8. Образцы заполнения и их коды

Uses Graph, CRT;

const

pattl: FillPatternType= ($49,$92,$49,$92,$49,$92,$49,$92);

patt2: FillPatternType= ($00,$18,$24,$42,$42,$24,$18,$00);

var

d,r,e: Integer;

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

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

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

if d=CGA then

SetGraphMode (0) ; {Устанавливаем цвет для CGA}

SetFillStyle(UserFill,White);

{Левый верхний квадрат}

SetFillPattern(Patt1,1);

Bar(0,0,GetMaxX div 2, GetMaxY div 2);

{Правый нижний квадрат}

SetFillPattern(Patt2,2);

Bar(GetMaxX div 2,GetMaxY div 2,GetMaxX,GetMaxY);

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

CloseGraph

end

end.

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

if d=CGA then

SetGraphMode(0);

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

SetFillPattern(patt2, 2);

содержит недопустимо большой для данного режима код цвета и обращение игнорируется. Сказанное, однако, не относится к процедуре SetFillStyle для значения параметра Fill в диапазоне от 0 до 11: программа будет нормально работать и в режиме высокого разрешения CGA-адаптера, причем все цвета палитры, кроме цвета фона, при этом заменяются на белый.

Процедура GetFillPattern. Возвращает образец заполнения, установленный ранее процедурой SetFillPattern. Заголовок:

Procedure GetFillPattern(var Pattern: FillPatternType);

Здесь Pattern - переменная типа FillPatternType, в которой возвращается образец заполнения.

Если программа не устанавливала образец с помощью процедуры SetFillPattern, массив Pattern заполняется байтами со значением 255 ($FF).

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

Procedure GetFillSettings(var Pattlnfo: FillSettingsType);

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

В модуле Graph определен тип:

type

FillSettingsType = record

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

Color : Word {Цвет}

end;

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

Процедура SetRGBPalette. Устанавливает цветовую гамму при работе с дисплеем IBM 8514 и адаптером VGA. Заголовок:

Procedure SetRGBPalette(ColNum,RedVal, GreenVal,BlueVal:Integer);

Здесь ColNum - номер цвета; RedVal, GreenVal, BlueVal - выражения типа Integer, устанавливающие интенсивность соответственно красной, зеленой и синей составляющих цвета.

Эта процедура может работать только с дисплеем IBM 8514, а также с адаптером VGA, использующим видеопамять объемом 256 Кбайт. В первом случае параметр ColNum задается числом в диапазоне 0...255, во втором - в диапазоне 0...15. Для установки интенсивности используются 6 старших разрядов младшего байта любого из параметров RedVal, GreenVal, BlueVal.

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

Uses Graph,CRT;

var

Driver, Mode, Err, xl, yl: Integer;

begin

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

Driver := Detect;

InitGraph(Driver, Mode, '');

Err := GraphResult;

if ErroO then

WriteLn(GraphErrorMsg(Err))

else if Driver in [IBM8514, VGA] then

begin

{Выводим прямоугольник в центре экрана}

x1 := GetMaxX div 4;

y1 := GetMaxY div 4;

SetColor(lS);

Bar(x1,y1,3*x1,3*y1);

{Изменяем белый цвет на случайный}

while not KeyPressed do

SetRGBPalette(15,Random(256),Random(256),Random(256));

CloseGraph

end

else

begin

CloseGraph; .

WriteLn('Адаптер не поддерживает ' , 'RGB-режим управления цветами')

end

end.

Процедура FloodFill. Заполняет произвольную замкнутую фигуру, используя текущий стиль заполнения (узор и цвет). Заголовок:

Procedure FloodFill(X,Y: Integer; Border: Word);

Здесь X, Y- координаты любой точки внутри замкнутой фигуры; Border - цвет граничной линии.

Если фигура незамкнута, заполнение «разольется» по всему экрану.

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

Следующая программа демонстрирует заполнение случайных окружностей. Сначала в центре экрана создается окно, в котором заполняется небольшой прямоугольник. Часть прямоугольника останется незаполненной, в чем Вы можете убедиться, так как программа в этот момент приостанавливает работу, ожидая нажатия на клавишу Enter. Затем осуществляется вывод и заполнение случайных окружностей до тех пор, пока не будет нажата любая клавиша. Замечу, что прямоугольник заполняется полностью, если вместо типа LtSlashFill (косая штриховка линиями обычной толщины) используется SlashFill (штриховка утолщенными линиями). Если программа будет работать достаточно долго, она может «зависнуть», что лишний раз свидетельствует о несовершенстве реализованного в ней алгоритма.

Uses Graph, CRT;

var

d, r, е, х, у, с : Integer;

begin

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

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

e := GraphResult;

if e <> grOk then . . WriteLn(GraphErrorMsg(e))

else

begin

{Создаем прямоугольное окно}

х := GetMaxX div 4;

у. := GetMaxY div 4;

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

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

{Демонстрируем заливку маленького прямоугольника}

SetPillStyle(LtSlashFill,GetMaxColor);

Rectangle(0,0,8,20); FloodFill(1,1,GetMaxColor);

OutTextXY(10,25,'Press Enter...');

ReadLn; {Ждем нажатия Enter}

{Выводим окружности до тех пор, пока не будет нажата любая клавиша}

repeat

{Определяем случайный стиль заливки}

SetFillStyle(Random(12),Random(GetMaxColor+1));

{Задаем координаты центра и цвет окружности}

х := Random (GetMaxX div 2);

у := Random (GetMaxY div 2);

с := Random (succ(GetMaxColor));

SetColor(c);

{Выводим и заливаем окружность}

Circle(x, у, Random(GetMaxY div 5));

FloodFill (x, у, с)

until KeyPressed;

if ReadKey=#0 then

x := ord(ReadKey);

CloseGraph

end

end.

Процедура Bar. Заполняет прямоугольную область экрана. Заголовок:

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

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

Процедура закрашивает (но не обводит) прямоугольник текущим образцом узора и текущим цветом, которые устанавливаются процедурой SetFillStyle.

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

Uses Graph, CRT;

var

d, r, e : Integer;

begin

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

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

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

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

d := GetMaxX div 4;

r := GetMaxY div 4; Rectangle(d,r,3*d,3*r);

SetViewPort(d+1,r+1,3*d-1,3*r-1,ClipOn);

{Цикл вывода и закраски случайных многоугольников}

repeat

SetFillStyle(Random(12),Random(succ(GetMaxColor)));

Bar(Random(Ge tMaxX),Random(Ge tMaxY),

Random(Ge tMaxX),Random(Ge tMaxY));

until KeyPressed;

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

CloseGraph

end

end.

Процедура Ваr3D. Вычерчивает трехмерное изображение параллелепипеда и закрашивает его переднюю грань . Заголовок:

Procedure Ваr3D (X1,Y1,X2,Y2,Depth: Integer; Top: Boolean);

Здесь X1... Y2 - координаты левого верхнего (X1, Y1) и правого нижнего (Х2, Y2) углов передней грани; Depth - третье измерение трехмерного изображения («глубина») в пикселях; Тор - способ изображения верхней грани.

Если параметр Тор имеет значение True, верхняя грань параллелепипеда вычерчивается, в противном случае - не вычерчивается (этот вариант используется для изображения поставленных друг на друга параллелепипедов, см. следующий пример). В качестве значения этого параметра может использоваться одна из следующих констант, определенных в модуле Graph:

const

TopOn = True;

TopOff = False;

При вычерчивании используется текущий стиль линий (SetLineStyle) и текущий цвет (SetColor). Передняя грань заливается текущим стилем заполнения (SetFillStyle).

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

Следующая программа иллюстрирует различные аспекты применения процедуры Bar3D.

Uses Graph,CRT;

var

d, r, e: Integer;

begin

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

d := Detect;

Ini-tGraph(d, r, ' ') ;

e := GraphResult;

if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

{Столбик с верхней гранью:}

Bar3D (80, 100, 120, 180, 15, TopOn);

{Столбик без верхней грани:}

Ваг3D (150, 150, 190, 180, 15, TopOff);

{Этот столбик "стоит" на следующем и прозрачен:}

Bar3D (230, 50, 250, 150, 15, TopOn);

Bar3D (220, 150, 260, 180, 15, TopOn);

{У этого столбика нет верхней грани, и поэтому он не мешает поставленному на него сверху:}

Bar3D (300, 150, 340, 180, 15, TopOff);

SetLineStyle(3,0,1);

SetColor(Yellow);

SetFillStyle(LtSlashFill,Yellow);

Bar3D (300, 50, 340, 150, 15, TopOn);

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

CloseGraph;

end

end.

Процедура Fill Poly. Обводит линией и закрашивает замкнутый многоугольник. Заголовок:

Procedure FillPoly(N: Word; var Coords);

Здесь N - количество вершин замкнутого многоугольника; Coords - переменная типа PointType, содержащая координаты вершин.

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

type

PointType = record

х, у : Integer

end;

Стиль и цвет линии контура задаются процедурами SetLineStyle и SetColor, тип и цвет заливки - процедурой SetFillStyle.

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

Uses Graph, CRT;

var

d, r, e: Integer;

p : array [1..6] of PointType; n, k : Word;

begin

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

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

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

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

d := GetMaxX div 4;

r := GetMaxY div 4;

Rectangle(d,r,3*d,3*r);

SetViewPort(d+l,r+l,3*d-l,3*r-l,ClipOn);

{Цикл вывода случайных закрашенных многоугольников}

repeat

{Выбираем случайный цвет и узор)

SetFillStyle(Random(12),Random(succ(GetMaxColor)));

SetColor (Random(succ(GetMaxColor)));

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

n := Random (4) + 3 ; for k := 1 to n do with p[k] do

begin

x := Random (GetMaxX div 2);

у := Random (GetMaxY div 2)

end;

FillPoly (n, p) {Выводим и закрашиваем}

until KeyPressed;

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

CloseGraph

end

end.

Процедура FillEllipse. Обводит линией и заполняет эллипс. Заголовок:

Procedure FillEllipse(X,Y,RX,RY: Integer);

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

Эллипс обводится линией, заданной процедурами SetLineStyle и SetColor, и заполняется с использованием параметров, установленных процедурой SetFillStyle.

Процедура Sector. Вычерчивает и заполняет эллипсный сектор. Заголовок: Procedure Sector(X,Y: Integer; BegA,EndA,RX,RY: Word);

Здесь BegA, EndA - соответственно начальный и конечный углы эллипсного сектора. Остальные параметры обращения аналогичны параметрам процедуры FillEllipse.

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

Uses Graph, CRT;

var

d, r, e : Integer;

begin

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

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

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

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

d := GetMaxX div 4;

r := GetMaxY div 4;

Rectangle(d,r,3*d,3*r);

SetViewPort(d+1,r+1,3*d-1,3*r-1,ClipOn);

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

repeat

SetFillStyle(Random(12), Random(succ(GetMaxColor)));

SetColor (Random(succ(GetMaxColor)));

Sector(Random(GetMaxX div),Random(GetMaxY div 2),

Random(360),Random(360),Random(GetMaxX div 5),

Random(GetMaxY div 5));

FillEl.lipse (Random (GetMaxX div 2),

Random(GetMaxY div 2),Random(GetMaxX div 5),

Random(GetMaxY div 5))

until KeyPressed;

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

CloseGraph

end

end.

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

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

В отличие от процедуры Sector, указывается лишь один горизонтальный радиус R, остальные параметры аналогичны параметрам процедуры Sector.

Сектор обводится линией, заданной процедурами SetLineStyle и SetColor, и заполняется с помощью параметров, определенных процедурой SetFillStyle. Процедуру удобно использовать при построении круговых диаграмм, как, например, в следующей программе (рис. 14.9).

Рис. 14.9. Иллюстрация процедуры PieSlice

Uses Graph, CRT;

var

d, r, e : Integer;

begin

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

d := Detect;

InitGraph(d, r, '');

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

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

SetFillStyle(WideDotFill, White);

PieSlice(GetMaxX div 2+5,GetMaxY div 2+4,270,360,100);

{Выводим большой сектор}

SetFillStyle (SolidFill, Red);

PieSlice (GetMaxX div 2,GetMaxY div 2, 0,270,100).;

{Выводим надписи}

OutTextXY (GetMaxX div 2+90,GetMaxY div 2+70, '25%');

OutTextXY(GetMaxX div 2-50,GetMaxY div 2-20, '75%');

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

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

Close,Graph

end

end.

14.7. СОХРАНЕНИЕ И ВЫДАЧА ИЗОБРАЖЕНИЙ

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

Function ImageSize(X1,Y1,X2,Y2: Integer): Word;

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

Процедура Getlmage. Помещает в память копию прямоугольного фрагмента изображения. Заголовок:

Procedure Getlmage(X1,Y1,X2,Y2: Integer; var Buf)

Здесь X1...Y2 - координаты углов фрагмента изображения; Buf - переменная или участок кучи, куда будет помещена копия видеопамяти с фрагментом изображения.

Размер Buf должен быть не меньше значения, возвращаемого функцией ImageSize с теми же координатами X1....Y2.

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

Procedure Putlmage(X,Y: Integer; var Buf; Mode: Word);

Здесь X,Y- координаты левого верхнего угла того места на экране, куда будет скопирован фрагмент изображения; Buf - переменная или участок кучи, откуда берется изображение; Mode - способ копирования.

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

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

const

NormalPut= 0;{Замена существующего изображения на копию}

XorPut = 1;{Исключительное ИЛИ}

OrPut = 2;{Объединительное ИЛИ}

AndPut = 3;{Логическое И}

NotPut = 4;{Инверсия изображения}

Наиболее часто используются операции NormalPut, XORPut и NotPut. Первая из них просто стирает часть экрана и на это место помещает копию из памяти в том виде, как она там сохраняется. Операция NotPut делает то же самое, но копия выводится в инверсном виде. Для монохромного режима это означает замену светящихся пикселей на темные и наоборот. В цветном режиме операция NotPut применяется к коду цвета каждого пикселя. Например, для White (код 15 или в двоичном виде 1111) эта операция даст код 0000 = 0 = Black, для Red = 4 = 0100 получим 1011 = 11 = LightCyan и т.д. Операция XORPut, примененная к тому же месту экрана, откуда была получена копия, сотрет эту часть экрана. Если операцию применить дважды к одному и тому же участку, вид изображения на экране не изменится. Таким способом можно довольно просто перемещать изображения по экрану, создавая иллюзию движения.

Следующая программа рисует «Неопознанный Летающий Объект» - летающую тарелку на звездном фоне (рис. 14.10).

Рис.14.10. Иллюстрация процедур Getlmage/Putlmage

Uses Graph, CRT;

const

r = 20; {Характерный размер НЛО}

pause = 50; {Длительность паузы}

var

d,m,e,xm/ym,x,y/lx,ly,rx,ry,

Size,i,dx,dy,Width,Height: Integer;

Saucer : Pointer;

label

loop;

begin

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

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

e := GraphResult; if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

x := r*5;

у := r*2;

xm := GetMaxX div 4;

ym := GetMaxY div 4;

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

Ellipse (х,у,0,360,r,r div 3+2); ,

Ellipse (х,у-4,190,357,r,r div 3);

Line (х+7,у-б,х+10,у-12);

Line (x-7,y-6, х-10, у-12);

Circle (x+10,y-12,2);

Circle (х-10,у-12,2);

FloodFill(x+l,y+4,White);

{Определяем габариты НЛО и помещаем его в кучу}

1х := х-r-1;

1у := у-14;

гх := х+r+1;

гу := у+r div 3+3;

Width := rx - lx + 1;

Height:= ry - ly + 1;

Size := ImageSize(lx, ly, rx, ry);

GetMem (Saucer, Size);

Getlmage (lx, ly, rx, ry, Saucer^);

{Стираем построенное}

Putlmage (lx, ly, Saucer^, xorPut);

{Создаем звездное небо}

Rectangle(xm,ym,3 *xm,3 *ym);

SetViewPort(xm+1,ym+1,3*xm-1,3*ym-1,ClipOn);

xm := 2*xm;

ym := 2*ym;

for i:=1 to 200 do

PutPixe1 (Random(xm), Random(ym), White) ;

{Задаем начальное положение НЛО и направление движения}

х := xm div 2;

у := ym div 2;

dx := 10;

dy := 10;

{Основной цикл}

repeat

Putlmage(x,y,Saucer^,xorPut); {Изображаем НЛО на}

Delay(pause); {новом месте и после}

Putlmage (x, у, Saucer^, XorPut);{паузы стираем его}

{Получаем новые координаты}

loop: x := x+dx;

у := y+dy;

{НЛО достиг границы экрана?}

if (x<0) or (x+Width+1>xm) or

(у<0) or (y+Height+1>ym) then

begin {Да - НЛО достиг границы: меняем направление его перемещения}

x := x-dx;

y:= y-dy;

dx : = GetMaxX div 10 - Random(GetMaxX div 5);

dy := GetMaxY div 30 - Random(GetMaxY div 15);

goto loop

end

until KeyPressed;

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

CloseGraph

end

end.

14.8. ВЫВОД ТЕКСТА

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

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

Ниже описываются стандартные средства модуля Graph для вывода текста.

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

Procedure OutText(Txt: String);

Здесь Txt - выводимая строка.

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

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

Procedure OutTextXY (X,Y: Integer; Txt: String);

Здесь X, Y - координаты точки вывода; Txt - выводимая строка. Отличается от процедуры OutText только координатами вывода. Указатель не меняет своего положения.

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

Procedure SetTextStyle(Font,Direct,Size: Word);

Здесь Font - код (номер) шрифта; Direct - код направления; Size - код размера шрифта.

Для указания кода шрифта можно использовать следующие предварительно определенные константы:

const

DefaultFont = 0;{Точечный шрифт 8x8}

TriplexFont = 1;{Утроенный шрифт TRIP.CHR}

SmallFont = 2;{Уменьшенный шрифт LITT.CHR}

SansSerifFont = 3;{Прямой шрифт SANS.CHR}

GothicFont = 4;{Готический шрифт GOTH.CHR}

Замечу, что эти константы определяют все шрифты для версий 4.0, 5.0, 5.5 и 6.0. В версии 7,0 набор шрифтов значительно расширен, однако для новых шрифтов не предусмотрены соответствующие мнемонические константы. В этой версии помимо перечисленных Вы можете при обращении к SetTextStyle использовать такие номера шрифтов:

Шрифт DefaultFont входит в модуль Graph и доступен в любой момент. Это -единственный матричный шрифт, т.е. его символы создаются из матриц 8x8 пикселей. Все остальные шрифты - векторные: их элементы формируются как совокупность векторов (штрихов), характеризующихся направлением и размером. Векторные шрифты отличаются более богатыми изобразительными возможностями, но главная их особенность заключается в легкости изменения размеров без существенного ухудшения качества изображения. Каждый из этих шрифтов размещается в отдельном дисковом файле. Если Вы собираетесь использовать какой-либо векторный шрифт, соответствующий файл должен находиться в Вашем каталоге, в противном случае вызов этого шрифта игнорируется и подключается стандартный.

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

Для задания направления выдачи текста можно использовать константы:

const

HorizDir = 0;{Слева направо}

VertDir = 1;{Снизу вверх}

Как видим, стандартные процедуры OutText и OutTextXY способны выводить сообщения лишь в двух возможных направлениях - слева направо или снизу вверх. Зная структуру векторных шрифтов, нетрудно построить собственные процедуры вывода, способные выводить сообщения в любом направлении.

Каждый шрифт способен десятикратно изменять свои размеры. Размер выводимых символов кодируется параметром Size, который может иметь значение в диапазоне от 1 до 10 (точечный шрифт - в диапазоне от 1 до 32). Если значение параметра равно 0. устанавливается размер 1, если больше 10 - размер 10. Минимальный размер шрифта. при котором еще отчетливо различаются все его детали, равен 4 (для точечного шрифта - 1).

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

Uses Graph, CRT;

const

FontNames: array [1..10] of String[4] =

( 'TRIP' , 'LITT'' SANS ' , ' GOTH ' , 'SCRI ' , ' SIMP ' ,'TSCR ' , ' LOOM ' , ' EURO',' BOLD ' );

Tabl = 50;

Tab2 = 150;

Tab3 =220;

var

d, r, Err,{Переменные для инициации графики}

Y,dY,{Ордината вывода и ее приращение}

Size,{Размер символов}

MaxFont,{Максимальный номер шрифта}

k: Integer;{Номер шрифта}

NT, SizeT, SynibT: String;{Строки вывода}

c: Char;

{-------------------}

Procedure OutTextWithTab ( S1, S2, S3, S4: String);

{Выводит строки S1..S4 с учетом позиций табуляции Таb1..ТаbЗ}

begin

MoveTo( (Tab1-TextWidth(Sl) ) div2,Y);

OutText (S1) ;

MoveTo(Tabl+(Tab2-Tabl-TextWidth(S2)) div2,Y);

OutText (S2) ;

MoveTo(Tab2+(Tab3-Tab2-TextWidth(S3)) div 2,Y);

OutText(S3);

if S4='Symbols' then {Заголовок колонки Symbols}

MoveTo((Tab3+GetMaxX-TextWidth(S4)) div 2,Y)

else {Остальные строки}

MoveTo(Tab3+3,Y);

OutText(S4)

end;

{------------}

begin

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

InitGraph(d,r, ' ');

Err := GraphResult; if ErrogrOk then

WriteLn(GraphErrorMsg(Err))

else

begin

{Определяем количество шрифтов:}

{$IFDEF VER70'}

MaxFont := 10; .

{$ELSE}

MaxFont := 4;

{$ENDIF}

SetTextStyle(l,0,4);

Y := 0;

OutTextWi thTab('N','Name',Size','Symbols');

{Определяем высоту Y линии заголовка}

Y := 4*TextHeight('Z') div3;

Line(0,Y,GetMaxX,Y) ;

{Определяем начало Y таблицы и высоту dY каждой строки}

Y := 3*TextHeight('Z') div 2;

dY := (GetMaxY-Y) div (MaxFont);

{Готовим строку символов}

SymbT := '';

for с := 'a' to 'z' do

SymbT := SymbT+c;

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

for k := 1 to MaxFont do

begin

Size := 0;

{Увеличиваем размер до тех пор, пока высота строки не станет приблизительно равна dY}

repeat

inc(Size);

SetTextStyle(k,0,Size+1);

until (TextHeight('Z')>=dY) or (Size=10)

or (Textwidth(FontNames[k])>(Tab2-Tab1));

{Готовим номер NT и размер SizeT шрифта}

Str(k,NT);

Str(Size,SizeT);

{Выводим строку таблицы}

SetTextStyle(k,HorizDir,Size);

OutTextWithTab(NT,FontNames[k],SizeT,SymbT);

inc(Y,dY)

end;

{Рисуем линии рамки}

Rectangle(0,0,GetMaxX,GetMaxY);

Line(Tab1,0,Tabl,GetMaxY);

Line(Tab2,0,Tab2,GetMaxY);

Line(Tab3,0,ТаЬЗ,GetMaxY);

{Ждем инициативы пользователя}

ReadLn;

CloseGraph

end

end.

Процедура SetTextJustify. Задает выравнивание выводимого текста по отношению к текущему положению указателя или к заданным координатам. Заголовок:

Procedure SetTextJustify(Horiz,Vert: Word);

Здесь Horiz - горизонтальное выравнивание; Vert - вертикальное выравнивание. Выравнивание определяет как будет размещаться текст - левее или правее указанного места, выше, ниже или по центру. Здесь можно использовать такие константы:

const

LeftText = 0;{Указатель слева от текста}

CenterText= 1;{Симметрично слева и справа,верху и снизу}

RightText = 2;{Указатель справа от текста}

BottomText= 0;{Указатель снизу от текста}

TopText = 2;{Указатель сверху от текста}

Обратите внимание на неудачные, с моей точки зрения, имена мнемонических констант: если, например, Вы зададите LeftText, что в переводе означает «Левый Текст», сообщение будет расположено справа от текущего положения указателя (при выводе процедурой OutTextXY - справа от заданных координат). Также «наоборот» трактуются и остальные константы.

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

Uses Graph, CRT;

var

d, r, e : Integer;

begin

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

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

e := GraphResult;

if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

{Выводим перекрестие линий в центре экрана}

Line(0,GetMaxY div 2,GetMaxX,GetMaxY div 2);

Line(GetMaxX div 2,0,GetMaxX div 2,GetMaxY);

{Располагаем текст справа и сверху от центра}

SetTextStyle(TriplexFont,HorizDir,3);

SetTextJustify(LeftText,BottomText);

OutTextXY (GetMaxX div 2, GetMaxY div 2, 'LeftText,BottomText');

{Располагаем текст слева и снизу}

SetTextJustify (RightText, TopText);

OutTextXY (GetMaxX div 2, GetMaxY div 2,'RightText, TopText');

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

CloseGraph

end

end.

Процедура SetUserCharSize. Изменяет размер выводимых символов в соответствии с заданными пропорциями. Заголовок:

Procedure SetUserCharSize(XI,X2,Yl,Y2: Word);

Здесь X1...Y2 - выражения типа Word, определяющие пропорции по горизонтали и вертикали.

Процедура применяется только по отношению к векторным шрифтам. Пропорции задают масштабный коэффициент, показывающий во сколько раз увеличится ширина и высота выводимых символов по отношению к стандартно заданным значениям. Коэффициент по горизонтали находится как отношение X1 к Х2, по вертикали - как отношение Y1 к Y2. Чтобы, например, удвоить ширину символов, необходимо задать X1=2 и Х2=1. Стандартный размер символов устанавливается процедурой SetTextStyle, которая отменяет предшествующее ей обращение к SetUserCharSize.

В следующем примере демонстрируется изменение пропорций уменьшенного шрифта.

Uses Graph, CRT;

var

d, r, e : Integer;

begin

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

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

e := GraphResult;

if e <> grOk then

WriteLn(GraphErrorMsg(e))

else

begin

MoveTo (0, GetMaxY div 2); SetTextStyle (SmallFont, HorizDir, 5);

SetTextJustify (LeftText, BottomText);

{Выводим сообщение стандартной высотой 5}

OutText ('Normal Width,');

{Удваиваем ширину шрифта}

SetUserCharSize (2, 1, 1, 1);

OutText (' Double Width, ');

{Удваиваем высоту, возвращаем стандартную ширину}

SetUserCharSize (I, 1, 2, 1) ;

OutText ('Double Height,');

SetUserCharSize (2, 1, 2, 1) ;

OutText (' Double Width and Height');

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

CloseGraph

end

end.

Функция TextWidth. Возвращает длину в пикселях выводимой текстовой строки. Заголовок:

Function TextWidth (Txjt: String): Word;

Учитываются текущий стиль вывода и коэффициенты изменения размеров символов, заданные соответственно процедурами SetTextStyle и SetUserCharSize.

Функция TextHeight. Возвращает высоту шрифта в пикселях. Заголовок:

Function TextHeight(Txt: String): Word;

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

Procedure GetTextSettins(var Textlnfo: TextSettingsType);

Здесь Textlnfo - переменная типа TextSettingsType, который в модуле Graph определен следующим образом:

type

TextSettingsType = record

Font : Word; {Номер шрифта}

Direction: Word; {Направление}

CharSize : Word; {Код размера}

Horiz : Word; {Горизонтальное выравнивание}

Vert : Word; {Вертикальное выравнивание}

end;

Функция InstallUserFont. Позволяет программе использовать нестандартный векторный шрифт. Заголовок функции:

Function InstallUserFont(FileName: String): Integer;

Здесь FileName - имя файла, содержащего векторный шрифт.

Как уже говорилось, в стандартную поставку Турбо Паскаля версий 4.0 - 6.0 включены три векторных шрифта, для версии 7.0 - 10. Функция InstallUserFont позволяет расширить этот набор. Функция возвращает идентификационный номер нестандартного шрифта, который может использоваться при обращении к процедуре SetTextStyle.

Функция InstallUserDriver. Включает нестандартный графический драйвер в систему BGI-драйверов. Заголовок функции:

Function InstallUserDriver(FileName: String; AutoDetectPtr: Pointer): Integer;

Здесь FileName - имя файла, содержащего программу драйвера; AutoDetectPtr - адрес точки входа в специальную процедуру автоопределения типа дисплея, которая в числе прочих процедур должна входить в состав драйвера.

Эта функция расширяет и без того достаточно обширный набор стандартных графических драйверов и предназначена в основном для разработчиков аппаратных средств.

14.9. ВКЛЮЧЕНИЕ ДРАЙВЕРА И ШРИФТОВ В ТЕЛО ПРОГРАММЫ

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

Включение драйвера и шрифтов осуществляется по следующей общей схеме. Сначала с помощью вспомогательной программы BINOBJ.EXE, входящей в комплект поставки Турбо Паскаля, драйвер и шрифты преобразуются в OBJ-файл (файл с расширением .OBJ). Для этого вне среды Турбо Паскаля необходимо вызвать утилиту BINOBJ с тремя параметрами: именем преобразуемого файла, именем получаемого OBJ-файла и глобальным именем процедуры. Эти имена, в принципе, могут быть произвольными, правильными для MS-DOS именами. Например:

c:\tp\binobj cga.bgi cga cgadrv

В результате такого обращения из каталога ТР на диске С будет вызвана программа BINOBJ и ей будут переданы следующие параметры:

CGA.BGI - имя файла с преобразуемым драйвером;

CGA - имя файла с расширением .OBJ, т.е. CGA.OBJ, который будет получен в результате исполнения программы BINOBJ;

CGADRV- глобальное имя, под которым этот драйвер будет известен программе.

После этого можно написать следующий фрагмент программы:

Uses Graph;

Procedure CGADRV; external;

{$L CGA.OBJ}

var

d, r, e : Integer;

begin

if RegisterBGIDriver (@CGADRV) < 0 then

begin

WriteLn ('Ошибка при регистрации драйвера');

halt

end;

d := CGA; r := CGAHi;

InitGraph (d, r, '');

.......

Как видно из этого примера, в программе объявляется внешняя процедура с именем CGADRV (глобальное имя, указанное при обращении к BINOBJ), причем дается директива компилятору отыскать в текущем каталоге и загрузить файл CGA.OBJ, в котором находится эта процедура. Затем осуществляется регистрация драйвера путем обращения к функции RegisterBGIDriver. Единственным параметром этой функции является адрес начала драйвера в памяти (@CGADRV). Функция возвращает значение типа Integer, которое служит для контроля правильности завершения процедуры регистрации драйвера: если это значение меньше нуля, обнаружена ошибка, в противном случае функция возвращает номер зарегистрированного драйвера. В примере контролируется правильность регистрации драйвера и, если ошибка не обнаружена, инициируется графический режим работы экрана.

Аналогичным образом можно присоединить к программе стандартные штриховые шрифты (матричный шрифт 8x8 входит в состав модуля Graph и поэтому присоединять его не надо). Присоединение шрифта строится по описанной схеме за тем исключением, что для его регистрации вызывается функция RegisterBGIFont. Например, после преобразования

c:\Pascal\binobj litt.chr litt litt

можно использовать операторы

Procedure Litt;External;

{$L Litt.obj}

.......

if RegisterBGIFont (@litt) < 0 then ...

Обратите внимание: регистрация и драйвера, и шрифтов должна предшествовать инициации графического режима.

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

Uses Graph;

var

р: Pointer;

f: file;

begin

Assign(f,'Litt.chr'); {Открываем файл}

Reset(f,1); {LITT.CHR для чтения}

GetMem(p,FileSize(f)) ; {Резервируем для него область кучи нужного размера}

BlockRead(f,pA,FileSize(f)){Читаем файл}

WriteLn(RegisterBGIFont (p)){Регистрируем шрифт}

end.