Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Graphische Oberflächen
[thread]5278[/thread]

Suche: Tabelle mit DragDrop-Funktionalität (Seite 3)



<< |< 1 2 3 4 >| >> 32 Einträge, 4 Seiten
GoodFella
 2007-01-14 10:14
#46098 #46098
User since
2007-01-09
192 Artikel
BenutzerIn
[default_avatar]
So, dieser Beitrag widmet sich dem Testen meines Algos.
Jeder Wert ist mit print versehen, hab also genug Daten zum analysieren.

1. Teil: ->colWidth gibt nach resizen negative Pixelwerte aus, ansonsten positive fixe Stringlängen. Weswegen $font->measure hier ungeeignet ist. In meinem Beispiel habe ich "X" als Zeichenbasis genommen, was eine Breite von 7 Pixeln hat, die Tabelle scheint jedoch mit 6 Pixeln zu arbeiten + 2 Pixel Offset. Zu diesen Werten bin ich gekommen, indem ich Screenshots mit Paint vermessen habe ^^ Hier mal die Daten:
http://rapidshare.com/files/11625505/mmc_test.xls.html  (Ich muss mir endlich wieder Webspace besorgen, Rapidshare stinkt)
Achja, die negativen Pixelwerte, die nach resizen geliefert werden, sind korrekt.

[UPDATE1>>]
Es scheint keine funktionierende allgemeingültige Möglichkeit zu geben, die die Zeilenbreite zuverlässig berechnet. (habe den gesamten Funktionsumfang von Tk::Font durch) Allerdings gibt es einen Workaround:
Ich setze einfach bei der Initialisierung der TableMatrix die Zeilenbreiten immer in negativen Pixelweiten, dann bekomme ich auch immer negative Pixelweiten von colWidth zurück :)\n\n

<!--EDIT|GoodFella|1168764966-->
GoodFella
 2007-01-14 13:04
#46099 #46099
User since
2007-01-09
192 Artikel
BenutzerIn
[default_avatar]
ARRRRRRRRRG!!!!

Ich schreib hier EWIG an nem funktionierendem Algorithmus, um dann rauszufinden, dass ein Einzeiler genau das tut, was ich will.
Code: (dl )
print index('@'.($t->pointerx - $t->rootx).','.($t->pointery - $t->rooty));

..schreibt das aktuelle Widget unter dem Mauszeiger in X,Y Format an STDOUT.

Bin drauf gestossen, als mir aufgefallen war, dass pointerxy -nicht- die Koordinaten relativ zur linken oberen Ecke des Widgets ausgibt, sondern relativ zum Gesamtbildschirm.
Der Bezugspunkt der Koordinaten von index ist allerdings auch nirgendswo dokumentiert.

[edit] ich seh grad, dass du 4 Beiträge weiter oben etwas ähnliches vorgeschlagen hattest, pTk; naja, konnte da noch nicht so richtig folgen, was du gemeint hast. Man lernt nie aus ;) ...und danke für deine Mühe. [/edit]\n\n

<!--EDIT|GoodFella|1168773211-->
GoodFella
 2007-01-14 13:55
#46100 #46100
User since
2007-01-09
192 Artikel
BenutzerIn
[default_avatar]
Als Abschluss hier mal ein funktionierendes TableMatrix Beispielscript, das DragnDrop unterstützt. Hab möglichst viele Konfigurationsmöglichkeiten reingebracht, ausserdem die Restriktion, dass nur Elemente innerhalb einer Zelle verschoben werden können und auch nur jene, die keine Titelelemente sind.

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
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
#!/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 row_sub
 {
  my $row = shift;
  return "OddRow" if( $row > 0 && $row % 2) 
 }

sub col_sub
 {
  my $col = shift;
  return "OddCol" if( $col > 0 && $col % 2) 
 }

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 = 7;
my $start_col = -2;
my $end_col = 6;
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');

$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, 
                     -rowtagcommand => \&row_sub, 
                     -coltagcommand => \&col_sub, 
                     -colstretchmode => 'none',
                     -rowstretchmode => 'none',
                     -selectmode => 'single',
                     -drawmode => 'fast',
                     -maxwidth => 800,
                     -maxheight => 600,
                     -rowheight => -20,
                     -colwidth => -100,
                     -resizeborders => 'none',
                     -sparsearray => 0, 
                     -selecttitle => 0,
                     -state => 'disabled',
                     -font => ['Tahoma', 10],
                     -bg => '#D4D0C8',
                     -fg => '#000000' );

