Opened by Gast at 2008-01-10 15:32
Ich hab gerade mal ein bisschen rumprobiert, und herausgefunden, dass es mit <FocusOut> sehr gut funktioniert!
Du musst nur dem Menü den Fokus geben, wenn es gezeigt wird. ( mittels $m->focus )
Als kleines Beispiel eine Menüklasse mit Schatten (aufgeteilt in mehere Antworten):
Du musst nur dem Menü den Fokus geben, wenn es gezeigt wird. ( mittels $m->focus )
Als kleines Beispiel eine Menüklasse mit Schatten (aufgeteilt in mehere Antworten):
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
package Tk::KMenu;
use strict;
use warnings 'all';
use Tk;
use Tk::Toplevel;
sub new
{
my( $class, $top ) = @_; # pick parameters
my $obj = { # create reference
container => $top -> Toplevel( # create and save new toplevel window
-bd => 1,
-relief => 'raised',
),
shadow => $top -> Toplevel( # create a shadow window
-background => '#0f0f0f', # set the background to really dark grey
),
menu => [], # save menu entries
};
bless $obj, $class; # bless the reference
$obj->{container} -> overrideredirect( 1 ); # delete menu border
$obj->{shadow} -> overrideredirect( 1 ); # delete shadow border
$obj->close; # don't show menu until ->show
# if the menu loses focus, close it
$obj->{container} -> bind(
'<FocusOut>' => sub {
$obj->close;
},
);
return $obj; # return object
} # new
sub add
{
my( $self, @pairs ) = @_; # pick parameters
for( my $i = 0; $i < @pairs; $i += 2 ) { # iterate over @pairs
# add a menu entry
push(
@{ $self->{menu} },
$self->{container} -> Button(
-text => $pairs[$i],
-anchor => 'w',
-relief => 'flat',
-bd => 1,
-command => $pairs[$i+1],
) -> pack(
-fill => 'x',
),
);
} # foreach
return $self; # return object
} # add