Drawing Rounded Rectangles

[vdecampo]

I just whipped up a function I needed for drawing rounded edge rectangles. Don't know if anyone has already done this. If so, here's another one!

Code: Select all

Const pi =  Atn(1)*4 
/'
   Draw Rounded Rectangle   
'/
Sub DrawCorner(dst As Any Ptr,x As Integer,y As Integer,r As Integer,clr As UInteger=&hFFFFFF,corner As Integer)
Dim As Single aStart,aEnd

   Select Case corner
      Case 0   'upper left
         aStart=(pi/2):aEnd=pi
      Case 1   'upper right
         aStart=0:aEnd=(pi/2)
      Case 2   'lower right
         aStart=pi*2-(pi/2):aEnd=pi*2
      Case 3   'lower left
         aStart=pi:aEnd=pi*2-(pi/2)
   End Select

   Circle dst,(x,y),r,clr,aStart,aEnd
         
End Sub

Sub DrawRoundRectangle( dst   As Any Ptr,_
                        x     As Integer,_
                        y     As Integer,_
                        dx    As Integer,_
                        dy    As Integer,_
                        clr   As UInteger=&hFFFFFF,_
                        round As Integer,_
                        fill  As Integer=0)
                        
   'Draw straight segments
   Line dst,(x+round,y)   -Step(dx-round*2,0),clr
   Line dst,(x+round,y+dx)-Step(dx-round*2,0),clr
   Line dst,(x,y+round)   -Step(0,dy-round*2),clr
   Line dst,(x+dx,y+round)-Step(0,dy-round*2),clr
   'Draw arc segments
   DrawCorner (dst,x+round,y+round,round,clr,0)
   DrawCorner (dst,x+dx-round,y+round,round,clr,1)
   DrawCorner (dst,x+dx-round,y+dy-round,round,clr,2)
   DrawCorner (dst,x+round,y+dy-round,round,clr,3)
   
   If fill Then
      Paint dst,(x+round,y+round),clr
   End If
   
End Sub

ScreenRes 640,480,32

DrawRoundRectangle (0,10,10,100,100,&hc0c0c0,20)
DrawRoundRectangle (0,200,10,100,100,&hFFFF00,10,1)
DrawRoundRectangle (0,100,120,80,80,&hFF0000,30,1)

sleep

You can specify how round then corners are by increasing the round value. Filling is also an option.

Enjoy!
-Vince

[rdc]

Cool. I like it.

[KristopherWindsor]

I made a similar thing awhile ago, because I needed the graphic on a web page. ;)

Code: Select all

Const sx = 760, sy = 280, border = 20, c = &HFFFFFFFF, bg = &HFF88FF88

Screenres sx, sy, 32

Line (0, 0) - (sx - 1, sy - 1), c, BF

Line (0, 0) - Step(border, border), bg, BF
Circle (border, border), border, c,,, 1, F

Line (sx - 1, 0) - Step(-border, border), bg, BF
Circle (sx - 1 - border, border), border, c,,, 1, F

Line (0, sy - 1) - Step(border, -border), bg, BF
Circle (border, sy - 1 - border), border, c,,, 1, F

Line (sx - 1, sy - 1) - Step(-border, -border), bg, BF
Circle (sx - 1 - border, sy - 1 - border), border, c,,, 1, F

'Bsave "curvedbox.bmp", 0
Sleep

[Rens]

I couldn't resist

Code: Select all

ScreenRes 800,600,32
Dim As Integer sx,sy,border,c,bg,x,y
c=&hff0000
bg=0
'x and y value
x=100:y=350
sx=800-x-x
'height
sy=32
border=sy/2-1

Line (x, y) - (x+sx - 1, y+sy - 1), c, BF

Line (x, y) - Step(border, border), bg, BF
Circle (x+border, y+border), border, c,,, 1, F

Line (x+sx - 1, y) - Step(-border, border), bg, BF
Circle (x+sx - 1 - border, y+border), border, c,,, 1, F

Line (x, y+sy - 1) - Step(border, -border), bg, BF
Circle (x+border, y+sy - 1 - border), border, c,,, 1, F

Line (x+sx - 1, y+sy - 1) - Step(-border, -border), bg, BF
Circle (x+sx - 1 - border, y+sy - 1 - border), border, c,,, 1, F

Sleep

Change x,y and sy (height) at will

[KristopherWindsor]

Oh, well if you're going to go all breakout-shaped on me...

Code: Select all

' Fade paddle, from UltraBreaker, by KristopherWindsor

#include once "fbgfx.bi"

Const x = 600, y = 60

Sub fadepaddle (Byval thepaddlegraphic As fb.image Ptr)
  'set the alpha value to round the edges of the paddles
  
  Dim As Integer a, b, c', cr, cg, cb
  Dim As Double d
  
  Dim As Ubyte Ptr gp
  
  gp = cast(Ubyte Ptr, thepaddlegraphic + 1)
  
  For b = 0 To y - 1
    For a = 0 To x - 1
      If (*cast(Uinteger Ptr, gp + a Shl 2) And &HFFFFFF) = &HFF00FF Then Continue For
      
      Select Case a
      Case Is < .05 * x
        d = (30 - Sqr((a - x * .05) * _
          (a - x * .05) + (b - 30) * (b - 30)))
      Case Is > .95 * x
        d = (30 - Sqr((a - x * .95) * _
          (a - x * .95) + (b - 30) * (b - 30)))
      Case Else
        d = 30 - Abs(b - 30)
      End Select
      c = Int((d * 100) ^ .8)
      If c < 0 Then c = 0
      If c > 255 Then c = 255
      *(gp + a Shl 2 + 3) = c ' +3 to get to the alpha byte
    Next a
    
    gp += (thepaddlegraphic -> pitch)
  Next b
End Sub

Screenres 800, 600, 32
Dim As fb.image Ptr g = imagecreate(x, y, &HFFFFFFFF)
fadepaddle(g)
Put (100, 100), g, alpha
Sleep

=P

[Rens]

Very Nice!

But what if you want to use the magic color (pink)?

See what happens.

Code: Select all

Screenres 800, 600, 32
Dim As fb.image Ptr g = imagecreate(x, y, &HFFFF00FF) '<--------
fadepaddle(g)
Put (100, 100), g, alpha
Sleep

[KristopherWindsor]

Code: Select all

If (*cast(Uinteger Ptr, gp + a Shl 2) And &HFFFFFF) = &HFF00FF Then Continue For

? ;)

[Conexion]

Code: Select all

If (*cast(Uinteger Ptr, gp + a Shl 2) And &HFFFFFF) = &HFF00FF Then Continue For

? ;)

Kris buddy, I think you meant to do:

If (*cast(Uinteger Ptr, gp + a Shl 2) And &HFFFFFF) = &HFFFF00 Then Continue For

[KristopherWindsor]

Nope... magic pink is red and blue. =P
(I have been using this function since last summer. ;))

[Conexion]

Nope... magic pink is red and blue. =P
(I have been using this function since last summer. ;))

Ha, I didn't even think about the numbers, I was just fixing Ren's issue.

For some reason it is showing a pink box, not a pink smooth rounded box.

[KristopherWindsor]

And I was showing why magic pink is treated differently from other colors; remove that line if you want magic pink to work like all the other colors. ;)