$t->tagConfigure('OddRow', -bg => '#999999', -fg => 'black');
$t->tagConfigure('OddCol', -bg => '#D4D0C8', -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); 

my ($dnd_t, $ds_t);
$dnd_t = $t->DragDrop( -event => '<B1-Motion>', 
                       -sitetypes => [qw(Local)], 
                       -startcommand =>  sub {
                                              @drag = split(",", $t->index('@'.($t->pointerx - $t->rootx).','.($t->pointery - $t->rooty))); 
                                              $dnd_t->configure( -text => $tm_array->{$drag[0].','.$drag[1]} );
                                              return 0;
                                             } );
$ds_t = $t->DropSite ( -droptypes     => ['Local'], 
                       -dropcommand   => sub { 
                                              @drop = split(",", $t->index('@'.($t->pointerx - $t->rootx).','.($t->pointery - $t->rooty)));                                                 
                                              &switch_cells; 
                                              } );

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

my $button = $top->Button( -text => "Exit", -width => 135, -command => sub{ $top->destroy } );  
$button->place( -x => 20, -y => 260 );

Tk::MainLoop;


Bleibt noch, rauszufinden, wie man Zellenhintergründe ändert und Drag & Drop Scrollen hinzufügt (jemand eine Idee?) Ausserdem wäre es nett, das Mausrad zum Scrollen benutzen zu können.\n\n

<!--EDIT|GoodFella|1168775929-->
PerlProfi
 2007-01-14 15:08
#46101 #46101
User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]
Mausrad scrollen ist ganz einfach:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
    # Support for mouse wheel in Windows environment
    $w->bind('<MouseWheel>', [sub {
        $_[0]->yviewScroll(-($_[1]/120)*3, 'units');
    }, Tk::Ev('D')]);
    # Support for mouse wheel in UNIX environment
    if ( $Tk::platform eq 'unix' ) {
        $w->bind('<4>', sub {
            $_[0]->yviewScroll(-3, 'units') unless $Tk::strictMotif;
        });
        $w->bind('<5>', sub {
            $_[0]->yviewScroll( 3, 'units') unless $Tk::strictMotif;
        });
    }


Warscheinlich der beste Weg Optionen für einzelne Zellen zu ändern ist mit Tags zu arbeiten.
Die Hintergrundfarbe aller Zellen mit dem Tag 'tagname' könntest du dann folgendermaßen nach 'green' ändern:
$tablematrix->tagConfigure('tagname', -bg => 'green')

Allerdings konnte ich der Doku nicht auf die schnelle entnehmen, wie man Tags für die Zellen festlegt.

MfG PerlProfi\n\n

<!--EDIT|PerlProfi|1168780165-->
GoodFella
 2007-01-14 16:06
#46102 #46102
User since
2007-01-09
192 Artikel
BenutzerIn
[default_avatar]
Geil, danke. Habe rausgefunden, wie man einzeln Zellenattribute ändert, nämlich mit $t->tagCell(tag, index); tag musste man vorher mit $t->tagConfigure(name, attribute) erstellen.. Hier jetzt das TestScript in seiner Endfassung:

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
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
#!/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 = 7;
my $start_col = -2;
my $end_col = 6;
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 => -100,
                     -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); 

my ($dnd_t, $ds_t);
$dnd_t = $t->DragDrop( -event => '<B1-Motion>', 
                       -sitetypes => [qw(Local)], 
                       -startcommand =>  sub {
                                              $t->tagCell('Normal', $drag[0].','.$drag[1]) if (@drag); 
                                              @drag = split(",", $t->index('@'.($t->pointerx - $t->rootx).','.($t->pointery - $t->rooty))); 
                                              $dnd_t->configure( -text => $tm_array->{$drag[0].','.$drag[1]} );
                                              $t->tagCell('DragSelected', $drag[0].','.$drag[1]); 
                                              return 0;
                                             } );
