The big obstacle you will face is making your image resizable when the user resizes the window. You pretty much need to rebuild the resized image as the user finishes the resize. The Goo::Canvas has a nice zoom ability to get around this problem, see it's demo for how it works. Otherwise, just make a decent sized image and place it in a scrolled canvas, and let the scrollbars handle window resizes. :-)
#!/usr/bin/perl use strict; use warnings; use Tk; # Main window with a stretchy canvas... my $mw = new MainWindow( -title => "Tk Canvas Item Drag" ); my $c = $mw->Canvas( -width => 600, -height => 300, -bg => 'beige', )->pack( -expand => '1', -fill => 'both' ); # Some rectangle items... $c->createRectangle( 100, 100, 200, 200, -fill => 'orange', -activefill => 'darkorange', -outline => 'red', -activeoutline => 'green', -width => 1, -activewidth => 2, -tags => ['draggable'], ); $c->createRectangle( 210, 110, 260, 160, -fill => 'red', -activefill => 'darkred', -tags => ['draggable'], ); # This one is not draggable... $c->createRectangle( 410, 90, 510, 160, -fill => 'blue', -activefill => 'navy', ); # An image of a playing card - loaded from a a pixmap with the playing +_card_xpm sub - see below... $c->Pixmap( 'card', -data => playing_card_xpm() ); $c->createImage( 300, 100, -image => 'card', -anchor => 'nw', -tags => [ 'draggable', 'card' ], ); my $description = <<'EOF'; The orange and red rectangles can be moved - the blue one can't. When the playing card is dragged it leaves a vector behind! Take a look at the info that goes to STDOUT. EOF $c->createText( 300, 20, -anchor => 'n', -justify => 'center', -text => $description ); # add bindings for draggable objects... $c->bind( 'draggable', '<1>' => \&drag_start ); $c->bind( 'draggable', '<B1-Motion>' => \&drag_during ); $c->bind( 'draggable', '<Any-ButtonRelease-1>' => \&drag_end ); # the enter and leave events could be used to show and hide highlight +type objects... $c->bind( 'draggable', '<B1-Enter>' => undef ); $c->bind( 'draggable', '<B1-Leave>' => undef ); # Dragging item info hash to be kept during a drag... my %draginfo; MainLoop(); sub drag_start { print "drag_start:\n"; my ($c) = @_; my $e = $c->XEvent; # get the screen position of the initial button press... my ( $sx, $sy ) = ( $e->x, $e->y,,, ); print "\t screen: $sx, $sy\n"; # get the canvas position... my ( $cx, $cy ) = ( $c->canvasx($sx), $c->canvasy($sy) ); print "\t canvas: $cx, $cy\n"; # get the clicked item... my $id = $c->find( 'withtag', 'current' ); print "\t item id: $id\n"; my ( $x1, $y1, $x2, $y2 ) = $c->bbox($id); print "\t obj has bbox: $x1, $y1, $x2, $y2.\n"; # set up the draginfo... $draginfo{id} = $id; $draginfo{startx} = $draginfo{lastx} = $cx; $draginfo{starty} = $draginfo{lasty} = $cy; } sub drag_during { print "drag_during:\n"; my ($c) = @_; my $e = $c->XEvent; # get the screen position of the move... my ( $sx, $sy ) = ( $e->x, $e->y,,, ); print "\t screen: $sx, $sy\n"; # get the canvas position... my ( $cx, $cy ) = ( $c->canvasx($sx), $c->canvasy($sy) ); print "\t canvas: $cx, $cy\n"; # get the amount to move... my ( $dx, $dy ) = ( $cx - $draginfo{lastx}, $cy - $draginfo{lasty} + ); print "\t dx, dy = $dx, $dy\n"; # move it... $c->move( $draginfo{id}, $dx, $dy ); # update last position $draginfo{lastx} = $cx; $draginfo{lasty} = $cy; my ( $x1, $y1, $x2, $y2 ) = $c->bbox( $draginfo{id} ); print "\t obj has bbox: $x1, $y1, $x2, $y2.\n"; } sub drag_end { print "drag_end: \n"; # upon drag end, check for valid position and act accordingly... # was it the card? my @tags = $c->gettags( $draginfo{id} ); if ( grep /^card$/, @tags ) { # did it move anywhere? If so draw a vector... if ( $draginfo{startx} - $draginfo{lastx} or $draginfo{starty} - $draginfo{lasty} ) { my $line = $c->createLine( $draginfo{startx}, $draginfo{starty}, $draginfo{lastx}, $draginfo{lasty}, -arrow => 'last', -width => 3, -capstyle => 'round', -fill => 'navy', ); } } %draginfo = (); } # return the source of a nice playing card pixmap... sub playing_card_xpm { return <<'EOXPM'; /* XPM */ static char *j[] = { /* width height num_colors chars_per_pixel */ " 73 97 8 1", /* colors */ "` c #000000", ". c #808080", "# c #c0c0c0", "a c None", "b c #ffffff", "c c #000000", "d c #000000", "e c #000000", /* pixels */ "a#``````````````````````````````````````````````````````````````````` +``#a", "#.bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bb.#", "`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbb````bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbb.``.bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbb``bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbb`#bb``bbbbbbbbbbbbbbbbbbbbb#.`````..#bbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbb``bb``bbbbbbbbbbbbbbbbbbb#.```````````#bbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbb.````.bbbbbbbbbbbbbbbbbb.``````````````.bbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbb.``.bbbbbbbbbbbbbbbbbb#`````````````.```bbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb#`````````````..```.bbbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb.`````````````...```#bbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb````````````````````.bbbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb#`````````````````````#bbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb#`````````````````````.bbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb.``````````````````````bbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb.````````````...```````bbbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb#``.#.``````..##.``````#bbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb.``##b#````##b#b.``````#bbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb#`.#.#b.```#b..#b.`````.bbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb#`.``.#.``.b.``.##`````#bbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb#`..`..#```#.```#b`````.bbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb#``.``.....#````#b`````#bbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb``#.`######..`.##`````.bbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb``..############``````.bbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb``..####b#######.``````bbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb`..#######b#####.``````bbbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb``.####b######.#.``````#bbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb``..###########..``.```.bbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb``...#######.....``...``bbbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb.`#....#.#....###```..``.bbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbb.`##........##bbb.```.```bbbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbb.``###.....####bbb#```````.bbbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbb#```bb#########bbbbb.```````#bbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbb```#bb#######bbbbbbbb````````bbbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbb.``.bbbb####bbbbbbbbbb.```````.bbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbb#```bbbbbbb#bbbbbbbbbbb#````````bbbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbb```.bbbbbbbbbbbbbbbbbbbb.````````bbbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbb.```bbbbbbbbbbbbbbbbbbbbb.`````````bbbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbbb.```.##bbbbbb#bbbbbbbb#b#b#`````````.bbbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbb.````..b#bbb#b#bbbb#b######b``````````#bbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbbb`````.#b#bbbbbbbbbbbbb#b###b#``````````bbbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbb#````.#bbbbbbb#bbbbbbbbbbbb##b.`````````#bbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbb.````##bbbbbbbbbbbbbbbbbbbbb###``````````bbbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbb````.#bbbbbbbbbbbbbbbbbbbbbbbb#.`````````#bbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbbb````#bbbbbbbbbbbbbbbbbbbbbbbbbb#``.``````.bbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbb.```.#bbbbbbbbbbbbbbbbbbbbbbbbbbb`.``.`````bbbbbbbbb +bbb`", "`bbbbbbbbbbbbbbbb````.bbbbbbbbb#bbbbbbbbbbbbbbbbbb.`````````#bbbbbbbb +bbb`", "`bbbbbbbbbbbbbbb.````bbbbbbbbbb#bbbbbbbbbbbbbbbbbb.`````````.bbbbbbbb +bbb`", "`bbbbbbbbbbbbbbb.```.bbbbbbbbb#bbbbbbbbbbbbbbbbbbb.``````````bbbbbbbb +bbb`", "`bbbbbbbbbbbbbb#````#bbbbbbbbb#bbbbbbbbbbbbbbbbbbb.``````````#bbbbbbb +bbb`", "`bbbbbbbbbbbbbb.````#bbbbbbbbb#bbbbbbbbbbbbbbbbbbb#``````````.bbbbbbb +bbb`", "`bbbbbbbbbbbbb.````.bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#``````````.bbbbbbb +bbb`", "`bbbbbbbbbbbbb``````#bbbbbbbbb#bbbbbbbbbbbbbbbbbbbb```````````bbbbbbb +bbb`", "`bbbbbbbbbbbb.```.`.bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#```````````bbbbbbb +bbb`", "`bbbbbbbbbbbb#````..#bbbbbbbbb#bbbbbbbbbbbbbbbbbbbb``````````.bbbbbbb +bbb`", "`bbbbbbbbbbbb.````..bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#``````````.bbbbbbb +bbb`", "`bbbbbbbbbbbb#`.#.`.bbbbbbbbbb#bbbbbbbbbbbbbbbbbbb#```````.``.bbbbbbb +bbb`", "`bbbbbbbbbbbbb####.`##bbbbbbbb#bbbbbbbbbbbbbbbb###.``````````.bbbbbbb +bbb`", "`bbbbbbbbbbbb######.`.#bbbbbbb#bbbbbbbbbbbbbbbb###b`````````.bbbbbbbb +bbb`", "`bbbbbbbbbbb#.######.`.#bbbbbbbbbbbbbbbbbbbbbbb####````````.##bbbbbbb +bbb`", "`bbbbbbbbbb#..#######```#bbbbbb#bbbbbbbbbbbbbbb###..``````.###bbbbbbb +bbb`", "`bbbbbbbb##.##########```#bbbbbbbbbbbbbbbbbbb#####..`````..###bbbbbbb +bbb`", "`bbbbb###.#.##########.```#bbbbbbbbbbbbbbbbbb#####........####bbbbbbb +bbb`", "`bbbb#.################````.#bbbbbbbbbbbbbbbb##.##.#.....######bbbbbb +bbb`", "`bbbb##################.````.bbbbbbbbbbbbbbbb##..##.#...########bbbbb +bbb`", "`bbbb###################`````bbbbbbbbbbbbbbbbb#..################bbbb +bbb`", "`bbbb###################.````#bbbbbbbbbbbbbbb##...################bbb +bbb`", "`bbbb#.##################.``#bbbbbbbbbbbbbbbb#`..##################bb +bbb`", "`bbbb#.####################bbbbbbbbbbbbbbbbb#``..###################b +bbb`", "`bbbb#####################.#bbbbbbbbbbbbbb#.```..###################b +bbb`", "`bbbb#.####################.bbbbbbbbbbbbb#`````..##################bb +bbb`", "`bbbb#####################...#bbbbbbbb##.``````.##################bbb +bbb`", "`bbbb..####################.``..#....``````````..#.##############bbbb +bbb`", "`bbbb#..#.################...`````````````````...###########.##bbbbbb +bbb`", "`bbbb#.........##########.#..``````````````````...##.#####..#bbbbbbbb +bbb`", "`bbbbbb#..........####.#....``````````````````..#..###.....#bbbbbbbbb +bbb`", "`bbbbbbbbbb#.................``..###########..`...#..#....bbbbbb.``.b +bbb`", "`bbbbbbbbbbbbb#........#...`.#bbbbbbbbbbbbbbbb.`.........bbbbbb.````. +bbb`", "`bbbbbbbbbbbbbbbbb#......`..bbbbbbbbbbbbbbbbbb#.`.......bbbbbbb``bb`` +bbb`", "`bbbbbbbbbbbbbbbbbbb#..``.#bbbbbbbbbbbbbbbbbbbb#.```..#bbbbbbbb``bb#` +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb``bbbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb.``.bbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb````bbb +bbb`", "`bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bbb`", "#.bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +bb.#", "a#``````````````````````````````````````````````````````````````````` +``#a" }; EOXPM }
And you can add some balloons to your draggable object.
Balloons on draggable objects
#!/usr/bin/perl use strict; use Tk; use Tk::Balloon; my $dx; my $dy; my $balloonhash = {}; my $statushash = {}; my $mw = tkinit; my $c = $mw->Canvas->pack; my $statusbar = $mw->Label->pack( -fill => 'x' ); my $b = $c->Balloon( -initwait => 0, -statusbar => $statusbar, -balloonposition => 'mouse' ); $b->attach( $c, -initwait => 75, -balloonmsg => $balloonhash, -statusmsg => $statushash, -cancelcommand => \&checktag ); for my $i ( 0 .. 4 ) { my $item = $c->create( 'rect', $i * 20, $i * 20, $i * 20 + 20, $i * 20 + 20, -fill => 'red', -tags => ["TAF$i", 'group1', 'move'] ); $balloonhash->{$item} = "Balloon $i WITH tag"; $statushash->{$item} = "Status message $i WITH tag"; my $item2 = $c->create( 'rect', $i * 20 + 20, $i * 20, $i * 20 + 40, $i * 20 + 20, -fill => 'green', -tags => ['group2','move'] ); $balloonhash->{$item2} = "Balloon $i with NO tag"; $statushash->{$item2} = "Status message $i NO tag"; } $c->bind('move', '<1>', sub {&mobileStart();}); $c->bind('move', '<B1-Motion>', sub {&mobileMove();}); $c->bind('move', '<ButtonRelease>', sub {&mobileStop();}); MainLoop; sub checktag { if ( grep /TAF/, $c->gettags('current') ) { return 0; } else { return 1; } } sub mobileStart { my $ev = $c->XEvent; ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); $c->raise('current'); print "START MOVE-> $dx $dy\n"; } sub mobileMove { my $ev = $c->XEvent; #you can drag individuals or whole groups # $c->move('current', $ev->x + $dx, $ev->y +$dy); if ( grep /TAF/, $c->gettags('current') ) { $c->move('current', $ev->x + $dx, $ev->y +$dy); }else{ $c->move('group2', $ev->x + $dx, $ev->y +$dy); } ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); print "MOVING-> $dx $dy\n"; } sub mobileStop{&mobileMove;}
and finally using tags to drag whole groups
#!/usr/bin/perl use warnings; use strict; use Tk; my $dx; my $dy; my $grouptag; my $mw = MainWindow->new; $mw->geometry("700x600"); my $x1 = 50; my $x2 = 100; my $y1 = 50; my $y2 = 200; my $c = $mw->Canvas(-width => 700, -height => 565, -bg => 'black', )->pack; my $closebutton = $mw->Button(-text => 'Exit', -command => sub{Tk::exi +t(0)}) ->pack; my $parent = $c->createOval($x1, $y1, $x2, $y2, -fill => 'red', -tags => ['mover','group1'], ); my @children; for (1..4) { push @children, $c->createLine(($x1 + $x2)/2,$y1, (2 * $x2), (2 * +$y2), # -state =>'disabled', -fill => 'white', -activefill => 'green', -disabledfill => 'white', -tags => ['mover','group1','line','line'.$_], ); $x1 += 15; $x2 += 15; } $c->bind('mover', '<1>', sub {&mobileStart();}); $c->bind('mover', '<B1-Motion>', sub {&mobileMove();}); $c->bind('mover', '<ButtonRelease>', sub {&mobileStop();}); MainLoop; sub mobileStart { my $ev = $c->XEvent; ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); my $curr_object = $c->find('withtag','current'); print "curr->",@$curr_object,"\n"; #array dereference my (@list) = $c->gettags($curr_object); print "movelist->@list\n"; # if( grep /line/, @list){ # ($grouptag) = grep /(line\d+)/, @list; # } else {($grouptag) = grep /(group\d+)/, @list; } # JKrahn #You are grep()ing through @list twice! and using capturing parenthese +s! Ick! #this is better unless ( ( $grouptag ) = grep /line\d/, @list ) { + ( $grouptag ) = grep /group\d/, @list; + } + # print "grouptag-> $grouptag\n"; # print "START MOVE-> $dx $dy\n"; } sub mobileMove { my $ev = $c->XEvent; $c->move($grouptag, $ev->x + $dx, $ev->y +$dy); ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); # print "MOVING-> $dx $dy\n"; } sub mobileStop{&mobileMove;}
And here is a draggable text on image example
#!/usr/bin/perl use warnings; use strict; use Tk; use Tk::JPEG; use Tk::PNG; my $file = shift || die "need a bmp, gif,jpg or png as arg 1\n"; my ($dx,$dy); my $mw = Tk::MainWindow->new; $mw->fontCreate('big', -family=>'arial', -weight=>'bold', -size=> 30); my $can = $mw->Scrolled('Canvas', -height => 400, -width => 400, -scrollbars => 'osoe', -highlightthickness=>0, -borderwidth =>0, )->pack( -fill =>'both',-expand=>1); my $realcan = $can->Subwidget('scrolled'); my $img = $mw->Photo( -file => $file ); $can->createImage(0,0, #hardcoded offset -image => $img, -anchor => 'nw', -tags => ['img'], ); my @bbox = $can->bbox( 'img' ); $can->configure(-scrollregion => [@bbox] ); my $text = 'This is some text'; $can->createText(50,50, -text => $text, -fill =>'yellow', -anchor => 'nw', -font => 'big', -tags=> ['move'] ); $realcan->bind('move', '<1>', sub {&mobileStart();}); $realcan->bind('move', '<B1-Motion>', sub {&mobileMove();}); $realcan->bind('move', '<ButtonRelease>', sub {&mobileStop();}); MainLoop; sub mobileStart { my $ev = $realcan->XEvent; ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); $realcan->raise('current'); print "START MOVE-> $dx $dy\n"; } sub mobileMove { my $ev = $realcan->XEvent; $realcan->move('current', $ev->x + $dx, $ev->y +$dy); ($dx, $dy) = (0 - $ev->x, 0 - $ev->y); print "MOVING-> $dx $dy\n"; } sub mobileStop{&mobileMove;}
In reply to Re: Simplest GUI with drag/drop/click on large image?
by zentara
in thread Simplest GUI with drag/drop/click on large image?
by halley
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |