@implementation CanvasBox { - init {} { $super init $super hideBorder set zoom 0 $self zoomFactor: 2 set bg [[entry $path._e] cget -background] destroy $path._e $frame configure -relief sunken -bd 1 set canvas [canvas $frame.canvas -width 1 -height 1 -bd 1 -relief flat] $canvas configure -bg $bg set xscroll [scrollbar $frame.xscroll -orient horizontal \ -command "$canvas xview"] set yscroll [scrollbar $frame.yscroll -orient vertical \ -command "$canvas yview"] grid rowconfigure $frame 0 -weight 1 grid columnconfigure $frame 0 -weight 1 grid $canvas $yscroll -sticky snew -padx 0 -pady 0 grid $xscroll -sticky snew -padx 0 -pady 0 $canvas configure -xscrollcommand "$xscroll set" \ -yscrollcommand "$yscroll set" $self enableEvent: Configure on: $canvas $self on: Configure do: "$canvas configure -scrollregion \[$canvas bbox all\]" $self enableEvent: {Button-4 Button-5} on: $canvas $self on: Button-4 do: {$canvas yview scroll -1 units} $self on: Button-5 do: {$canvas yview scroll +1 units} $self enableEvent: { Alt-ButtonPress-1 Alt-ButtonPress-3 Alt-ButtonRelease-1 Alt-ButtonRelease-3 } on: $canvas $self on: Alt-ButtonPress-1 do: {$self startZooming} $self on: Alt-ButtonPress-3 do: {$self startUnZooming} $self on: Alt-ButtonRelease-1 do: {$self stopZooming} $self on: Alt-ButtonRelease-3 do: {$self stopZooming} } - canvas {} { return $canvas } - zoomFactor: newFactor { set newFactor [expr 1.0 * $newFactor] if {($newFactor != 0.0) && ($newFactor != 1.0)} { $self zoomReset set zoomFactor $newFactor } } - zoomFactor {} { return $zoomFactor } - zoom {} { $canvas scale all 0 0 $zoomFactor $zoomFactor $canvas configure -scrollregion [$canvas bbox all] incr zoom } - unzoom {} { set factor [expr 1.0/$zoomFactor] $canvas scale all 0 0 $factor $factor $canvas configure -scrollregion [$canvas bbox all] incr zoom -1 } - zoomSync {} { #- to do after a canvas reset if {[set oldzoom $zoom] != 0} { set zoom 0 if {$oldzoom > 0} { while {$zoom < $oldzoom} { $self zoom } } elseif {$oldzoom < 0} { while {$zoom > $oldzoom} { $self unzoom } } } } - zoomReset {} { if {$zoom != 0} { if {$zoom > 0} { while {$zoom > 0} { $self unzoom } } elseif {$zoom < 0} { while {$zoom < 0} { $self zoom } } } } - startZooming {} { $self stopZooming $self zooming } - zooming {} { $self zoom set cmd "$self zooming" set zoomingId [after 200 $cmd] } - startUnZooming {} { $self stopZooming $self unZooming } - unZooming {} { $self unzoom set cmd "$self unZooming" set zoomingId [after 200 $cmd] } - stopZooming {} { if {[string length $zoomingId]} { after cancel $zoomingId set zoomingId {} } } - canvasBackground: aColor { $canvas configure -bg $aColor $frame configure -bg $aColor } - canvasBackground {} { return [$canvas cget -background] } - busy {} { $canvas configure -cursor watch } - unbusy {} { $canvas configure -cursor {} } }