canvas shapes

saito - 2023-03-10

Sometimes you may wish to create shapes beyond the ones Tk canvas provides by default. Here is a little proc that creates database cylinders.

## can: canvas
## x,y: where the cyclinder will be placed
## w,h: width and height of the cyclinder
## oh: the size of the circles on top/bottom

package req Tk

proc make_db_drum {can x y w h {oh 10}} {
     set toX   [expr {$x + $w}]
     set toY   [expr {$y + $h}]
     set topY1 [expr {$y - $oh}]
     set topY2 [expr {$y + $oh}]
     set botY1 [expr {$toY - $oh}]
     set botY2 [expr {$toY + $oh}]

     set tag    drum[string range [clock milli] end-5 end]
     set objID1 [$can create line $x $y $x $toY -tags $tag]
     set objID2 [$can create line $toX $y $toX $toY -tags $tag]
     set objID3 [$can create oval $x $topY1 $toX $topY2 -tags $tag]
     set objID4 [$can create oval $x $botY1 $toX $botY2 -tags $tag]

     return $tag
}