[Windows] 10 extra shapes for 2D drawing

Share your advanced PureBasic knowledge/code with the community.
User avatar
Arctic Fox
Enthusiast
Enthusiast
Posts: 609
Joined: Sun Dec 21, 2008 5:02 pm
Location: Aarhus, Denmark

[Windows] 10 extra shapes for 2D drawing

Post by Arctic Fox »

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

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

Updated with Regular Polygon :D
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
Last edited by Arctic Fox on Sat Jan 31, 2009 6:39 pm, edited 2 times in total.
milan1612
Addict
Addict
Posts: 894
Joined: Thu Apr 05, 2007 12:15 am
Location: Nuremberg, Germany
Contact:

Post by milan1612 »

Very nice, thank you. Quite useful for a geometry moron like me :P
Windows 7 & PureBasic 4.4
User avatar
Blue
Addict
Addict
Posts: 964
Joined: Fri Oct 06, 2006 4:41 am
Location: Canada

Post by Blue »

Very nice work.
Thanks fo a useful collection of ready-made drawing functions.
PB Forums : Proof positive that 2 heads (or more...) are better than one :idea:
User avatar
Arctic Fox
Enthusiast
Enthusiast
Posts: 609
Joined: Sun Dec 21, 2008 5:02 pm
Location: Aarhus, Denmark

Post by Arctic Fox »

Thanks for the kind replies :D
If somebody can add a rotate function, it will be very cool 8)
Seldon
Enthusiast
Enthusiast
Posts: 405
Joined: Fri Aug 22, 2003 7:12 am
Location: Italia

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

Post by Seldon »

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.
User avatar
Arctic Fox
Enthusiast
Enthusiast
Posts: 609
Joined: Sun Dec 21, 2008 5:02 pm
Location: Aarhus, Denmark

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

Post by Arctic Fox »

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 :lol:
And PureBasic has already got the Ellipse() function - Ellipse_() is an API function in Windows :wink:
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Post by Psychophanta »

Thanks!
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
SFSxOI
Addict
Addict
Posts: 2970
Joined: Sat Dec 31, 2005 5:24 pm
Location: Where ya would never look.....

Post by SFSxOI »

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?
User avatar
Arctic Fox
Enthusiast
Enthusiast
Posts: 609
Joined: Sun Dec 21, 2008 5:02 pm
Location: Aarhus, Denmark

Post by Arctic Fox »

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)
SFSxOI
Addict
Addict
Posts: 2970
Joined: Sat Dec 31, 2005 5:24 pm
Location: Where ya would never look.....

Post by SFSxOI »

Yes, exactly like that! How creative both you and that sparkie are. Thank You very much. :)
User avatar
Arctic Fox
Enthusiast
Enthusiast
Posts: 609
Joined: Sun Dec 21, 2008 5:02 pm
Location: Aarhus, Denmark

Post by Arctic Fox »

Thanks a lot for your kind words :D
I have updated the code with a Regular Polygon function :o - see first post
User avatar
Demivec
Addict
Addict
Posts: 4260
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Post by Demivec »

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

Code: Select all

Radian()
User avatar
Arctic Fox
Enthusiast
Enthusiast
Posts: 609
Joined: Sun Dec 21, 2008 5:02 pm
Location: Aarhus, Denmark

Post by Arctic Fox »

Sorry, my fault :oops:
I have included it in the first post - hope it works now
Post Reply