Thread Tk-Raten: Linie zwischen zwei Boxen ziehen (3 answers)
Opened by pktm at 2010-09-05 16:05

pktm
 2010-09-06 20:42
#141222 #141222
User since
2003-08-07
2921 Artikel
BenutzerIn
[Homepage]
user image
Hallo Molaf,

den Code würde ich mir gerne mal ansehen.

Hier ist das, was ich gestern Abend und heute Abend so hinbekommen habe.
Der Code zum Auslesen einer ID, die als Tag hinterlegt wurde, muss noch gekapselt werden, aber ich denke, damit komme ich ganz gut hin.

Es fehlt noch:
- diese Kapselung...
- Ursprungs-Widget-ID merken
- Linie zwischen den Widgets malen (ich will die gezogene nicht einfach stehen lassen, sondern eine ordentliche von der Mitte rechten Randes des linken Widgets zur Mitte des linken Rands des rechten Widgets ziehen).

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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper qw/Dumper/;
use Tk;

my $mw = tkinit();

my $canvas = $mw->Canvas()->pack(-expand => 1, -fill => 'both',);

# -------------------------------------------------------------
# --- left box
my $left = $canvas->createText(
        50, 50,
        -text => 'left',
        -tags => [qw/left text id1/]
);
my @left_bbox = $canvas->bbox('left', 'id1');
my $padding = 3;
$canvas->createRectangle(
        $left_bbox[0] - $padding, $left_bbox[1] - $padding,
        $left_bbox[2] + $padding, $left_bbox[3] + $padding,
        -fill => 'green',
        -tags => [qw/left box id1/]
);
$canvas->raise('text', 'box');

# -------------------------------------------------------------
# --- right box
my $right = $canvas->createText(
        250, 50,
        -text => 'right',
        -tags => [qw/right text id5/]
);
my @right_bbox = $canvas->bbox('right', 'id5');
$canvas->createRectangle(
        $right_bbox[0] - $padding, $right_bbox[1] - $padding,
        $right_bbox[2] + $padding, $right_bbox[3] + $padding,
        -fill => 'yellow',
        -tags => [qw/right box id5/]
);
$canvas->raise('text', 'box');


# -- store point of origin here:
my $origin_x = undef;
my $origin_y = undef;


$canvas->bind('left', '<Button-1>' , [ 
        sub{ start_drawing_xy(@_); }, 
        Ev('x'), Ev('y'), 
        \$origin_x, \$origin_y 
]);
$canvas->Tk::bind('<B1-Motion>' , [ 
        sub{ motion_xy(@_); }, 
        Ev('x'), Ev('y'), 
        \$origin_x, \$origin_y 
]);
$canvas->Tk::bind('<ButtonRelease>' , [ 
        sub{ stop_drawing_xy(@_); }, 
        Ev('x'), Ev('y'), 
        \$origin_x, \$origin_y 
]);

$mw->MainLoop();


=head2 start_drawing_xy( $canvas, $x, $y, \$origin_x, \$origin_y )

=cut

sub start_drawing_xy {
        my $canvas = shift;
        my $x = shift;
        my $y = shift;
        my $origin_x = shift;
        my $origin_y = shift;
        
        $$origin_x = $x;
        $$origin_y = $y;
        
        printf("init drawing from vertex <%s, %s>\n", $x, $y);
} # /start_drawing_xy




=head2 motion_xy( $canvas, $x, $y )

Draw a line from source vertex to current vertex. Current vertex is the vertex
of the current mouse cursor position while button 1 is pressed.

=cut

sub motion_xy {
        my $canvas = shift;
        my $x = shift;
        my $y = shift;
        my $origin_x = shift;
        my $origin_y = shift;

        # catch unset origin
        return unless $$origin_x;

        # -- delete old line
        $canvas->delete('line');
        
        # -- draw new line
        $canvas->createLine($$origin_x, $$origin_y, $x, $y, -tags => [qw/line/]);

        printf("draw line from source vertex <%s, %s> to current vertex <%s, %s>\n", 
                $$origin_x, $$origin_y, $x, $y);
} # /motion_xy




=head2 stop_drawing_xy( $canvas, $x, $y, \$origin_x, \$origin_y )

=cut

sub stop_drawing_xy {
        my $canvas = shift;
        my $x = shift;
        my $y = shift;
        my $origin_x = shift;
        my $origin_y = shift;
        
        $$origin_x = $x;
        $$origin_y = $y;
        
        $canvas->delete('line');
        
        # -- Check if there is a valid target widget at <$x, $y>. If not, delete
        # the line && do nothing.
        my $w = $canvas->find("overlapping", $x, $y, $x+1, $y+1);
        print (defined $w ? "defined\n" : "undef\n");
        return undef unless defined $w;
        #print Dumper($w);
        
        my $id = undef;
        WIDGETS: foreach my $widget ( @{$w} ) {

                my @tags = $canvas->itemcget($widget, '-tags');
                next unless @tags;
                
                foreach my $tag ( @tags ) {
                        if( $tag =~ m/^id\d+$/ ) {
                                $id = $tag;
                                last WIDGETS;
                        }
                }
        }
        
        return undef unless $id; # there was no valid widget :-(
        
        print "target widget id = $id\n";
        
        
        
        printf("stop drawing from vertex <%s, %s> to vertex <%s, %s>\n", 
                $$origin_x, $$origin_y, $x, $y, );
} # /stop_drawing_xy
http://www.intergastro-service.de (mein erstes CMS :) )

View full thread Tk-Raten: Linie zwischen zwei Boxen ziehen