Posted to tcl by ro at Mon Dec 31 23:13:34 GMT 2007view raw

  1.  
  2. set x [image create photo -width 500 -height 500]
  3. pack [label .x -image $x -bd 0]
  4.  
  5. . conf -bg gray80
  6. wm geom . 600x550
  7.  
  8.  
  9. foreach {x1 y1 x2 y2} [list 200 200 300 300] break
  10.  
  11. proc render {} {
  12. global x
  13. global x1 y1 x2 y2
  14. $x put black -to 0 0 500 500
  15. $x put orange -to $x1 $y1 $x2 $y2
  16. }
  17.  
  18. proc move_start {X Y} {
  19. global qx qy
  20. set qx $X ; set qy $Y
  21. }
  22.  
  23. proc move_motion {X Y} {
  24. global qx qy
  25. set dx [expr {$X - $qx}]
  26. set dy [expr {$Y - $qy}]
  27. set qx $X ; set qy $Y
  28.  
  29. global x1 y1 x2 y2
  30. incr x1 $dx ; incr y1 $dy
  31. incr x2 $dx ; incr y2 $dy
  32. render
  33. }
  34.  
  35.  
  36. bind .x <1> [list move_start %X %Y]
  37. bind .x <Button1-Motion> [list move_motion %X %Y]
  38.  
  39. render
  40.