Posted to tcl by ro at Wed Jan 02 09:17:25 GMT 2008view raw
- load [file join $dir megaimage.dll]
- load [file join $dir megaimagetk.dll]
- set size 100
- set obj_x 100
- set obj_y 50
- set canvas_width 600
- set canvas_height 800
- set obj [megaimage-blank $canvas_width $canvas_height]
- $obj rectangle $obj_x $obj_y $size $size {255 255 255 0}
- pack [megaimage.frame .f] -fill both -expand 1
- .f size $canvas_width $canvas_height
- .f objsetimage $obj
- 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 obj
- global size
- global obj_x obj_y
- global canvas_width canvas_height
- # blank the canvas to black
- $obj rectangle 0 0 $canvas_width $canvas_height {0 0 0 0}
- set obj_x [expr {$obj_x + $dx}]
- set obj_y [expr {$obj_y + $dy}]
- $obj rectangle $obj_x $obj_y $size $size {255 255 255 0}
- .f objsetimage $obj
- }
- bind .f <1> [list move_start %X %Y]
- bind .f <Button1-Motion> [list move_motion %X %Y]