Thread Tk-Canvas -> Objekt begrenzt verschieben (1 answers)
Opened by Kean at 2011-01-11 16:23

Kalle
 2011-01-12 22:59
#144633 #144633
User since
2007-03-18
48 Artikel
BenutzerIn
[default_avatar]
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)

View full thread Tk-Canvas -> Objekt begrenzt verschieben