Posted to tcl by ro at Mon Dec 31 23:13:34 GMT 2007view raw
- set x [image create photo -width 500 -height 500]
- pack [label .x -image $x -bd 0]
- . conf -bg gray80
- wm geom . 600x550
- foreach {x1 y1 x2 y2} [list 200 200 300 300] break
- proc render {} {
- global x
- global x1 y1 x2 y2
- $x put black -to 0 0 500 500
- $x put orange -to $x1 $y1 $x2 $y2
- }
- proc move_start {X Y} {
- global qx qy
- set qx $X ; set qy $Y
- }
- proc move_motion {X Y} {
- global qx qy
- set dx [expr {$X - $qx}]
- set dy [expr {$Y - $qy}]
- set qx $X ; set qy $Y
- global x1 y1 x2 y2
- incr x1 $dx ; incr y1 $dy
- incr x2 $dx ; incr y2 $dy
- render
- }
- bind .x <1> [list move_start %X %Y]
- bind .x <Button1-Motion> [list move_motion %X %Y]
- render