Журнал о программированнии на языках Blitz3D, BlitzPlus, BlitzMax

Рисование полигонов

Материал из 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)

Другие

Друзья