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