* * *    
Главная » Статьи » Код PB

Просмотров: 1190 | Дата: 08.05.2024 | Коментарии (0)

Фигуры




Code
Procedure.d Radian(degreeAngle.d)
ProcedureReturn ASin(1) / 90 * degreeAngle
EndProcedure

Procedure Pie(dc, x, y, w, h, angleStart, angleEnd, outlineColor = -1, fillColor = -1)
; Рисуем (круг / эллипс сектор)

; Создает кистью и пером
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf

SelectObject_(dc, pen)
SelectObject_(dc, brush)

; Рассчитывает измерения углов http://www.purebasic.fr/english/viewtopic.php?t=13845
midx = w / 2
midy = h / 2

sx = 0 - (0 - midy) * Sin((2 * #PI) * angleStart / 360) + midx
sy = (0 - midy) * Cos((2 * #PI) * angleStart / 360) + midy

ex = 0 - (0 - midy) * Sin((2 * #PI) * angleEnd / 360) + midx
ey = (0 - midy) * Cos((2 * #PI) * angleEnd / 360) + midy

Pie_(dc, x, y, x + w, y + h, ex + x, ey + y, sx + x, sy + y)

If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure

Procedure RoundRectangle(dc, x, y, w, h, roundedWidth, roundedHeight, outlineColor = -1, fillColor = -1)
; Рисует прямоугольник с закругленными углами

If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf

SelectObject_(dc, pen)
SelectObject_(dc, brush)

; Рисует прямоугольник с закругленными углами
RoundRect_(dc, x, y, x + w, y + h, roundedWidth, roundedHeight)

If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure

Procedure Arc(dc, x, y, w, h, angleStart, angleEnd, outlineColor)
; Рисуем дугу  

If outlineColor < 0 : outlineColor = 0 : EndIf
pen = CreatePen_(#PS_SOLID, 1, outlineColor)

SelectObject_(dc, pen)

; Рассчитываем измерения угла
midx = w / 2
midy = h / 2

sx = 0 - (0 - midy) * Sin((2 * #PI) * angleStart / 360) + midx
sy = (0 - midy) * Cos((2 * #PI) * angleStart / 360) + midy

ex = 0 - (0 - midy) * Sin((2 * #PI) * angleEnd / 360) + midx
ey = (0 - midy) * Cos((2 * #PI) * angleEnd / 360) + midy

; Рисует дугу
Arc_(dc, x, y, x + w, y + h, ex + x, ey + y, sx + x, sy + y)

DeleteObject_(pen)
EndProcedure

Procedure Chord(dc, x, y, w, h, angleStart, angleEnd, outlineColor = -1, fillColor = -1)
;Обращает аккорде (круг / эллипс разделе)

If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf

SelectObject_(dc, pen)
SelectObject_(dc, brush)

; Рассчитываеv измерения угла
midx = w / 2
midy = h / 2

sx = 0 - (0 - midy) * Sin((2 * #PI) * angleStart / 360) + midx
sy = (0 - midy) * Cos((2 * #PI) * angleStart / 360) + midy

ex = 0 - (0 - midy) * Sin((2 * #PI) * angleEnd / 360) + midx
ey = (0 - midy) * Cos((2 * #PI) * angleEnd / 360) + midy

Chord_(dc, x, y, x + w, y + h, ex + x, ey + y, sx + x, sy + y)

If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure

Procedure Triangle(dc, x1, y1, x2, y2, x3, y3, outlineColor = -1, fillColor = -1)
; Рисует треугольник - с помощью функции API Polygon_

If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf

SelectObject_(dc, pen)
SelectObject_(dc, brush)

; Создает многоугольник массив
Dim PolygonArray.l(5)
PolygonArray(0) = x1
PolygonArray(1) = y1
PolygonArray(2) = x2
PolygonArray(3) = y2
PolygonArray(4) = x3
PolygonArray(5) = y3

; Рисует треугольник
Polygon_(dc, @PolygonArray(), 3)

If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure

Procedure Parallelogram(dc, x, y, w, h, xPush, outlineColor = -1, fillColor = -1)
; Рисует параллелограмм - с помощью функции API Polygon_

If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf

SelectObject_(dc, pen)
SelectObject_(dc, brush)

; Создает параллелограмм массив
Dim PolygonArray.l(7)
PolygonArray(0) = x
PolygonArray(1) = y
PolygonArray(2) = x + xPush
PolygonArray(3) = y + h
PolygonArray(4) = x + xPush + w
PolygonArray(5) = y + h
PolygonArray(6) = x + w
PolygonArray(7) = y

; Рисует параллелограмм
Polygon_(dc, @PolygonArray(), 4)

; Deletes the brush and the pen
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure

Procedure Trapezium(dc, upperX, upperW, lowerX, lowerW, y, h, outlineColor = -1, fillColor = -1)
; Рисует трапецию - с помощью функции API Polygon_

If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf

SelectObject_(dc, pen)
SelectObject_(dc, brush)

; Creates the polygon array
Dim PolygonArray.l(7)
PolygonArray(0) = upperX
PolygonArray(1) = y
PolygonArray(2) = lowerX
PolygonArray(3) = y + h
PolygonArray(4) = lowerX + lowerW
PolygonArray(5) = y + h
PolygonArray(6) = upperX + upperW
PolygonArray(7) = y

; Draws the trapezium
Polygon_(dc, @PolygonArray(), 4)

; Deletes the brush and the pen
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure

Procedure Rhombus(dc, x, y, w, h, outlineColor = -1, fillColor = -1)
; Рисует ромба - с помощью функции API Polygon_

; Creates the brush and the pen
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf

SelectObject_(dc, pen)
SelectObject_(dc, brush)

; Creates the polygon array
Dim PolygonArray.l(7)
PolygonArray(0) = Int((x + x + w) / 2)
PolygonArray(1) = y
PolygonArray(2) = x
PolygonArray(3) = Int((y + y + h) / 2)
PolygonArray(4) = Int((x + x + w) / 2)
PolygonArray(5) = y + h
PolygonArray(6) = x + w
PolygonArray(7) = Int((y + y + h) / 2)

; Draws the rhombus
Polygon_(dc, @PolygonArray(), 4)

; Deletes the brush and the pen
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure

Procedure Cross(dc, x, y, w, h, verticalX, verticalW, horizontalY, horizontalH, outlineColor = -1, fillColor = -1)
; Рисуем крест- using the Polygon_ API function
; NOTE: you can center verticalX and/or horizontalY by giving them a value less than zero

; Creates the brush and the pen
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf

SelectObject_(dc, pen)
SelectObject_(dc, brush)

If verticalX < 0 : verticalX = Int((w - verticalW) / 2) : EndIf
If horizontalY < 0 : horizontalY = Int((h - horizontalH) / 2) : EndIf

; Creates the polygon array
Dim PolygonArray.l(23)
PolygonArray(0) = x + verticalX + verticalW
PolygonArray(1) = y

PolygonArray(2) = x + verticalX
PolygonArray(3) = y

PolygonArray(4) = x + verticalX
PolygonArray(5) = y + horizontalY

PolygonArray(6) = x
PolygonArray(7) = y + horizontalY

PolygonArray(8) = x
PolygonArray(9) = y + horizontalY + horizontalH

PolygonArray(10) = x + verticalX
PolygonArray(11) = y + horizontalY + horizontalH

PolygonArray(12) = x + verticalX
PolygonArray(13) = y + h

PolygonArray(14) = x + verticalX + verticalW
PolygonArray(15) = y + h

PolygonArray(16) = x + verticalX + verticalW
PolygonArray(17) = y + horizontalY + horizontalH

PolygonArray(18) = x + w
PolygonArray(19) = y + horizontalY + horizontalH

PolygonArray(20) = x + w
PolygonArray(21) = y + horizontalY

PolygonArray(22) = x + verticalX + verticalW
PolygonArray(23) = y + horizontalY

; Draws the cross
Polygon_(dc, @PolygonArray(), 12)

; Deletes the brush and the pen
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure

Procedure RegularPolygon(dc, x, y, size, numSides, outlineColor = -1, fillColor = -1, startAngle.f = 0, enableStar = 0, distanceFromEdge.f = -1)
; Draws Звезду - using the Polygon_ API function
; Let enableStar = 1 to draw stars, let distanceFromEdge < 0 to use the standard distance

; Creates the brush and the pen
If outlineColor >= 0 : pen = CreatePen_(#PS_SOLID, 1, outlineColor) : Else : pen = GetStockObject_(#NULL_PEN) : EndIf
If fillColor >= 0 : brush = CreateSolidBrush_(fillColor) : Else : brush = GetStockObject_(#NULL_BRUSH) : EndIf

SelectObject_(dc, pen)
SelectObject_(dc, brush)

; Calculates angle stuff
If numSides < 3 : numSides = 3 : EndIf
If enableStar : enableStar = 1 : EndIf
startAngle = 360 - startAngle

anglePoint.f = 360 / numSides / (enableStar + 1)
If Not enableStar : startAngle + (anglePoint / 2) : EndIf
If enableStar : startAngle - 180 : EndIf

While startAngle < 0 : startAngle + 360 : Wend
While startAngle > 360 : startAngle - 360 : Wend

; Creates the polygon array
polyCount.w = numSides * (enableStar + 1)
Dim PolygonArray.l(polyCount * 2)

midx = (size / 2) + x
midy = (size / 2) + y

If distanceFromEdge < 0 : distanceFromEdge = 0.62 : Else : distanceFromEdge * 0.01 : EndIf

For a = 1 To polyCount
; Calculates the angle measurements of the actual point
anglePos = anglePoint * a + startAngle + 180
While anglePos > 360 : anglePos - 360 : Wend

sx = midx - Sin(Radian(anglePos)) * (size / 2)
sy = midy - Cos(Radian(anglePos)) * (size / 2)

If (enableStar And a & 1)
distance = Sqr(Pow(sx - midx, 2) + Pow(sy - midy, 2))
sx + Sin(Radian(anglePos)) * distanceFromEdge * distance
sy + Cos(Radian(anglePos)) * distanceFromEdge * distance
EndIf

PolygonArray((2 * a) - 2) = sx
PolygonArray((2 * a) - 1) = sy
Next a

; Draws the regular polygon/star
Polygon_(dc, @PolygonArray(), polyCount)

; Deletes the brush and the pen
If outlineColor >= 0 : DeleteObject_(pen) : EndIf
If fillColor >= 0 : DeleteObject_(brush) : EndIf
EndProcedure

CreateImage(0, 580, 380)
dc = StartDrawing(ImageOutput(0)) ; Функции рисования необходимо дескриптор контекста устройства выходной

FillArea(0, 0, -1, GetSysColor_(#COLOR_BTNFACE))

Pie(dc, 0, 0, 120, 120, 90, 225, -1, RGB(255, 0, 0))
RoundRectangle(dc, 0, 180, 180, 90, 40, 40, -1, RGB(0, 168, 255))
Arc(dc, 280, 0, 200, 100, 225, 45, RGB(0, 0, 0))
Chord(dc, 280, 120, 100, 100, 135, 300, -1, RGB(255, 128, 0))
Triangle(dc, 150, 80, 200, 0, 250, 80, -1, RGB(0, 0, 255))
Parallelogram(dc, 150, 110, 100, 50, -20, -1, RGB(0, 200, 0))
Trapezium(dc, 25, 100, 0, 150, 280, 80, -1, RGB(0, 255, 128))
Rhombus(dc, 180, 220, 150, 100, -1, RGB(255, 255, 0))
Cross(dc, 400, 50, 150, 200, -1, 40, 60, 40, -1, RGB(200, 200, 200))
RegularPolygon(dc, 340, 200, 100, 5, -1, RGB(0, 128, 64), 0, 1, -1)
RegularPolygon(dc, 450, 270, 100, 8, -1, RGB(0, 64, 238), 30)

StopDrawing()

OpenWindow(0, 10, 10, 600, 400, "Drawing different shapes", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
ImageGadget(1, 10, 10, 580, 380, ImageID(0))

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
End










Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.