Drawing rounded rectangles

Purpose: Demonstrate how to use the canvas to draw a rectangle with rounded corners:

Laurent Duperval posted in comp.lang.tcl:

Does anyone have sample code out there to draw rounded rectangles on a canvas? I looked at the code for impress which does that and it creates a polygon to achieve this effect. I'd like to know if anyone else has another approach to do this.

The code to which Laurent referred used a polygon with many, many small sides to round off the corners. An alternative is to use a smoothed polygon.

If you just want to draw rounded rectangles, you can skip straight to the code below. The rest of this discussion is to describe how the code works in detail.

The trick with the smoothed polygon is that the parabolic splines that Tk uses for smooth curves have the following features:

The curve passes through the midpoint of the line segment that joins two consecutive control points.
The line segment is tangent to the curve at that point.
If two consecutive segments are collinear, the spline is a straight line joining their midpoints.

The idea in creating a rounded rectangle, then, is to set control points back from the corners by twice the radius of the rounded corner. This trick will make the curve break at just the right point. The only real restriction is that the radius has to be at most 3/8 the length of the shorter side of the rectangle, or else the line segment will overshoot the curve segments.

The following code implements these ideas. The demonstration program below the code draws a rounded rectangle and a scale that lets you manipulate its corner radius.

KPV - this was very helpful. I generalized the concept in Drawing rounded polygons. Thanks

 #----------------------------------------------------------------------
 #
 # roundRect --
 #
 #       Draw a rounded rectangle in the canvas.
 #
 # Parameters:
 #       w - Path name of the canvas
 #       x0, y0 - Co-ordinates of the upper left corner, in pixels
 #       x3, y3 - Co-ordinates of the lower right corner, in pixels
 #       radius - Radius of the bend at the corners, in any form
 #                acceptable to Tk_GetPixels
 #       args - Other args suitable to a 'polygon' item on the canvas
 #
 # Results:
 #       Returns the canvas item number of the rounded rectangle.
 #
 # Side effects:
 #       Creates a rounded rectangle as a smooth polygon in the canvas.
 #
 #----------------------------------------------------------------------

 proc roundRect { w x0 y0 x3 y3 radius args } {

    set r [winfo pixels $w $radius]
    set d [expr { 2 * $r }]

    # Make sure that the radius of the curve is less than 3/8
    # size of the box!

    set maxr 0.75

    if { $d > $maxr * ( $x3 - $x0 ) } {
        set d [expr { $maxr * ( $x3 - $x0 ) }]
    }
    if { $d > $maxr * ( $y3 - $y0 ) } {
        set d [expr { $maxr * ( $y3 - $y0 ) }]
    }

    set x1 [expr { $x0 + $d }]
    set x2 [expr { $x3 - $d }]
    set y1 [expr { $y0 + $d }]
    set y2 [expr { $y3 - $d }]

    set cmd [list $w create polygon]
    lappend cmd $x0 $y0
    lappend cmd $x1 $y0
    lappend cmd $x2 $y0
    lappend cmd $x3 $y0
    lappend cmd $x3 $y1
    lappend cmd $x3 $y2
    lappend cmd $x3 $y3
    lappend cmd $x2 $y3
    lappend cmd $x1 $y3
    lappend cmd $x0 $y3
    lappend cmd $x0 $y2
    lappend cmd $x0 $y1
    lappend cmd -smooth 1
    return [eval $cmd $args]
 }

 # Demonstration program

 grid [canvas .c -width 600 -height 300]
 grid [scale .s -orient horizontal \
          -label "Radius" \
          -variable rad -from 0 -to 200 \
          -command doit] \
    -sticky ew

 proc doit { args } {

    global rad

    .c delete rect
    roundRect .c 100 50 500 250 $rad -fill white -outline black -tags rect


 }

GNJ - Another possibility, corners are much smoother for me this way:

