Schrift
Wiki:Tipp zum Debugging: use Data::Dumper; local $Data::Dumper::Useqq = 1; print Dumper \@var;
[thread]5276[/thread]

tk::balloon und menu type menubar + cascade: der balloon wird nicht angezeigt (Seite 2)

Leser: 2


<< |< 1 2 >| >> 15 Einträge, 2 Seiten
PerlProfi
 2007-01-08 18:52
#46067 #46067
User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]
Hatte gerade ein kleines Beispiel fertig, getestet, und es klappt wieder nicht :(
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
#!/usr/bin/perl
use strict;
use warnings 'all';
use Tk;
use Tk::Balloon;

# MainWindow erstellen
my $mw = tkinit(-title => "Tk::Balloon");

# menuframe und statusframe erstellen
my $mf = $mw -> Frame ( -relief => "flat" ,
-bd => 1 )
-> pack ( -fill => "x" ,
-expand => 1 );
my $sf = $mw -> Frame ( -relief => "groove" ,
-bd => 1 )
-> pack ( -fill => "x" ,
-expand => 1 );

# Menü erstellen
my $menubar = $mf -> Menu ( -type => "menubar" ,
-menuitems =>
[
[
"cascade" => "Datei" ,
-tearoff => 0 ,
-menuitems =>
[
[
"command" => "Neu" ,
-command => sub { print"neu\n" }
] ,
"-" ,
[
"command" => "Beenden" ,
-command => sub { $mw->destroy }
]
]
]
] );
$mw -> configure ( -menu => $menubar );

# Statuslabel erstellen
my $sl = $sf -> Label ( -text => "Starttext" ,
-font => "{Arial} 10 {normal}" )
-> pack ( -side => "left" ,
-padx => 2 ,
-pady => 2 );

# Balloon erstellen
my $b = $mw -> Balloon ( -statusbar => $sl ,
-initwait => 1 ,
-state => "status" );

$b -> attach ( $sf ,
-msg => "Statusbar" );

# attach() menu entrys
$b -> attach ( $menubar ,
-state => "status" ,
-msg =>
[
"Menü: Datei" ,
"Eine neue Datei erstellen" ,
"Programm beenden"
] );

MainLoop;

Was hab ich denn da jetzt falsch gemacht?
Vorhin hats noch funktioniert...

MfG PerlProfi
ptk
 2007-01-09 00:13
#46068 #46068
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Fehler: du attachst an $menubar, aber du meinst eigentlich das erste Untermenü, also:
Code: (dl )
$menubar->entrycget("Datei", -menu)

Aber leider reicht das nicht, weil aus irgendwelchen Gründen das Menü-Clone verwendet wird. Ich werde mal recherchieren...
ptk
 2007-01-09 00:53
#46069 #46069
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
OK, hab's jetzt. Entweder du verzichtest auf -type => "menubar" und baust einen "altmodischen" Menubar mit Frames und MenuButtons, oder du wendest noch diesen Patch an:
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
--- Tixish/Balloon.pm   (revision 1452)
+++ Tixish/Balloon.pm (revision 1456)
@@ -169,6 +169,13 @@ sub Motion {
my $client = $over;
while (defined $client) {
last if (exists $w->{'clients'}{$client});
+ if ($client->can("MasterMenu")) {
+ my $master = $client->MasterMenu;
+ if ($master && exists $w->{'clients'}{$master}) {
+ $w->{'clients'}{$client} = $w->{'clients'}{$master};
+ last;
+ }
+ }
$client = $client->Parent;
}
if (defined $client) {
--- Tk/Menu.pm (revision 1452)
+++ Tk/Menu.pm (revision 1456)
@@ -1152,6 +1152,25 @@ sub BalloonInfo
}
}

+sub MasterMenu
+{
+ my ($menu) = @_;
+ my $pathname = $menu->PathName;
+ my $master_menu;
+ if ($pathname =~ m{#})
+ {
+ my $master_pathname = (split m{\.}, $pathname)[-1];
+ $master_pathname =~ s{#}{.}g;
+ $master_menu = $menu->Widget($master_pathname);
+ if (!Tk::Exists($master_menu))
+ {
+ warn "Cannot find master menu <$master_pathname>";
+ }
+ }
+ $master_menu;
+}
+
+
# ::tk::AmpMenuArgs --
# Processes arguments for a menu entry, turning -label option into
# -label and -underline options, returned by ::tk::UnderlineAmpersand.
PerlProfi
 2007-01-10 17:50
#46070 #46070
User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]
@ptk sehr vielen Dank, dass du dir die Zeit genommen hast.

Ich habe die entsprechenden Stellen in Balloon.pm und Menu.pm verändert, und im attach() auch entrycget() benutzt. Trotzdem klappt es noch nicht.

Hast du es mal getestet?
Vielleicht habe ich ja nur einen Fehler beim übernehmen der Änderungen an den Modulen gemacht.

MfG PerlProfi\n\n

<!--EDIT|PerlProfi|1168444495-->
ptk
 2007-01-11 01:10
#46071 #46071
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Getestet habe ich es, allerdings nur unter X11. Kann sein, dass sich Cloned Menus unter Windows anders verhalten.

Solltest du mit den Patches nicht zurechtgekommen sein: die kompletten Dateien befinden sich hier:
https://svn.sourceforge.net/svnroot/srezic/Tk/Tk/Menu.pm
https://svn.sourceforge.net/svnroot/srezic/Tk/Tixish/Balloon.pm
<< |< 1 2 >| >> 15 Einträge, 2 Seiten



View all threads created 2007-01-06 11:52.