[HJG] Shows a [canvas]-window and a few [button]s to do some operations on it. ---- ====== #!/bin/sh # Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \ exec wish $0 ${1+"$@"} # demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073 #: CanvasDemo: On button-click, draw something on the canvas package require Tk proc ClrCanvas {w} { $w delete "all" } proc DrawAxis {w} { set midX [expr { $::maxX / 2 }] set midY [expr { $::maxY / 2 }] $w create line 0 $midY $::maxX $midY -tags "axis" $w create line $midX 0 $midX $::maxY -tags "axis" } proc PaintText {w Txt} { global y incr y 10 $w create text 20 $y -text $Txt -tags "text" } proc DrawBox {w} { global x1 y1 x2 y2 $w create rect 50 10 100 60 -tags "box" $w create rect $x1 $y1 $x2 $y2 -tags "box" incr x1 15 incr x2 15 incr y1 10 incr y2 10 } proc DrawFn1 {w} { $w create line 0 100 50 200 100 50 150 70 200 155 250 50 300 111 350 222\ -tags "Fn1" -smooth bezier } proc DrawFn2 {w} { set offY 0 ;# [expr { $::maxY / 2 }] for { set x 0 } { $x <= $::maxX } { incr x 5 } { set y [expr { rand() * $::maxY + $offY }] #puts "$x $y" if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2" } set x0 $x set y0 $y } } #: Main : frame .f1 frame .f2 pack .f1 .f2 set maxX 320 set maxY 240 set y 0 set x1 120 set x2 150 set y1 50 set y2 80 canvas .cv -width $maxX -height $maxY -bg white pack .cv -in .f1 button .b0 -text "Clear" -command { ClrCanvas .cv } button .b1 -text "Text" -command { PaintText .cv "Canvas" } button .b2 -text "Axis" -command { DrawAxis .cv } button .b3 -text "Box" -command { DrawBox .cv } button .b4 -text "Fn1" -command { DrawFn1 .cv } button .b5 -text "Fn2" -command { DrawFn2 .cv } pack .b0 .b1 .b2 .b3 .b4 .b5 -in .f2 -side left -padx 2 #catch {console show} ====== ---- See also: [Widgets on a canvas] and [Minimal scrolling canvas] (if you need scrollbars) ---- ***Screenshots*** [gold] added pix <
> [WikiDbImage TCL_wiki_Simple_Canvas_Demo.PNG] <
> [http://farm5.static.flickr.com/4013/4714847391_1dbce38be3.jpg] x ---- ***Auxiliary code*** [gold] Here is some auxiliary code which will raise or lower a blue rectangular grid on canvas objects.One can install two buttons which will raise or lower grid depending on state variable (`$state2`). Used code from Canvas moving objects and toggle tags, mainly to put in a measuring ball and screen coords on a label. Canvas moving objects and toggle tags is found on this wiki. [Canvas moving objects and toggle tags] Also added some exit buttons. ****Early Version***** ====== #!/bin/sh # Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \ exec wish $0 ${1+"$@"} # demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073 #: CanvasDemo: On button-click, draw something on the canvas package require Tk proc ClrCanvas {w} { $w delete "all" } proc DrawAxis {w} { set midX [expr { $::maxX / 2 }] set midY [expr { $::maxY / 2 }] $w create line 0 $midY $::maxX $midY -tags "axis" -width 2 $w create line $midX 0 $midX $::maxY -tags "axis" -width 2 } proc PaintText {w Txt} { global y incr y 10 $w create text 20 $y -text $Txt -tags "text" } proc DrawBox {w} { global x1 y1 x2 y2 $w create rect 50 10 100 60 -tags "box" $w create rect $x1 $y1 $x2 $y2 -tags "box" incr x1 15 incr x2 15 incr y1 10 incr y2 10 } proc DrawFn1 {w} { $w create line 0 100 50 200 100 50 150 70 200 155 250 50 300 111 350 222\ -tags "Fn1" -smooth bezier -width 4 } proc DrawFn2 {w} { set offY 0 ;# [expr { $::maxY / 2 }] for { set x 0 } { $x <= $::maxX } { incr x 5 } { set y [expr { rand() * $::maxY + $offY }] #puts "$x $y" if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2"-width 4 } set x0 $x set y0 $y } } #: Main : frame .f1 frame .f2 pack .f1 .f2 set maxX 320 set maxY 240 set y 0 set state2 1 set x1 120 set x2 150 set y1 50 set y2 80 set colorite seashell3 #canvas .cv -width $maxX -height $maxY -bg white set state2 1 #canvas .cv -width $maxX -height $maxY -bg white set oscwidth 1000 set oschorizontal 500 canvas .cv -width 400 -height 200 -scrollregion "0 0 $oscwidth $oschorizontal" \ -xscrollcommand ".corpsx set" -yscrollcommand ".corpsy set" \ -background palegreen -highlightcolor DarkOliveGreen \ -relief raised -border 10 scrollbar .corpsx -command " .cv xview" -orient horizontal scrollbar .corpsy -command " .cv yview" -orient vertical focus .cv proc refreshgrid { .cv state2} { global oscwidth oschorizontal colorite global grid set colorite blue for {set x 0} {$x<$oscwidth} {incr x 50} {.cv create line $x 0 $x $oschorizontal -tag grid -width 4} for {set y 0} {$y<$oschorizontal} {incr y 50} {.cv create line 0 $y $oschorizontal $y -tag grid -width 4} .cv itemconfigure grid -fill honeydew if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} } pack .cv -in .f1 button .b0 -text "Clear" -command { ClrCanvas .cv } button .b1 -text "Text" -command { PaintText .cv "Canvas" } button .b2 -text "Axis" -command { DrawAxis .cv } button .b3 -text "Box" -command { DrawBox .cv } button .b4 -text "Fn1" -command { DrawFn1 .cv } button .b5 -text "Fn2" -command { DrawFn2 .cv } #pack .b0 .b1 .b2 .b3 .b4 .b5 .b6 .b7 -in .f2 -side left -padx 2 #catch {console show} #if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} } button .b6 -text "gridlower" -command { refreshgrid .cv 2 } -background $colorite button .b7 -text "gridover" -command { refreshgrid .cv 1 } -background $colorite button .b8 -text "exit" -command { exit } pack .b0 .b1 .b2 .b3 .b4 .b5 .b6 .b7 .b8 -in .f2 -side left -padx 2 ====== ****Second Version**** ====== #!/bin/sh # Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \ exec wish $0 ${1+"$@"} # demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073 #: CanvasDemo: On button-click, draw something on the canvas # used code from Canvas moving objects and toggle tags #mainly to put in a measuring ball and screen coords on a label. package require Tk set halo 2 proc item:upd {w} { $w itemconfigure object -outline {} $w itemconfigure hover -outline red -width 5 $w itemconfigure moveit -outline purple -width 5 } proc item:move {w x y {init 0}} { global oldx oldy if $init { set oldx $x; set oldy $y $w addtag moveit closest $x $y $::halo $w dtag !moveable moveit $w raise moveit } else { $w move moveit [expr $x-$oldx] [expr $y-$oldy] set oldx $x; set oldy $y } item:upd $w } proc item:endmove {w x y} { $w dtag moveit item:upd $w } proc item:hover {w x y st} { if $st { $w addtag hover closest $x $y $::halo $w dtag !moveable hover } else { $w dtag hover } item:upd $w } proc item:toggletag {w x y tag} { set ttt tagtotoggle $w addtag $ttt closest $x $y $::halo $tag if {[lsearch [$w gettags $ttt] $tag] >= 0} { $w dtag ($ttt&&$tag) $tag item:hover $w $x $y 0 } else { $w addtag $tag withtag ($ttt&&!$tag) item:hover $w $x $y 1 } $w dtag $ttt } proc ClrCanvas {w} { $w delete "all" } proc DrawAxis {w} { #set midX [expr { $::maxX / 2 }] #set midY [expr { $::maxY / 2 }] set midX [expr { $::maxX / 2 }] set midY [expr { $::maxY / 2 }] $w create line 0 $midY [expr $::maxX+80] $midY -tags "axis" -width 2 $w create line $midX 0 $midX $::maxY -tags "axis" -width 2 } proc PaintText {w Txt} { global y incr y 30 $w create text 40 $y -text $Txt -tags "text" } proc mint {w } { catch {console show} $w create oval 150 110 170 130 -width 2 -fill red -outline gray -tags {object moveable}; puts "test" } proc DrawBox {w} { global x1 y1 x2 y2 $w create rect 50 200 100 80 -tags "box" $w create rect $x1 $y1 $x2 $y2 -tags "box" incr x1 15 incr x2 15 incr y1 10 incr y2 10 } proc DrawFn1 {w} { $w create line 0 100 50 200 100 50 150 70 200 155 250 50 300 111 350 222\ -tags "Fn1" -smooth bezier -width 4 } proc DrawFn2 {w} { set offY 0 ;# [expr { $::maxY / 2 }] for { set x 0 } { $x <= $::maxX } { incr x 5 } { set y [expr { rand() * $::maxY + $offY }] #puts "$x $y" if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2" } set x0 $x set y0 $y } } #: Main : frame .f1 frame .f2 frame .f3 pack .f1 .f2 .f3 set maxX 320 set maxY 240 set y 0 set state2 1 set x1 120 set x2 150 set y1 50 set y2 80 set colorite seashell3 #canvas .cv -width $maxX -height $maxY -bg white set state2 1 #canvas .cv -width $maxX -height $maxY -bg white set oscwidth 1000 set oschorizontal 500 canvas .cv -width 400 -height 240 -scrollregion "0 0 $oscwidth $oschorizontal" \ -xscrollcommand ".corpsx set" -yscrollcommand ".corpsy set" \ -background palegreen -highlightcolor DarkOliveGreen \ -relief raised -border 10 scrollbar .corpsx -command " .cv xview" -orient horizontal scrollbar .corpsy -command " .cv yview" -orient vertical focus .cv proc refreshgrid { .cv state2} { global oscwidth oschorizontal colorite global grid set colorite blue for {set x 10} {$x<$oscwidth} {incr x 50} {.cv create line $x 0 $x $oschorizontal -fill blue -tag grid -width 4} for {set y 20} {$y<$oschorizontal} {incr y 50} {.cv create line 0 $y $oschorizontal $y -fill blue -tag grid -width 4} .cv itemconfigure grid -fill blue if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} } pack .cv -in .f1 button .b0 -text "Clear" -command { ClrCanvas .cv } button .b1 -text "Text" -command { PaintText .cv "Canvas" } button .b2 -text "Axis" -command { DrawAxis .cv } button .b3 -text "Box" -command { DrawBox .cv } button .b4 -text "Fn1" -command { DrawFn1 .cv } button .b5 -text "Fn2" -command { DrawFn2 .cv } #pack .b0 .b1 .b2 .b3 .b4 .b5 .b6 .b7 -in .f2 -side left -padx 2 #catch {console show} #if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} } button .b6 -text "gridlower" -command { refreshgrid .cv 2 } -background $colorite button .b7 -text "gridover" -command { refreshgrid .cv 1 } -background $colorite button .b8 -text "exit" -command { exit } button .b9 -text "exit" -command { exit } button .b10 -text "scale^" -command {.cv scale all 0 0 1.1 1.1 } button .b11 -text "unscale<" -command {.cv scale all 0 0 .9 .9 } button .b12 -text "meas_ball" -command { .cv create oval 150 110 170 130 -width 2 -fill red -outline gray -tags {object moveable}; } button .b13 -text "ball" -command { mint .cv; } button .b14 -text "exit" -command { exit } set info "0" label .info -textvar info -just left pack .b0 .b1 .b2 .b3 .b4 .b5 .b6 .b7 -in .f2 -side left -padx 2 pack .b8 .b9 .b10 .b11 .b12 .b13 .b14 .info -in .f3 -side left -padx 2 .cv bind moveable {item:move %W %x %y 1;set info " %x %y ";puts "%x %y"} .cv bind moveable {item:endmove %W %x %y;puts "%x %y"} .cv bind moveable {item:hover %W %x %y 1;set info " %x %y "} .cv bind moveable {item:hover %W %x %y 0;set info " %x %y "} .cv bind moveit {item:move %W %x %y;set info " %x %y "} .cv bind all {item:toggletag %W %x %y moveable} #set info [format "x=%.2f y=%.2f" $x $y] # update item styles item:upd .cv ====== <> Example | Graphics