Posted to tcl by ro at Wed Jan 02 09:08:31 GMT 2008view raw

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