$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]); 
                                              &switch_cells; 
                                             } );

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

my $button = $top->Button( -text => "Exit", -width => 135, -command => sub{ $top->destroy } );  
$button->place( -x => 20, -y => 260 );

Tk::MainLoop;


Hoffe, dass die, die nach mir kommen, es dadurch nicht so schwer haben.
GoodFella
 2007-01-14 20:49
#46103 #46103
User since
2007-01-09
192 Artikel
BenutzerIn
[default_avatar]
Habe mich jetzt ein bischen mit Drag-Scrollen beschäftigt: von Tk::TableMatrix gibt es die Methoden scanMark und scanDragto; leider ist das einzige, was meine Test zum Effekt hatten, eine vertikale Scrollbewegung (nur nach unten) bei jeder noch so kleinen Mausbewegung. Ich möchte, dass wenn ich ein Element am draggen bin und über den Rand der Tablle hinausgehe, dass die Tabelle dann langsam in diese Richtung scrollt.
Habe dann weitergegoogled, bin auf <Leave> und <Enter> gestossen; daraus habe ich folgendes Script gebaut:

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
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
#!/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 ($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; 
                                             } );


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;


Momentan passiert folgendes: Wenn man mit dem Mousebutton über den entsprechenden Buttons ist, scrollt die Tabelle langsam. Geht man jedoch mit gedrückter Maustaste über die Buttons, passiert gar nichts.
Jemand eine Idee, wie man das hinbekommen könnte? Wär auch für eine Alternative dankbar, was ich da zusammengebaut habe, ist alles andere als sauber (update in ner while-schleife)

[edit]Habe gerade herausgefunden, dass TableMatrix von alleine drag-scrollt, und zwar wenn man die Shift-Taste gedrückt hält. Leider beendet das Drücken der Shift-Taste auch jegliches Draggen.[/edit]\n\n

<!--EDIT|GoodFella|1168804187-->
ptk
 2007-01-14 21:31
#46104 #46104
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
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.
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-->
ptk
 2007-01-15 00:25
#46106 #46106
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Quote
Einfach noch einen Eintrag in MainLoop haben, der jede paar Zehntelsekunden checkt, ob Mauscursor ausserhalb Widget und darauf entsprechend scrollt.
Das sollte machbar sein: sobald dein Drag aktiv wird startest du einen Watcher per repeat-Methode. Die Funktion im repeat sollte prüfen, ob sich pointerxy innerhalb des Widgets befindet (die Rootposition und Ausmaße des Widgets bekommst du mit rootx/rooty und width/height heraus). Sobald du rechts/links/drüber/drunter bist, machst du ein scroll in die jeweilige Richtung. Eventuell könnte es sich "natürlicher" anfühlen, wenn du schon an der Rändern des Widgets, aber noch innerhalb, zu scrollen anfängst.
GoodFella
 2007-01-15 01:53
#46107 #46107
User since
2007-01-09
192 Artikel
BenutzerIn
[default_avatar]
[quote=ptk,14.01.2007, 23:25]
Quote
Einfach noch einen Eintrag in MainLoop haben, der jede paar Zehntelsekunden checkt, ob Mauscursor ausserhalb Widget und darauf entsprechend scrollt.
Das sollte machbar sein: sobald dein Drag aktiv wird startest du einen Watcher per repeat-Methode. Die Funktion im repeat sollte prüfen, ob sich pointerxy innerhalb des Widgets befindet (die Rootposition und Ausmaße des Widgets bekommst du mit rootx/rooty und width/height heraus). Sobald du rechts/links/drüber/drunter bist, machst du ein scroll in die jeweilige Richtung. Eventuell könnte es sich "natürlicher" anfühlen, wenn du schon an der Rändern des Widgets, aber noch innerhalb, zu scrollen anfängst.[/quote]
Hört sich cool an, werde gleich mal googlen.. Wegen der Methode, die du vorgeschlagen hast: Schau dir mal alles ab "-entercommand" von meinem letzten Beitrag an - ist genau das. Hast wohl meinen Code nur überflogen ;)
<< |< 1 2 3 4 >| >> 32 Einträge, 4 Seiten



View all threads created 2007-01-09 21:27.