Posted to tcl by ro at Wed Jan 02 09:00:03 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 p [image create photo]
- pack [label .p -width $canvas_width -height $canvas_height] \
- -fill both -expand 1
- .p conf -image $p
- set obj [megaimage-blank $canvas_width $canvas_height]
- $obj rectangle 0 0 $canvas_width $canvas_height {0 0 0 255}
- $obj rectangle $obj_x $obj_y $size $size {255 255 255 255}
- megaimage.put.on.photo [$obj getdata] $p 0 0 set
- 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
- global p
- set obj_x [expr {$obj_x + $dx}]
- set obj_y [expr {$obj_y + $dy}]
- $obj rectangle 0 0 $canvas_width $canvas_height {0 0 0 255}
- $obj rectangle $obj_x $obj_y $size $size {255 255 255 255}
- megaimage.put.on.photo [$obj getdata] $p 0 0 set
- }
- bind .p <1> [list move_start %X %Y]
- bind .p <Button1-Motion> [list move_motion %X %Y]