package KMenueTest; use strict; use Tk; use Tk::Toplevel; sub new { my($class) = @_; my $this = bless({ MW => MainWindow->new }, $class); my $lab = $this->{MW}->Label(-text => 'Klick hier')->pack; $this->{MW}->bind($lab, '<1>' => [ \&Click_Event, $this, Ev('X'), Ev('Y') ] ); return $this; } sub Click_Event { my($mw, $this, $x, $y) = @_; $this->Close_KMenue if $this->{KMenueOpen}; my $kmenue = $mw->Toplevel(qw/-bd 1 -relief raised/); $kmenue->overrideredirect(1); $kmenue->geometry(sprintf("+%d+%d", $x, $y)); my %opt = qw/-activebackground darkblue -activeforeground white -width 20 -height 1 -bd 0 -anchor w/; $kmenue->Button(%opt, -text => "Test1" , -command => [ \&Test, $this, 1 ])->pack; $kmenue->Button(%opt, -text => "Test2" , -command => [ \&Test, $this, 2 ])->pack; $this->{KMenue} = $kmenue; $this->{KMenueOpen} = 1; } sub Test { my($this, $param) = @_; print "Test $param\n"; $this->Close_KMenue; } sub Close_KMenue { my($this) = @_; $this->{KMenue}->destroy; $this->{KMenue} = undef; $this->{KMenueOpen} = 0; } 1;