package Tk::MyOwnBalloon; use strict; use warnings; use Carp qw/croak/; use Tk::widgets qw/ Balloon /; use base qw/ Tk::Derived Tk::Balloon /; Construct Tk::Widget 'MyOwnBalloon'; =head1 Beschreibung Modifikation von Tk::Ballon: Zeigt einen Hintergrundschatten für das Popup an. =head1 METHODEN =head2 ClassInit( $mw ) =cut sub ClassInit { my( $class, $mw ) = @_; #... e.g., class bindings here ... $class->SUPER::ClassInit( $mw ); } # /ClassInit =head2 Populate( $args ) =cut sub Populate { my( $self, $args ) = @_; $self->SUPER::Populate( $args ); } # /Populate =head2 Popup( ??? ) =cut sub Popup { # -- Inhalt der Tk::Balloon::Popup-Funktion, aus technischen Gründen gekürzt.... # -- Modifikation ab hier $w->stayOnTop (); # the shadow: unless ( $w->{'shadow'} ) { # create the toplevel 'shadow': $w->{'shadow'} = $w->Toplevel( -height => $w->height(), -width => $w->width(), ); $w->{'shadow'}->overrideredirect(1); $w->{'shadow'}->configure(-background => '#666666'); $w->{'shadow'}->Label(-takefocus => 1)->place(); my ($shadow_x, $shadow_y) = ($xx+2, $y+11); $w->{'shadow'}->geometry("+$shadow_x+$shadow_y"); }else { my ($shadow_x, $shadow_y) = ($xx+2, $y+11); $w->{'shadow'}-> geometry ("+$shadow_x+$shadow_y"); $w->{'shadow'}->configure( -height => $w->height(), -width => $w->width(), ); $w->{'shadow'}->deiconify(); } } # /Popup =head2 Deactivate( ??? ) =cut sub Deactivate { my ($w) = @_; my $delay = delete $w->{'delay'}; $delay->cancel if defined $delay; if ($w->{'popped'}) { my $client = $w->{'client'}; my $command = $w->GetOption(-cancelcommand => $client); if (defined $command) { # Execute the user's command and return if it returns false: return if not $command->Call($client); } $w->withdraw; $w-> {'shadow'}-> withdraw; $w->ClearStatus; $w->{'popped'} = 0; $w->{'menu_index'} = 'none'; $w->{'canvas_tag'} = ''; } $w->{'client'} = undef; $w->{'subclient'} = undef; $w->{'location'} = undef; } # /Deactivate 1;