view release on metacpan or  search on metacpan

IDEdragShadowToplevel.pm  view on Meta::CPAN

    use Tk::IDEdragShadowToplevel;

    $TabbedFrame = $widget->IDEdragShadowToplevel
       (
        -geometry => "30x30+10+30", # Format widthxheight+x+y
 	
       );



=head1 DESCRIPTION

This is a composite widget that implements a grey outline frame that can be used to show window shapes when
dragging, or drop-target areas. 

This differs from the releated L<Tk::IDEdragShadow> widget in that it acts like a top-level widget. It can be dragged
all around the desktop. L<Tk::IDEdragShadow> is a subwidget of a Mainwindow/Toplevel and can't be moved/displayed outside of it's
Mainwindow/Toplevel.

=head1 OPTIONS


=over 1

=item geometry

Geometry of the outline frame, in the form C<widthxheight+x+y>.


=back 

=head1 Advertised Subwidgets

=over 1

=item top/bot/left/right

4 separate L<Tk::Toplevel> components representing the top/bot/left/right element of the outline.

=back

=head1 ATTRIBUTES

None

=head1 Methods

=cut

package Tk::IDEdragShadowToplevel;

our ($VERSION) = ('0.37');

use Carp;
use strict;


use Tk;

use base qw/ Tk::Derived Tk::Frame/;


Tk::Widget->Construct("IDEdragShadowToplevel");

sub Populate {
    my ($cw, $args) = @_;
     
    $cw->SUPER::Populate($args);

    
    $cw->ConfigSpecs( 
		      -geometry => [ qw/METHOD geometry     geometry /,            undef ],
    );

    # Create components (Toplevels for each side of the shadow
    $cw->{top}    = $cw->Toplevel;
    $cw->{bot}    = $cw->Toplevel;
    $cw->{left}   = $cw->Toplevel;
    $cw->{right}  = $cw->Toplevel;
    
    $cw->{top}->overrideredirect(1);
    $cw->{bot}->overrideredirect(1);
    $cw->{left}->overrideredirect(1);
    $cw->{right}->overrideredirect(1);
    
    # Frames to populate each side
    $cw->{top}->Frame(-bg => 'darkgrey')->pack();
    $cw->{bot}->Frame(-bg => 'darkgrey')->pack();
    $cw->{left}->Frame(-bg => 'darkgrey')->pack();
    $cw->{right}->Frame(-bg => 'darkgrey')->pack();
    
    foreach (qw/ top bot left right /){
	    $cw->Advertise( $_ => $cw->{$_});
	    $cw->{$_}->deiconify
    }
 
  
    
}

#----------------------------------------------
# Sub called when -geometry option changed
#
sub geometry{
	my ($cw, $geometry) = @_;


	if(! defined($geometry)){ # Handle case where $widget->cget(-geometry) is called
		
		# Try the normal place where options are stored, if not there
		#   try the alternate location, incase widget has gone away.
		if( defined( $geometry = $cw->{Configure}{-geometry} )){
			return $geometry;
		}
		else{
			return $cw->{-geometry};
		}
		
	}