Линии и точки
Процедура 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.
