Thread Suche: Tabelle mit DragDrop-Funktionalität (31 answers)
Opened by GoodFella at 2007-01-09 21:27

GoodFella
 2007-01-14 22:53
#46105 #46105
User since
2007-01-09
192 Artikel
BenutzerIn
[default_avatar]
[quote=ptk,14.01.2007, 20:31]Wenn du einen Drag startest, dann denke ich, dass es einen "global grab" gibt. Damit wird verhindert, dass andere Widgets ihre Bindings feuern können. Du müsstest aus dem Drag-Objekt heraus tracken, wo du dich gerade befindest (gibt es dort etwas ähnliches wie -motioncommand?) und entsprechend scrollen.

Und so kompliziert, wie man bei rapidshare an eine Datei herankommt, bevorzuge ich es, das Skript hier im Forum zu haben. Auch weil es bei rapidshare wohl nach einigen Wochen verschwindet.[/quote]

Hab den Rapidshare Link jetzt mit dem Script ersetzt.
Es gibt -entercommand von DropSite, welches aufgerufen wird, sobald man mit dem Mauszeiger aus dem Widget heraus sowie hereinfährt. Leider ist das aber nur EIN Event, d.h. es passiert nur einmal. Ich möchte aber kontinuierliches Scrollen, solange man ausserhalb des Widgets ist; habe das wieder mit ner while Schleife gelöst und diesmal funktioniert es sogar überhaupt nicht ^^
Er scrollt irgendwie nur einmal .. dann wieder doch wie er sollte... danach ist kein DragDrop mehr möglich und ein clicken auf Exit ergibt einen "not a Tk-Widget"-Fehler, der seinen Ursprung in der Zeile hat, in der MainLoop bzw. update steht. Nett.
Code: (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
Tk::Error: XStoSubCmd: Not a Tk Window
 Tk::die_with_trace at C:/Programme/Perl/lib/Tk/Submethods.pm line 37
 Tk::Submethods::__ANON__ at test.pl line 141
 main::__ANON__ at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 (eval) at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 Tk::DropSite::Apply at C:/Programme/Perl/lib/Tk/DropSite.pm line 92
 Tk::DropSite::Leave at C:/Programme/Perl/lib/Tk/DragDrop.pm line 221
 Tk::DragDrop::Done at C:/Programme/Perl/lib/Tk/DropSite.pm line 78
 Tk::DropSite::Drop at C:/Programme/Perl/lib/Tk/DragDrop.pm line 285
 Tk::DragDrop::Drop at test.pl line 149
 (eval) at test.pl line 149
 main::__ANON__ at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 (eval) at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 Tk::DropSite::Apply at C:/Programme/Perl/lib/Tk/DropSite.pm line 92
 Tk::DropSite::Leave at C:/Programme/Perl/lib/Tk/DragDrop.pm line 153
 Tk::DragDrop::FindSite at C:/Programme/Perl/lib/Tk/DragDrop.pm line 182
 Tk::DragDrop::Mapped at test.pl line 149
 (eval) at test.pl line 149
 main::__ANON__ at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 (eval) at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 Tk::DropSite::Apply at C:/Programme/Perl/lib/Tk/DropSite.pm line 85
 Tk::DropSite::Enter at C:/Programme/Perl/lib/Tk/DragDrop.pm line 161
 Tk::DragDrop::FindSite at C:/Programme/Perl/lib/Tk/DragDrop.pm line 320
 Tk::DragDrop::StartDrag at C:/Programme/Perl/lib/Tk.pm line 411
 (eval) at C:/Programme/Perl/lib/Tk.pm line 411
 Tk::MainLoop at test.pl line 199
 <ButtonRelease>
 (command bound to event)
 error:XStoSubCmd: Not a Tk Window
 Tk::die_with_trace at C:/Programme/Perl/lib/Tk/Submethods.pm line 37
 Tk::Submethods::__ANON__ at test.pl line 141
 main::__ANON__ at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 (eval) at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 Tk::DropSite::Apply at C:/Programme/Perl/lib/Tk/DropSite.pm line 92
 Tk::DropSite::Leave at C:/Programme/Perl/lib/Tk/DragDrop.pm line 153
 Tk::DragDrop::FindSite at C:/Programme/Perl/lib/Tk/DragDrop.pm line 182
 Tk::DragDrop::Mapped at test.pl line 149
 (eval) at test.pl line 149
 main::__ANON__ at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 (eval) at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 Tk::DropSite::Apply at C:/Programme/Perl/lib/Tk/DropSite.pm line 85
 Tk::DropSite::Enter at C:/Programme/Perl/lib/Tk/DragDrop.pm line 161
 Tk::DragDrop::FindSite at C:/Programme/Perl/lib/Tk/DragDrop.pm line 320
 Tk::DragDrop::StartDrag at C:/Programme/Perl/lib/Tk.pm line 411
 (eval) at C:/Programme/Perl/lib/Tk.pm line 411
 Tk::MainLoop at test.pl line 199

Tk::Error: XStoSubCmd: Not a Tk Window
 Tk::die_with_trace at C:/Programme/Perl/lib/Tk/Submethods.pm line 37
 Tk::Submethods::__ANON__ at test.pl line 141
 main::__ANON__ at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 (eval) at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 Tk::DropSite::Apply at C:/Programme/Perl/lib/Tk/DropSite.pm line 92
 Tk::DropSite::Leave at C:/Programme/Perl/lib/Tk/DragDrop.pm line 153
 Tk::DragDrop::FindSite at C:/Programme/Perl/lib/Tk/DragDrop.pm line 182
 Tk::DragDrop::Mapped at test.pl line 149
 (eval) at test.pl line 149
 main::__ANON__ at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 (eval) at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 Tk::DropSite::Apply at C:/Programme/Perl/lib/Tk/DropSite.pm line 85
 Tk::DropSite::Enter at C:/Programme/Perl/lib/Tk/DragDrop.pm line 161
 Tk::DragDrop::FindSite at C:/Programme/Perl/lib/Tk/DragDrop.pm line 320
 Tk::DragDrop::StartDrag at C:/Programme/Perl/lib/Tk.pm line 411
 (eval) at C:/Programme/Perl/lib/Tk.pm line 411
 Tk::MainLoop at test.pl line 199
 <Map>
 (command bound to event)
 error:XStoSubCmd: Not a Tk Window
 Tk::die_with_trace at C:/Programme/Perl/lib/Tk/Submethods.pm line 37
 Tk::Submethods::__ANON__ at test.pl line 141
 main::__ANON__ at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 (eval) at C:/Programme/Perl/lib/Tk/DropSite.pm line 66
 Tk::DropSite::Apply at C:/Programme/Perl/lib/Tk/DropSite.pm line 85
 Tk::DropSite::Enter at C:/Programme/Perl/lib/Tk/DragDrop.pm line 161
 Tk::DragDrop::FindSite at C:/Programme/Perl/lib/Tk/DragDrop.pm line 320
 Tk::DragDrop::StartDrag at C:/Programme/Perl/lib/Tk.pm line 411
 (eval) at C:/Programme/Perl/lib/Tk.pm line 411
 Tk::MainLoop at test.pl line 199


Hier mal das zugehörige Script:

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
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198

#!/usr/local/bin/perl -w

use Tk;
use Tk::TableMatrix;
require Tk::JBrowseEntry;
require Tk::DragDrop;
require Tk::DropSite;
use strict;

my $tm_array = {};
my $t;
my @drag = ();
my @drop = ();

sub switch_cells
 {
  if ($drag[0] == $drop[0]) # Selbe Zeile
   {
    if ($drag[1] >= 0) # Kein Titel
     { 
      my $drag_coords = $drag[0].','.$drag[1];
      my $drop_coords = $drop[0].','.$drop[1];
      my $drag_val = $tm_array->{$drag_coords};
      my $drop_val = $tm_array->{$drop_coords};

      $t->set($drop_coords, $drag_val);
      $tm_array->{$drop_coords} = $drag_val;

      $t->set($drag_coords, $drop_val);
      $tm_array->{$drag_coords} = $drop_val;
     }
   }
 }

my $start_row = -3;
my $end_row = 50;
my $start_col = 0;
my $end_col = 50;
my $display_cols = 10;
my $display_rows = 10; 
my $nr_rows = $end_row - $start_row + 1;
my $nr_cols = $end_col - $start_col + 1;
my $title_rows = ($start_row < 0) ? (abs($start_row)) : (0);
my $title_cols = ($start_col < 0) ? (abs($start_col)) : (0);

foreach my $row  (($start_row - $title_rows)..$end_row)
 {
  foreach my $col (($start_col - $title_cols)..$end_col)
   {
    $tm_array->{"$row,$col"} = "$row:$col";
   }
 }

my $top = MainWindow->new;
$top->geometry('870x300');

$top->bind( '<MouseWheel>', [ sub { $_[0]->yviewScroll(-($_[1]/120)*3, 'units'); }, Tk::Ev('D') ] );

$t = $top->Scrolled( 'TableMatrix', 
                     -titlerows => $title_rows,   -titlecols => $title_cols,
                     -rows =>      $nr_rows,      -cols =>      $nr_cols, 
                     -height =>    $display_rows, -width =>     $display_cols, 
                     -variable => $tm_array,
                     -roworigin => $start_row,
                     -colorigin => $start_col, 
                     -colstretchmode => 'none',
                     -rowstretchmode => 'none',
                     -selectmode => 'single',
                     -drawmode => 'fast',
                     -maxwidth => 800,
                     -maxheight => 600,
                     -rowheight => -20,
                     -colwidth => -200,
                     -resizeborders => 'none',
                     -sparsearray => 0, 
                     -selecttitle => 0,                     
                     -state => 'disabled',
                     -font => ['Tahoma', 10, 'bold'],
                     -bg => '#D4D0C8',
                     -fg => '#000000' 
);

$t->tagConfigure('Normal',       -bg => '#D4D0C8', -fg => 'black');
$t->tagConfigure('DragSelected', -bg => '#EEEE11', -fg => 'black');
#$t->tagConfigure('DarkRed',      -bg => '#881111', -fg => 'black');
#$t->tagConfigure('LightRed',     -bg => '#EE9999', -fg => 'black');
#$t->tagConfigure('DarkGreen',    -bg => '#118888', -fg => 'black');
#$t->tagConfigure('LightGreen',   -bg => '#99EEEE', -fg => 'black');


my $cb_use = $t->Checkbutton( -text => 'nutzen' ); 
my @test_arr = ( 'TEXT', 'ZAHL', '#.## ¤', '#.## ¤ / # ¤', 'PLZ', 'TT.MM.JJJJ', 'TT.MM.JJ' );
my $test_var = $test_arr[0];
my $be_format = $t->JBrowseEntry( -label => '', -variable => \$test_var, -choices => \@test_arr,
                                  -state => 'normal', -font => ['Tahoma', 8], -width => 10 );
my $lbl_hl = $top->Label(-text => "Headline");

$t->windowConfigure("-3,0", -window=>$cb_use); 
$t->windowConfigure("-2,0", -window=>$be_format); 
$t->windowConfigure("-1,0", -window=>$lbl_hl); 

#$top->bind( '<B1-Motion>', [ \&dragscroll ] );
#sub dragscroll
# {
#  my @coords = (($t->pointerx - $t->rootx), ($t->pointery - $t->rooty)); 
#  
# }

my $dragscroll = 0;
my ($dnd_t, $ds_t);
$dnd_t = $t->DragDrop( -event => '<B1-Motion>', 
                       -sitetypes => [qw(Local)], 
                       -startcommand =>  sub {
                                              my @coords = split(",", $t->index('@'.($t->pointerx - $t->rootx).','.($t->pointery - $t->rooty))); 
                                              if (($coords[0] >= 0) and ($coords[1] >= 0))
                                               {
                                                $t->tagCell('Normal', $drop[0].','.$drop[1]) if (@drop); 
                                                $t->tagCell('Normal', $drag[0].','.$drag[1]) if (@drag); 
                                                @drag = @coords;
                                                $dnd_t->configure( -text => $tm_array->{$drag[0].','.$drag[1]} );
                                                $t->tagCell('DragSelected', $drag[0].','.$drag[1]); 
                                                return 0;
                                               }
                                              else
                                               { return(1); }
                                             } );
$ds_t = $t->DropSite ( -droptypes     => ['Local'], 
                       -dropcommand   => sub { 
                                              @drop = split(",", $t->index('@'.($t->pointerx - $t->rootx).','.($t->pointery - $t->rooty)));                                                 
                                              $t->tagCell('Normal', $drag[0].','.$drag[1]); 
                                              $t->tagCell('DragSelected', $drop[0].','.$drop[1]);                
                                              &switch_cells; 
                                             },
                       -entercommand => sub 
                                         { 
                                          if ($dragscroll == 0)
                                           {
                                            $dragscroll = 1;      
                                            while($dragscroll == 1)  
                                             {
                                              my ($mouse_x, $mouse_y) = $t->pointerxy;
                                              my ($x_left, $x_right) = ($t->rootx, $t->rootx + $t->height);
                                              my ($y_top, $y_bottom) = ($t->rooty, $t->rooty + $t->width);
                                              my $x_scroll = ($mouse_x < $x_left) ? (-1) : (($mouse_x < $x_right) ? (0) : (1));
                                              my $y_scroll = ($mouse_y < $y_top) ? (-1) : (($mouse_y < $y_bottom) ? (0) : (1));
                                              $t->xviewScroll($x_scroll, 'units');  
                                              $t->yviewScroll($y_scroll, 'units');  
                                              $t->after(10);
                                              $t->update;
                                             }
                                           }
                                          else
                                           {
                                            $dragscroll = 0;
                                           }                                           
                                         } );


#my $btn_dragscroll_left = $top->Button(  -text => chr(0x37), -width => 1, -height => 13, -font => ['Webdings', 7], -relief => 'raised' );  
#my $btn_dragscroll_right = $top->Button( -text => chr(0x38), -width => 1, -height => 13, -font => ['Webdings', 7], -relief => 'raised' );  

my $button = $top->Button( -text => 'Exit', -width => 135, -command => sub{ $top->destroy } ); 

#$btn_dragscroll_left->place(  -x =>   1, -y => 20 );
$t->place(                    -x =>  20, -y => 20 );
#$btn_dragscroll_right->place( -x => 842, -y => 20 );

#my $inside_scroll = 0;
#$btn_dragscroll_left->bind( '<Enter>', [ sub 
#                                          {
#                                           $inside_scroll = 1;
#                                           $btn_dragscroll_left->configure( -relief => 'sunken' );
#                                           while($inside_scroll == 1)
#                                            {
#                                             $t->xviewScroll(-1, 'units');  
#                                             $t->after(100);
#                                             $t->update;
#                                            }                                            
#                                          }
#                                       ] );
#$btn_dragscroll_left->bind( '<Leave>', [ sub { $inside_scroll = 0; $btn_dragscroll_left->configure( -relief => 'raised' ); } ] );
#$btn_dragscroll_right->bind( '<Enter>', [ sub 
#                                           {
#                                            $inside_scroll = 1;
#                                            $btn_dragscroll_right->configure( -relief => 'sunken' );
#                                            while($inside_scroll == 1)
#                                             {
#                                              $t->xviewScroll(1, 'units');  
#                                              $t->after(100);
#                                              $t->update;
#                                             }                                            
#                                           }
#                                        ] );
#$btn_dragscroll_right->bind( '<Leave>', [ sub { $inside_scroll = 0; $btn_dragscroll_right->configure( -relief => 'raised' ); } ] );

$button->place( -x => 20, -y => 260 );

Tk::MainLoop;


Ich hab schon dran gedacht, <Any-Motion> dran zu binden, aber wenn sich der MouseCursor nicht bewegt, macht er auch wieder nix mehr. Eigentlich müsste man <Any-Motion> + <No-Motion> dranbinden, nur denke ich, sowas gibt es nicht ^^..   Einfach noch einen Eintrag in MainLoop haben, der jede paar Zehntelsekunden checkt, ob Mauscursor ausserhalb Widget und darauf entsprechend scrollt.
Oder gibt es sowas ähnliches doch?


edit: ihr habt ja perl-code-tags! :D\n\n

<!--EDIT|GoodFella|1168809754-->

View full thread Suche: Tabelle mit DragDrop-Funktionalität