#!/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', 'Background', '#d9d9d9'], # grey -bordercolor => [{-background => $outer}, 'bordercolor', 'Bordercolor', '#000000'], # black -borderwidth => [{-borderwidth => $outer}, 'borderwidth', 'Borderwidth', 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();