proc roundRect2 {w L T Rad width height colour tag} {

  $w create oval $L $T [expr $L + $Rad] [expr $T + $Rad] -fill $colour -outline $colour -tag $tag
  $w create oval [expr $width-$Rad] $T $width [expr $T + $Rad] -fill $colour -outline $colour -tag $tag
  $w create oval $L [expr $height-$Rad] [expr $L+$Rad] $height -fill $colour -outline $colour -tag $tag
  $w create oval [expr $width-$Rad] [expr $height-$Rad] [expr $width] $height -fill $colour -outline $colour -tag $tag
  $w create rectangle [expr $L + ($Rad/2.0)] $T [expr $width-($Rad/2.0)] $height -fill $colour -outline $colour -tag $tag
  $w create rectangle $L [expr $T + ($Rad/2.0)] $width [expr $height-($Rad/2.0)] -fill $colour -outline $colour -tag $tag

}

EG: Here's another approach, using a raw smoothed polygon instead of bezier. The advantage is a more precise radius and roundness

  proc round-rect {c poly x1 y1 x2 y2 r} {
    set p [expr {$r * 0.44771525}]; # 1 - (4 * (sqrt(2) - 1) / 3.0)
    $c coords $poly \
        [+ $x1 $r] $y1 [+ $x1 $r] $y1 [- $x2 $r] $y1 \
        [- $x2 $r] $y1 [- $x2 $p] $y1 $x2 [+ $y1 $p] \
        $x2 [+ $y1 $r] $x2 [+ $y1 $r] $x2 [- $y2 $r] \
        $x2 [- $y2 $r] $x2 [- $y2 $p] [- $x2 $p] $y2 \
        [- $x2 $r] $y2 [- $x2 $r] $y2 [+ $x1 $r] $y2 \
        [+ $x1 $r] $y2 [+ $x1 $p] $y2 $x1 [- $y2 $p] \
        $x1 [- $y2 $r] $x1 [- $y2 $r] $x1 [+ $y1 $r] \
        $x1 [+ $y1 $r] $x1 [+ $y1 $p] [+ $x1 $p] $y1
  }
  # test
  package require Tk
  namespace path ::tcl::mathop
  set c [canvas .c]
  pack $c -expand 1 -fill both
  set poly [$c create polygon 0 0 0 0 -width 2 -fill blue -smooth raw]

  set x1 100
  set x2 300
  set y1 100
  set y2 200
  set r  20

  round-rect $c $poly $x1 $y1 $x2 $y2 $r

KPV 2026-04-01 -- I've used this code innumerable times so I was excited in seeing a new method. I thought I'd write a short script that lets you see the two methods side by side while varying the radius (I couldn't get GNJ's method to work). Note, the original method limits the radius to 3/4 the size of the box but the new method does not. Also, you need to grab the source code for both methods (I didn't want to duplicate the code).

package require Tk
namespace path ::tcl::mathop

proc TestBoth {radius} {
    global width height bandHeight numBands

    .c delete all

    set x0 50
    set y0 50
    set x1 [expr {$x0 + $width}]
    set y1 [expr {$y0 + $height}]

    # Original
    roundRect .c $x0 $y0 $x1 $y1 $radius -tag method1 -fill yellow -width 2
    .c create text [expr {($x0 + $x1) / 2}] [expr {($y0 + $y1) / 2}] -font {{} 18} \
        -text "Original Rounded Rect\nRadius: $radius" -anchor c

    # New method
    incr y0 $bandHeight
    incr y1 $bandHeight

    set poly [.c create polygon 0 0 0 0 -width 2 -fill yellow -smooth raw]
    round-rect .c $poly $x0 $y0 $x1 $y1 $radius
    .c create text [expr {($x0 + $x1) / 2}] [expr {($y0 + $y1) / 2}] -font {{} 18} \
        -text "New Rounded Rect\nRadius: $radius" -anchor c
}

set width 400
set height 200
set bandHeight 300
set numBands 2

catch {destroy .c}
canvas .c -width [expr {$width + 2*50}] -height [expr {$numBands * $bandHeight}] \
    -borderwidth 0 -highlightthickness 0
pack .c -expand 1 -fill both -side top
scale .radius -showvalue 0 -label Radius -orient horizontal -from 0 -to $height -command TestBoth
pack .radius -side top

set radius 20
TestBoth $radius