view release on metacpan or  search on metacpan

MDI/ChildWindow.pm  view on Meta::CPAN

package Tk::MDI::ChildWindow;

use strict;

my $unfocusedTitleBg = 'lightgray';      # bg color when no focus
my $focusedTitleBg   = 'papayawhip';       # default color when focused

my %changeCursorHash = 
	(
		n  => [qw/size_ns    top_side/],
		w  => [qw/size_we   left_side/],
		e  => [qw/size_we  right_side/],
		s  => [qw/size_ns bottom_side/],

		nw => [qw/size_nw_se     top_left_corner/],
		se => [qw/size_nw_se bottom_right_corner/],
		sw => [qw/size_ne_sw  bottom_left_corner/],
		ne => [qw/size_ne_sw    top_right_corner/],
	);

sub new {
	my $self  = shift;
	my $class = ref($self) || $self;

	my $obj = bless {} => $class;

	my %args  = @_;
	$obj->{PARENT}    = delete $args{-parent} or die "No Parent Frame";
	$obj->{PARENTOBJ} = delete $args{-parentobj} or die "No Parent Object";
	$obj->{NAME}     = $args{-name};
	$obj->{FOCUSBG}   = $args{-titlebg} || $focusedTitleBg;
	$obj->{MINFRAME}  = $args{-minframe};

	$obj->{EXTBD} = $obj->{PARENTOBJ}->_getExtBD;
	$obj->{INTBD} = $obj->{PARENTOBJ}->_getIntBD;
	$obj->{MINIMIZEDHEIGHT}=23;
	$obj->{MINIMIZEDWIDTH}=120;
	$obj->{CASCADEHEIGHT}=400;
	$obj->{CASCADEWIDTH}=500;

	my $x = delete $args{-x} || 0;
	my $y = delete $args{-y} || 0;
	$x=$y=0 unless ($x == $y);
	my $h = delete $args{-height} || $obj->{CASCADEHEIGHT};
	my $w = delete $args{-width} || $obj->{CASCADEWIDTH};

	$obj->{EXTERNAL} = $obj->{PARENT}->Frame(
				-relief=>'raised',
				-bd=>$obj->{EXTBD}
				)->place(-x=>$x,-y=>$y,-width=>$w,-height=>$h);

	$obj->{INTERNAL} = $obj->{EXTERNAL}->Frame(
				-relief=>'flat',
				-bd=>$obj->{INTBD},
				)->pack(qw/-fill both -expand 1/);

	$obj->{TITLE} = $obj->{INTERNAL}->Frame(
				-relief=>'flat', 
				-height=>$obj->{MINIMIZEDHEIGHT},
				-bd=>0,
				-bg => $obj->{FOCUSBG},
				)->pack(qw/-fill x -expand 0/);

	$obj->{MAIN} = $obj->{INTERNAL}->Frame(
				-container => 1,
				)->pack(qw/-fill both -expand 1/);

	# for some reason I need an eval here to get it to work on winblowZ.
	$obj->{TOPLEVEL} = $obj->{PARENT}->Toplevel(-use => eval $obj->{MAIN}->id);

	$obj->{TITLELABEL} = $obj->{TITLE}->Label(
				-text => $obj->{NAME},
				-bg   => $obj->{FOCUSBG},
				-anchor => 'w',
				)->grid(qw/-row 0 -column 0 -sticky nesw/);

	# populate the title.
	$obj->{CLOSEBUTTON}=$obj->{TITLE}->Button(
				-image=>$obj->{PARENTOBJ}->{IMAGES}->{close},
				-command => sub { $obj->_killWindow(1) },
				)->grid(qw/-row 0 -column 3 -sticky ew -padx 2/);
                         
	# We put the Restore button directly beneath the minimize and maximize buttons.
	# This means only we only need a Tk::raise to toggle between them
	$obj->{RESTORE_FROM_MAX}=$obj->{TITLE}->Button(