Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
The Tk Canvas widget is perfect for this in terms of simplicity. See the examples below. The Tk::Zinc and Gtk2's Goo Canvas have much better transparency, and zooming abilities, but they are harder to setup and use. But in general, go with a canvas type widget, as it allows you to lay down an image, then drag and place things anywhere you want on top. It is all done with "tags" as shown in the examples below. Also see Goo Canvas and transparent images

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. :-)

Draggable xpm on Tk canvas demo, you could make a pushpin xpm. :-)
#!/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;}

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

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

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others examining the Monastery: (8)
    As of 2014-11-28 20:40 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My preferred Perl binaries come from:














      Results (200 votes), past polls