in reply to Re^2: Scrolling and marking by dragging on canvas
in thread Scrolling and marking by dragging on canvas
You're most welcome!
Yes, such a thing is possible in Tk. I'll give you an example so you can see how to do it, but you'll see that it's fairly involved. It's not that any of the individual steps are particularly difficult, just that there is a lot of preparation work to do.
I'll use the example above as a starting point:
#!/usr/bin/perl -w use Tk; use strict; # Globals my $b_button_1_down = 0; # Is the left mouse button currently down? my ($x0, $y0, $x1, $y1); # Starting and ending (x,y) coordinates my $rect_id = 0; # Last rectangle drawn # Main program / GUI setup my $mw = MainWindow->new; my $c = $mw->Scrolled('Canvas', -width => 100, -height => 100); $c->configure(-background =>'blue', -scrollregion => [ 0, 0, 500, 500 +]); $c->pack(-expand => 1, -fill => 'both'); bind_left_mouse($c); MainLoop; # Subroutines sub bind_left_mouse { my ($c) = @_; # Create "callback"; subroutines which get called whenever the # corresponding event is triggered. Note that Ev('x') and Ev('y') # will tell us, at the time they're used, what the current (x,y) # coordinate pair was. # my $cb1 = [ \&left_mouse_down, $c, Ev('x'), Ev('y')]; my $cb2 = [ \&left_mouse_release, $c, Ev('x'), Ev('y')]; my $cb3 = [ \&left_mouse_moving, $c, Ev('x'), Ev('y')]; # Bind the callbacks $c->CanvasBind("<ButtonPress-1>", $cb1); $c->CanvasBind("<ButtonRelease-1>", $cb2); $c->CanvasBind("<Motion>", $cb3); } sub left_mouse_down { # This gets called whenever the left-mouse button is clicked my ($ev, $c, $x, $y) = @_; $b_button_1_down = 1; ($x0, $y0) = ($x, $y); print "(debug) button1 down, (x,y) => ($x,$y)\n"; } sub left_mouse_moving { # This gets called whenever the mouse moves. It's true for ALL # mouse motion, but we're really just interested in when the mouse # is moving -and- the left mouse button is held down; hence the na +me. # my ($ev, $c, $x, $y) = @_; return unless $b_button_1_down; print "(debug) button1 moving, (x,y) => ($x,$y)\n"; $rect_id and $c->delete($rect_id); # Delete any old rectangle firs +t $rect_id = $c->createRectangle($x0, $y0, $x, $y, -fill => 'yellow' +); } sub left_mouse_release { # This gets called whenever the left-mouse button is released my ($ev, $c, $x, $y) = @_; $b_button_1_down = 0; ($x1, $y1) = ($x, $y); print "(debug) button1 release, (x,y) => ($x,$y)\n"; # Now do something with the triangle at (x0,y0,x1,y1)... $rect_id and $c->delete($rect_id); # Delete any old rectangle firs +t $rect_id = $c->createRectangle($x0, $y0, $x, $y, -fill => 'red'); }
What the above program does is to create a yellow rectange when you first click the left mouse button. The rectangle then changes its shape in response to the mouse being moved around. When you release the mouse button, the rectangle turns red.
You can take out the lines containing "(debug)", which are there to show the events that are being triggered.
You'll notice that the final rectangle is currently removed when you start a new one; you would have to add logic to keep it if you needed to.
I hope that's a good starting point for you to work with. There is a LOT of good things you can do with Perl/Tk, and although it takes some time to master it (and I'm still learning), it's well worth the enjoyable experience.
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^4: Scrolling and marking by dragging on canvas
by tamaguchi (Pilgrim) on Sep 22, 2006 at 15:27 UTC | |
|
Re^4: Scrolling and marking by dragging on canvas
by tamaguchi (Pilgrim) on Sep 22, 2006 at 15:30 UTC |