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

}