http://www.perlmonks.org?node_id=700202


in reply to Re: change title font in collapsable frame
in thread change title font in collapsable frame

If you are going to make your own copy of CollapsableFrame, would modifying this code in sub Populate also work?
$self->ConfigSpecs( ... -labelfont => [$self->{ident}, qw/font Font SomeFont/], );

Replies are listed 'Best First'.
Re^3: change title font in collapsable frame
by zentara (Archbishop) on Jul 25, 2008 at 20:25 UTC
    Well it was easy enought to try, and your method works. There is a sizing glitch I didn't work out, but the OP should be able to figure it out.
    #!/usr/bin/perl -w use Tk; use Tk::widgets qw/LabEntry/; use strict; package MyCollapsableFrame; use Carp; use Tk::widgets qw/Frame/; use vars qw/$cf_height_bias $im_Close $im_Open/; use strict; use base qw/Tk::Frame/; Construct Tk::Widget 'MyCollapsableFrame'; sub ClassInit { # Define global variables and images for the class. my($class, $mw) = @_; $cf_height_bias = 22; $im_Close = $mw->Bitmap(-data => <<'END'); #define close_width 16 #define close_height 16 static unsigned char close_bits[] = { 0x00, 0x80, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0x +c0, 0xf0, 0xc7, 0xe0, 0xc3, 0xc0, 0xc1, 0x80, 0xc0, 0x00, 0xc0, 0x00, 0x +c0, 0x00, 0xc0, 0x00, 0xc0, 0xfe, 0xff, 0xff, 0xff, }; END $im_Open = $mw->Bitmap(-data => << 'END'); #define open_width 16 #define open_height 16 static unsigned char open_bits[] = { 0x00, 0x80, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x40, 0xc0, 0xc0, 0x +c0, 0xc0, 0xc1, 0xc0, 0xc3, 0xc0, 0xc1, 0xc0, 0xc0, 0x40, 0xc0, 0x00, 0x +c0, 0x00, 0xc0, 0x00, 0xc0, 0xfe, 0xff, 0xff, 0xff, }; END $class->SUPER::ClassInit($mw); } # end ClassInit sub Populate { # Create an instance of a CollapsableFrame. Instance variables ar +e: # # {frame} = the ridged frame, which contains the open/close # Label image, the id Label for the collapsable Frame, # and the container Frame within which the user manages # collapsable widgets. It's ALMOST possible to forgo # this extra internal frame, were it not for the -pady # packer attribute we use to make the widget look pretty +. # {opcl} = the open/close image Label. # {ident} = the identifying Label. # {colf} = the user's container Frame, advertised as "colf". my($self, $args) = @_; my $height = $args->{-height}; croak "Tk::CollapsableFrame: -height must be >= $cf_height_bias" u +nless $height >= $cf_height_bias; $self->SUPER::Populate($args); $self->{frame} = $self->Frame( qw/-borderwidth 2 -height 16 -relief ridge/, ); $self->{frame}->pack( qw/-anchor center -expand 1 -fill x -pady 7 -side left/, ); $self->{opcl} = $self->Label( qw/-borderwidth 0 -relief raised/, -text => $height, ); $self->{opcl}->bind('<Button-1>' => [sub {$_[1]->toggle}, $self]); $self->{opcl}->place( qw/-x 5 -y -1 -width 21 -height 21 -anchor nw -bordermode igno +re/, ); $self->{ident} = $self->Label(qw/-anchor w -borderwidth 1/); $self->{ident}->place( qw/-x 23 -y 3 -height 12 -anchor nw -bordermode ignore/, ); $self->{colf} = $self->{frame}->Frame; $self->{colf}->place(qw/-x 20 -y 15 -relwidth 1.0 -width -20/); $self->Advertise('colf' => $self->{colf}); if (not defined $args->{-width}) { $args->{-width} = $self->parent->cget(-width); } $self->ConfigSpecs( -background => [['SELF', 'CHILDREN'], qw/background Background/ +], -height => [qw/METHOD height Height 47/], -image => [$self->{opcl}, 'image', 'Image', $im_Open], -title => '-text', -text => [$self->{ident}, qw/text Text NoTitle/], -font => [$self->{ident}, qw/font Font NoTitle/], -width => [$self->{frame}, qw/width Width 250/], ); } # end Populate sub bias {return $cf_height_bias} # Public instance methods. sub close { my($self) = @_; $self->{opcl}->configure(-image => $im_Open); $self->{frame}->configure(-height => 16); } sub open { my($self) = @_; $self->{opcl}->configure(-image => $im_Close); $self->{frame}->configure(-height => $self->{opcl}->cget(-text)); } sub state { my($self) = @_; my $i = $self->{opcl}->cget(-image); my $op = ($i == $im_Open) ? 'close' : 'open'; return $op; } sub toggle { my($self) = @_; my $i = $self->{opcl}->cget(-image); my $op = ($i == $im_Open) ? 'open' : 'close'; $self->$op(); } # Private instance methods. sub height { my($self, $h) = @_; $self->{opcl}->configure(-text => $h); } 1; package main; my $mw = MainWindow->new; $mw->fontCreate('big', -family=>'arial', -weight=>'bold', -size=>int(-18*18/14)); $mw->fontCreate('big1', -family=>'arial', -weight=>'bold', -size=>int(-10*10/14)); my $cf = $mw->MyCollapsableFrame( -background => 'lightblue', -height => 110, -title => 'Copy Details', -width => 300, -font => 'big1', ); $cf->pack(qw/-fill x -expand 1/); my $cf_frame = $cf->Subwidget('colf'); # Populate the CollapsableFrame with detail information. my ($file, $from, $to, $bytes) = ('Makefile.PL', '/home/bug', '/tmp', '1,847'); foreach my $item ( ['Copying', \$file], ['From', \$from], ['To', \$to], ['Bytes Copied', \$bytes], ) { my $l = $item->[0] . ':'; my $le = $cf_frame->LabEntry( -background => 'lightgreen', -highlightbackground => 'blue', -label => ' ' x (13 - length $l) . $l, -labelBackground => 'lightgreen', -labelPack => [qw/-side left -anchor w/], -labelFont => '9x15bold', -relief => 'flat', -state => 'disabled', -textvariable => $item->[1], -width => 35, ); $le->pack(qw/ -fill x -expand 1/); } my $button = $mw->Button(-text =>'Change Font', -command => sub{ $cf->configure(-font => 'big'); })->pack(); MainLoop;

    I'm not really a human, but I play one on earth Remember How Lucky You Are
Re^3: change title font in collapsable frame
by zentara (Archbishop) on Jul 25, 2008 at 20:00 UTC
    It looks like it would, but I've learned you have to try it to be sure. The problem seems to come when new() claims the option isn't legal for the package, or when you try to configure the object later, to modify the font. Or it may complain that -labelfont isn't an option of Frame.

    Did you try it? I would but I'm lazy. :-) I know it can be made to work. If you are going to do it, you may as well allow options for all the fonts used( even the list fonts).


    I'm not really a human, but I play one on earth Remember How Lucky You Are