home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource / 37_2.tcl < prev    next >
Text File  |  2003-04-16  |  1KB  |  40 lines
  1. #
  2. # Example 37-2
  3. # The canvas "Hello, World!" example.
  4. #
  5.  
  6. proc CanvasHello {} {
  7.     set can [Scrolled_Canvas .c -width 400 -height 100 \
  8.         -scrollregion {0 0 800 400}]
  9.     pack .c -fill both -expand true
  10.     # Create a text object on the canvas
  11.     $can create text 50 50 -text "Hello, World!" -tag movable
  12.     # Bind actions to objects with the movable tag
  13.     $can bind movable <Button-1> {CanvasMark %x %y %W}
  14.     $can bind movable <B1-Motion> {CanvasDrag %x %y %W}
  15. }
  16. proc CanvasMark { x y can} {
  17.     global canvas
  18.     # Map from view coordinates to canvas coordinates
  19.     set x [$can canvasx $x]
  20.     set y [$can canvasy $y]
  21.     # Remember the object and its location
  22.     set canvas($can,obj) [$can find closest $x $y]
  23.     set canvas($can,x) $x
  24.     set canvas($can,y) $y
  25. }
  26. proc CanvasDrag { x y can} {
  27.     global canvas
  28.     # Map from view coordinates to canvas coordinates
  29.     set x [$can canvasx $x]
  30.     set y [$can canvasy $y]
  31.     # Move the current object
  32.     set dx [expr $x - $canvas($can,x)]
  33.     set dy [expr $y - $canvas($can,y)]
  34.     $can move $canvas($can,obj) $dx $dy
  35.     set canvas($can,x) $x
  36.     set canvas($can,y) $y 
  37. }
  38.  
  39.  
  40.