PureBasic Forums - English

Posted: **Sun Jan 18, 2009 9:13 pm**

A collection of nine different 2D shapes using the Windows API. The Windows API uses the Device Context handle for drawing - StartDrawing() returns that one.
I have chosen an ImageGadget for this purpose as PureBasic (or is it Windows?) redraws it automatically.

For a manual redrawing process for WindowOutput(), take a look at Sparkie's brilliant code

http://www.purebasic.fr/english/viewtop ... 0556#90556

Set the outlineColor and/or fillColor to something less than zero to make them transparent

Please note that the angles for Pie(), Arc() and Chord() are clockwise (angleStart > angleEnd).

Updated with Regular Polygon

A function which draws regular polygons including stars.
startAngle sets the rotation angle (in degrees, clockwise).
enableStar specifies whether drawing stars (1) or not (0).
distanceFromEdge sets the distance (percentage) from the edge for the "concave" star points.

Feel free to modify, improve, enhance, destroy etc. this example.

Code: Select all

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

Procedure Pie(dc, x, y, w, h, angleStart, angleEnd, outlineColor = -1, fillColor = -1)
; Draws a pie (circle/ellipse sector)

; 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 the angle measurements - thanks to Mischa :), 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

; Draws the pie
Pie_(dc, x, y, x + w, y + h, ex + x, ey + y, sx + x, sy + y)

; Deletes the brush and the pen
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)
; Draws a rectangle with rounded corners

; 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)

; Draws the rounded rectangle
RoundRect_(dc, x, y, x + w, y + h, roundedWidth, roundedHeight)

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

Procedure Arc(dc, x, y, w, h, angleStart, angleEnd, outlineColor)
; Draws an arc (like the border of a pie)

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

SelectObject_(dc, pen)

; Calculates the angle measurements
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

; Draws the arc
Arc_(dc, x, y, x + w, y + h, ex + x, ey + y, sx + x, sy + y)

; Deletes the pen
DeleteObject_(pen)
EndProcedure

Procedure Chord(dc, x, y, w, h, angleStart, angleEnd, outlineColor = -1, fillColor = -1)
; Draws a chord (circle/ellipse section)

; 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 the angle measurements
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

; Draws the chord
Chord_(dc, x, y, x + w, y + h, ex + x, ey + y, sx + x, sy + y)

; Deletes the brush and the pen
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)
; Draws a triangle - using the Polygon_ API function

; 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(5)
PolygonArray(0) = x1
PolygonArray(1) = y1
PolygonArray(2) = x2
PolygonArray(3) = y2
PolygonArray(4) = x3
PolygonArray(5) = y3

; Draws the triangle
Polygon_(dc, @PolygonArray(), 3)

; Deletes the brush and the pen
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)
; Draws a parallelogram - using the Polygon_ API function

; 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) = 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

; Draws the parallelogram
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)
; Draws a trapezium (or trapeziod) - using the Polygon_ API function

; 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) = 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)
; Draws a rhombus (diamond) - using the Polygon_ API function

; 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)
; Draws a cross - 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 a regular polygon or star - 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)) ; The drawing functions need the Device Context handle of the output

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

Posted: **Sun Jan 18, 2009 9:19 pm**

Very nice, thank you. Quite useful for a geometry moron like me

Posted: **Mon Jan 19, 2009 8:07 am**

Very nice work.
Thanks fo a useful collection of ready-made drawing functions.

Posted: **Mon Jan 19, 2009 9:43 am**

Thanks for the kind replies

If somebody can add a rotate function, it will be very cool

Posted: **Mon Jan 19, 2009 10:54 am**

Very nice work !!! Thank you ! Just a tiny note, I'd never give a private function the same name of an API function, in order to keep things clear.

Arctic Fox wrote:I have chosen an ImageGadget for this purpose as PureBasic (or is it Windows?) redraws it automatically.

Yes, it's Windows that does it.

Posted: **Mon Jan 19, 2009 7:44 pm**

Seldon wrote:Just a tiny note, I'd never give a private function the same name of an API function, in order to keep things clear.

Fortunately API's have an underscore after the function name

And PureBasic has already got the Ellipse() function - Ellipse_() is an API function in Windows

Posted: **Mon Jan 19, 2009 11:28 pm**

Thanks!

Posted: **Wed Jan 21, 2009 8:17 pm**

Nice Artic Fox, thanks for posting.

Have you tried to use this yet for placing the shapes as backgrounds for windows so that gadgets don't wreck if?

Posted: **Wed Jan 21, 2009 11:37 pm**

SFSxOI wrote:Have you tried to use this yet for placing the shapes as backgrounds for windows so that gadgets don't wreck if?

You mean something like this?
For the sake of "code beauty" in the browser I have removed the shape procedures - please add them when trying this!

Code: Select all

Procedure ForceGadgetZOrderBottom(gadget)
SetWindowLong_(GadgetID(gadget), #GWL_STYLE, GetWindowLong_(GadgetID(gadget), #GWL_STYLE) | #WS_CLIPSIBLINGS)
SetWindowPos_(GadgetID(gadget), #HWND_BOTTOM, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE)
EndProcedure

CreateImage(0, 580, 380)
dc = StartDrawing(ImageOutput(0)) ; The drawing functions need the Device Context handle of the output

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, 200, 250, 150, 100, -1, RGB(255, 255, 0))
Cross(dc, 400, 50, 150, 200, -1, 40, 60, 40, -1, RGB(200, 200, 200))

StopDrawing()

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

StringGadget(2, 100, 100, 200, 20, "Hello World!")
ForceGadgetZOrderBottom(1)

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
End

I have used Sparkie's "Gadget-ZOrder" code (PB's sample http://www.purebasic.fr/english/viewtop ... 750#210750)

Posted: **Thu Jan 22, 2009 2:13 am**

Yes, exactly like that! How creative both you and that sparkie are. Thank You very much.

Posted: **Sat Jan 31, 2009 5:14 am**

Thanks a lot for your kind words

I have updated the code with a Regular Polygon function

- see first post

Posted: **Sat Jan 31, 2009 5:47 am**

You haven't defined this function, though I know it's not that difficult:

Code: Select all

Radian()

Posted: **Sat Jan 31, 2009 6:41 pm**

Sorry, my fault

I have included it in the first post - hope it works now

PureBasic Forums - English

[Windows] 10 extra shapes for 2D drawing

[Windows] 10 extra shapes for 2D drawing

Re: [Windows] Nine extra shapes for 2D drawing

Re: [Windows] Nine extra shapes for 2D drawing