Thread Tk-Canvas -> Objekt begrenzt verschieben
(1 answers)
Opened by Kean at 2011-01-11 16:23
hmm...so vielleicht ? :
Code (perl): (dl
)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 use strict; use warnings; use Tk; use Tk::Canvas; #use Tk::CursorControl; require Tk::PNG; my ( $X, $Y, $dx, $dy, $BNr ); my $schiebeauswahl = ""; my $mw = MainWindow->new(); #my $cControl = $mw->CursorControl; my $canvas = $mw->Canvas(-width => 640, -height => 480, -background => "#c0c0c0")->grid(-row=>1, -column=>0, -columnspan=>10 ); my $image_in = $canvas->Photo( -file => 'background.png', -format => 'png' ); my $image_width = $image_in->image('width'); my $image_height = $image_in->image('height'); my $picture = $canvas->createImage(0,0,-image => $image_in, -anchor => "nw", -tags => "picture"); my $rect_x1=2; my $rect_y1=2; my $rect_x2=168; my $rect_y2=202; my $rahmen = $canvas->createRectangle($rect_x1, $rect_y1, $rect_x2, $rect_y2, -width => 2, -outline => "#0f0", -tags => "rectangle"); my $rect_width=$rect_x2 - $rect_x1; my $rect_height=$rect_y2 - $rect_y1; $canvas->Tk::bind( '<ButtonPress-1>', sub { $schiebeauswahl = 'rectangle'; $BNr = 1; startmove(); } ); $canvas->Tk::bind( '<ButtonRelease-1>', sub { $schiebeauswahl = 'rectangle'; $BNr = 1; endmove(); } ); $canvas->Tk::bind( '<ButtonPress-3>', sub { $schiebeauswahl = 'picture'; $BNr = 3; startmove(); } ); $canvas->Tk::bind( '<ButtonRelease-3>', sub { $schiebeauswahl = 'picture'; $BNr = 3; endmove(); } ); MainLoop; sub startmove { return unless ( $canvas->gettags('current') ); my $ev = $canvas->XEvent; ( $X, $Y ) = ( $ev->x, $ev->y ); $canvas->Tk::bind( '<B'.$BNr.'-Motion>', \&moveit ); $canvas->raise( 'rectangle', 'all' ); } sub moveit { my $stepx; my $stepy; my $ev = $canvas->XEvent; my ( $cx, $cy ) = ( $ev->x, $ev->y ); ( $dx, $dy ) = ( $cx - $X, $cy - $Y ); if (($rect_x1 + $dx) < 0) { $stepx=-$rect_x1; $rect_x1 = 0; } elsif (($rect_x1 + $dx) > ($image_width - $rect_width)) { $stepx=$image_width - $rect_width - $rect_x1; $rect_x1 = $image_width - $rect_width; } else { $stepx=$dx; $rect_x1=$rect_x1 + $stepx; } if ($rect_y1 + $dy < 0) { $stepy=-$rect_y1; $rect_y1 = 0; } elsif (($rect_y1 + $dy) > ($image_height - $rect_height)) { $stepy=$image_height - $rect_height - $rect_y1; $rect_y1 = $image_height - $rect_height; } else { $stepy=$dy; $rect_y1=$rect_y1 + $stepy; } $canvas->move( $schiebeauswahl, $stepx, $stepy ); ( $X, $Y ) = ( $cx, $cy ); } sub endmove { return unless ( $canvas->gettags('current') ); my $ev = $canvas->XEvent; my ( $cx, $cy ) = ( $ev->x, $ev->y ); ( $dx, $dy ) = ( $cx - $X, $cy - $Y ); $canvas->move( $schiebeauswahl, $dx, $dy ); undef($X); undef($Y); $canvas->Tk::bind( '<B'.$BNr.'-Motion>', '' ); } Zumindest bewegt sich das Rechteck nun innerhalb des Bildes. Für die Sache mit dem sichtbaren Bereich des Canvas hab ich keine Lösung parat. Gruß Kalle Edit: ups...alten Bildnamen wieder eingetragen Last edited: 2011-01-12 23:05:23 +0100 (CET) |