Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re^2: change title font in collapsable frame

by pc88mxer (Vicar)
on Jul 25, 2008 at 18:51 UTC ( #700202=note: print w/ replies, xml ) Need Help??


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/], );


Comment on Re^2: change title font in collapsable frame
Select or Download Code
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
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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://700202]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2014-08-30 06:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (291 votes), past polls