Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Mega Widget Frame

by gpjahn (Initiate)
on Sep 27, 2018 at 18:44 UTC ( #1223174=perlquestion: print w/replies, xml ) Need Help??

gpjahn has asked for the wisdom of the Perl Monks concerning the following question:

Greetings monks! Question for everyone

I'm trying to create a custom frame that can have its border color changed (not just black). I've created a mega widget that basically places a frame inside a frame. I can then change the background of the outer frame to simulate a different colored border. Works great, with one exception; I can't seem to place (pack) objects such as a button on my new cool frame, easily. It want's to pack it onto the outer frame not on the inner frame.

I found that I have to reference the {'inner'} frame directly if I want to pack something onto it. I would really like to be able to just create my new colored frame and place something onto it just like a normal frame.

Any thought?

Here is the code for my mega widget:

package Tk::CoolFrame; use strict; use warnings; use vars qw/$VERSION/; $VERSION = '1.0'; use base qw(Tk::Frame); Construct Tk::Widget 'CoolFrame'; sub ClassInit { my($class, $mw) = @_; $class->SUPER::ClassInit($mw); } sub Populate { my($self, $args) = @_; $self->SUPER::Populate($args); my $outer = $self->Frame()->pack(-fill=> 'both', -expand=> 1); my $inner = $outer->Frame()->pack(-fill=> 'both', -expand=> 1); $self->ConfigSpecs( -background => [{-background => $inner}, 'background', 'Backg +round', '#d9d9d9'], # grey -bordercolor => [{-background => $outer}, 'bordercolor', 'Bord +ercolor', '#000000'], # black -borderwidth => [{-borderwidth => $outer}, 'borderwidth', 'Bor +derwidth', 1], 'DEFAULT' => [$outer], ); $self->{outer} = $outer; $self->{inner} = $inner; } 1; __END__

Program to demo my colored frame:

#!/usr/local/bin/perl -w use strict; use warnings; use Tk; use CoolFrame; my $mw = MainWindow->new(); $mw->geometry( ); my $frame = $mw->CoolFrame( -bordercolor => 'red', -background=> 'white', )->pack(-padx => 5, -pady => 5); # THIS WORKS my $button = $frame->{'inner'}->Button( -text=> "Exit", -command=> sub{ exit; }, )->pack(-padx => 5, -pady => 5); # THIS IS WHAT I WOULD LIKE TO DO! # my $button = $frame->Button( # -text=> "Exit", # -command=> sub{ exit; }, # )->pack(-padx => 5, -pady => 5); MainLoop(); 1; __END__

Thank you for your time!

Replies are listed 'Best First'.
Re: Mega Widget Frame
by tybalt89 (Prior) on Sep 27, 2018 at 19:13 UTC
    #!/usr/bin/perl # https://perlmonks.org/?node_id=1223174 use strict; use warnings; use Tk; #use CoolFrame; { package Tk::CoolFrame; use strict; use warnings; use vars qw/$VERSION/; $VERSION = '1.0'; use base qw(Tk::Frame); Construct Tk::Widget 'CoolFrame'; sub ClassInit { my($class, $mw) = @_; $class->SUPER::ClassInit($mw); } sub Populate { my($self, $args) = @_; $self->SUPER::Populate($args); my $outer = $self->Frame()->pack(-fill=> 'both', -expand=> 1); my $inner = $outer->Frame()->pack(-fill=> 'both', -expand=> 1); $self->ConfigSpecs( -background => [{-background => $inner}, 'background', 'Backg +round', '#d9d9d9'], # grey -bordercolor => [{-background => $outer}, 'bordercolor', 'Bord +ercolor', '#000000'], # black -borderwidth => [{-borderwidth => $outer}, 'borderwidth', 'Bor +derwidth', 1], 'DEFAULT' => [$outer], ); $self->{outer} = $outer; $self->{inner} = $inner; $self->Delegates('Construct' => $inner); # <--- add this } } ################################################### package main; my $mw = MainWindow->new(); $mw->geometry( ); my $frame = $mw->CoolFrame( -bordercolor => 'red', -background=> 'white', )->pack(-padx => 5, -pady => 5); # # THIS WORKS # my $button = $frame->{'inner'}->Button( # -text=> "Exit", # -command=> sub{ exit; }, # )->pack(-padx => 5, -pady => 5); # THIS IS WHAT I WOULD LIKE TO DO! my $button = $frame->Button( -text=> "Exit", -command=> sub{ exit; }, )->pack(-padx => 5, -pady => 5); MainLoop();
Re: Mega Widget Frame
by choroba (Archbishop) on Sep 27, 2018 at 19:17 UTC
    As shown at Tk::mega, you need to add the following to the end of Populate:
    $self->Delegates(Construct => $self->{inner});
    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
Re: Mega Widget Frame
by gpjahn (Initiate) on Sep 28, 2018 at 11:07 UTC
    Thank you Monks! This was much appreciated.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1223174]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (5)
As of 2020-10-20 12:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (210 votes). Check out past polls.

    Notices?