Рисование полигонов
Материал из Blitz Et Cetera
В Blitz не предусмотрены стандартные функции рисования треугольников и произвольных многоугольников. Хочу предложить простую программку, которая восполняет этот пробел и позволяет рисовать произвольные многоугольники с любым количеством вершин, пустые либо заполненные (параметр solid).
Существенный недостаток этой программы (и возможность для ее дополнения и расширения, если найдутся энтузиасты либо у меня будет побольше времени) - пока многоугольники рисуются только одного цвета - белого.
Программа очень простая, поэтому я ограничусь только небольшими комментариями в листинге.
Graphics 800, 600, 16, 0
Const BlackColor=$FF000000; задаем значения цветов, которые возвращает ReadPixelFast
Const WhiteColor=$FFF8FCF8;
Dim Pixs(1,1); создаем массив для его последующего динамического изменения в функции
SetBuffer BackBuffer()
ClsColor 0,0,0
Cls
Type Point ; тип точки вершины
Field n, x, y
End Type
; здесь мы создаем точки вершины
; в принципе для создания точек вершин можно написать отдельную функцию - в зависимости от необходимости
; например, можно написать функцию, которая будет создавать точки вершин равностороннего многоугольника
; c заданным количеством граней
p1.Point = New Point
p1\x=0: p1\y=0: p1\n=0
p2.Point = New Point
p2\x=100: p2\y=0 p2\n=1
p3.Point = New Point
p3\x=50: p3\y=100: p3\n=2
p4.Point = New Point
p4\x=50: p4\y=70
SetBuffer BackBuffer()
Polygon=CreatePolygon(100,100,1); создаем многоугольник (вызываем функцию) и возвращаем переменной Polygon указатель на рисунок
DrawImage(Polygon, 300, 400); рисуем картинку
Flip
WaitKey
End
Function CreatePolygon(Width,Height,Solid) ; параметры width и height задают размеры "рамки" (размер рисунка)
; solid=0|1 (0 - контуры, 1 - заполненный)
PolygonImg=CreateImage(width,height); создаем пустую картинку
Dim Pixs(width,height) ; изменяем размерность массива
SetBuffer ImageBuffer(PolygonImg) ; рисуем в буфере рисунка
Color 255,255,255 ; рисуем белым по черному ;)
For p.Point = Each Point ; перебираем все вершины
If p = First Point
x0=p\x: y0=p\y: x1=x0: y1=y0 ; запоминаем координаты первый вершины
Goto skip ; может, кто предложит более удачную конструкцию. Я просто пропускаю тело цикла, если это первая вершина
End If
x2=p\x: y2=p\y ; передаем координаты вершины
If p = Last Point
Line x0,y0,x2,y2 ; соединяем первую и последнюю вершину
End If
Line x1,y1,x2,y2 ; соединяем вершину с предыдущей
x1=x2: y1=y2 ; запоминаем координаты текущей вершины как "предыдущей"
.skip
Next
;/----------------- заполнение области полигона. Вариант 1 -------------------------------------------------\
If Solid ; если выбран параметр "заполнить", заполняем многоугольник белым
LockBuffer ImageBuffer(PolygonImg) ; закрываем буфер рисунка, чтобы получить доступ к отдельным пикселям
For y=0 To height-1
m=0 ; переменная - флажок пересечения грани многоугольника при переборе точек построчно
For x=0 To width-1
Pixs(x,y)=ReadPixelFast (x,y) ; передаем параметр цвета точки x,y в массив
If Pixs(x,y)=WhiteColor m = Not m ; меняем состояние флага на противоположный при пересечении грани многоугольника
If m And Pixs(x,y)=BlackColor WritePixelFast x,y,WhiteColor ; если грань пересечена нечетный раз, рисуем белую точку
Next
Next
UnlockBuffer ImageBuffer(PolygonImg); разблокируем буфер рисунка
EndIf
;\________________________________________________________________________________________________________/
SetBuffer BackBuffer()
Return PolygonImg ; возвращаем указатель на рисунок с многоугольником
End Function
Дополнение: тестирование показало, что алгоритм заполнения области полигона белым цветом не совершенен: он не учитывает, что линии граней многоугольника не всегда представляют из себя идеальные прямые - на самом деле команда Line может выдавать и "зигзаг". Поэтому предлагаю алгоритм усовершенствовать и переписать блок If Solid ... End If так:
;/----------------- заполнение области полигона. Вариант 2 -------------------------------------------------\
If Solid
LockBuffer ImageBuffer(PolygonImg)
For y=0 To height-1
m=0: x0=0
For x=0 To width-1
Pixs(x,y)=ReadPixelFast (x,y)
If Pixs(x,y)=WhiteColor
m= Not m
If (Not m) And Pixs(x-1,y)=WhiteColor Then m=1 ; если флажок упал четный раз, но предыдущий пиксель белого цвета,
; то обращаем значение флага обратно в 1 - "ложная тревога" :)
If Not m
For i=x0+1 To x-1 ; если флажок упал четный раз и это не "ложная тревога",
WritePixelFast i,y,WhiteColor ; то заполняем белым цветом расстояние между четным и нечетным
Next ; падением флажка
Else
x0=x ; при нечетном падении флажка запоминаем координату в x0
EndIf
End If
Next
Next
UnlockBuffer ImageBuffer(PolygonImg)
EndIf
;\________________________________________________________________________________________________________/
И еще одно дополнение. Приведенную ниже функцию можно использовать для генерации вершин правильных многоугольников:
Function EqPolygon (N,R,povorot ) ; N - число вершин, R - радиус (расстояние от центра до любой из вершин)
; povorot - поворот в градусах
count=0
Local St#=360/n
For i=1 To N
a=(i-1)*St+povorot
X=Cos(a)*R+R
Y=Sin(a)*R+R
p.Point = New Point
p\x=x
p\y=y
count=count+1
Next
End Function
Автор: Константин Хлоров (E-mail: ubikvist_soba4ka_gmail.com)
|