Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

how to change the font of a perl tk gui

by ghosh123 (Monk)
on Aug 16, 2013 at 11:40 UTC ( #1049729=perlquestion: print w/replies, xml ) Need Help??

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

Hi
I have a Tk gui which is showing the report of the usage of some tool from a report file which is downloaded from some website. The gui lets the user select the report file by a drop-down and populates the gui under its respective columns by some calculation.

Question is, the gui size is defaulted to "560x250". But how can I introduce a mechanism so that the gui size can be reduced according to user preference and obviously the fonts of the Tk objects on it should also get reduced so that everything can be accomodated in the small gui size with small fonts. Is that possible ?

I am including only the relevant portion of the code here which will give you an idea about the structure of the gui and the Tk objects on it. For a particular report file the gui also gets refreshed every 30 secs and displays the updated report. To run it , assuming you save the code by the name 'srcipt', use following command :

script -u "myself"

The code is below :

use strict; use warnings; use Getopt::Long; use LWP::Simple; use List::MoreUtils qw(indexes); use Tk; use Tk::HList; use Tk::ItemStyle; use Tk::BrowseEntry; use Tk::Toplevel; use Tk::ROText; use Tk::Menubutton; #Input file parsing my ($user,$file,$other); my $licHash = {}; my ($tool,$issued,$use,$vendor,$feature); my $sec = 30; #000; GetOptions("u=s" => \$user, "f=s" => \$file); my $timer; my $others = []; unless (defined $user) { $user = $ENV{USER}; } # url hash my %url = ( report => "http://webdesk.com:8002/cache/report.txt", srs => "http://webdesk.com:8002/cache/srs.txt", ); unless (defined $file) { $file = "report"; #default to snps prod } my $selectfile = $file; # Making the GUI my $mw = new MainWindow; $mw->title("View"); $mw->geometry("560x250"); my $userframe = $mw->Frame(-width=>5,-height=>10)->pack(-side=>'top',- +anchor=>'nw'); $userframe->Label(-text => "USER: $user")->pack(-side => 'left',-ancho +r => 'w',-padx => 0); $userframe->Label(-text => "Set time(sec)")->pack(-side => 'left',-anc +hor => 'w',-padx => 0); my $frequency = $userframe->Entry(-width=> 5,-textvariable=> \$sec)->p +ack(-side => 'left',-anchor => 'nw',-padx => 0); $userframe->Label(-text => "Select File")->pack(-side => 'left',-ancho +r => 'w',-padx => 0); $userframe->BrowseEntry( -state => 'normal', -choices => [keys %url], -variable => \$selectfile, -browsecmd => \&read_file, )->pack(-side=>'right',-anchor =>' +e'); my $hlistframe = $mw->Frame()->pack(-fill => 'both',-expand=>1); my $h +l; my $bottomframe = $mw->Frame()->pack(-fill => 'both', -expand => 1); $bottomframe->Button(-text => "Display File",-command => \&dumpOnTermi +nal)->pack(-side=>'right',-anchor => 'se',-fill=>'both'); my ($general,$general_nw, $allok ,$allok_nw,$alert,$alert_nw,$cautious +,$cautious_nw,$gray); my ($label1,$label2,$label3,$label4,$label5,$label6,$label7); sub dumpOnTerminal { } sub create_hlist { $hl = $hlistframe->Scrolled('HList', -scrollbars => 'ose', -columns =>7 , -header => 1, -width => 100, -command => sub {print "AAA\n";}, )->pack(-fill => 'both',-expand =>1 ); $label1 = $hl->Label(-text => "Tool", -anchor => 'w'); $hl->headerCreate(0,-itemtype => 'window',-widget => $label1) ; $label2 = $hl->Label(-text => "Vendor", -anchor => 'w'); $hl->headerCreate(1,-itemtype => 'window',-widget => $label2); $label3 = $hl->Label(-text => "Available", -anchor => 'w'); $hl->headerCreate(2,-itemtype => 'window',-widget => $label3); $label4 = $hl->Label(-text => "num.", -anchor => 'w'); $hl->headerCreate(3,-itemtype => 'window',-widget => $label4); $label5 = $hl->Label(-text => "usage%", -anchor => 'w'); $hl->headerCreate(4,-itemtype => 'window',-widget => $label5); $label6 = $hl->Label(-text => "user", -anchor => 'w'); $hl->headerCreate(5,-itemtype => 'window',-widget => $label6); $label7 = $hl->Label(-text => "user%", -anchor => 'w'); $hl->headerCreate(6,-itemtype => 'window',-widget => $label7); $general = $hl->ItemStyle('text', -selectforeground =>'black', -ancho +r =>'center'); $general_nw = $hl->ItemStyle('text', -selectforeground =>'black', -an +chor =>'nw'); $allok = $hl->ItemStyle('text', -selectforeground =>'black', -ancho +r =>'center',-background =>'green'); $allok_nw = $hl->ItemStyle('text', -selectforeground =>'black', -an +chor =>'nw',-background =>'green'); $alert = $hl->ItemStyle('text', -selectforeground =>'black', -ancho +r =>'center',-background =>'red'); $alert_nw = $hl->ItemStyle('text', -selectforeground =>'black', -anch +or =>'nw',-background =>'red'); $cautious = $hl->ItemStyle('text', -selectforeground =>'black', -anch +or =>'center',-background =>'yellow'); $cautious_nw = $hl->ItemStyle('text', -selectforeground =>'black', -a +nchor =>'nw',-background =>'yellow'); $gray = $hl->ItemStyle('text', -selectforeground =>'black', -anchor = +>'nw',-background =>'gray'); } showData(); $mw->after($sec*1000, \&clearAndLoadData); MainLoop; sub read_file { # download the file from the url and extract info } sub showData { &read_file(); &create_hlist(); } sub clearAndLoadData { my $value = ${$frequency->cget(-textvariable)}; $hl->destroy; read_file(); &create_hlist(); my $path = 0; my @keys = keys %$licHash; my $pos = indexes {$keys[$_] eq $user } 0 ..$#keys; if($pos){ splice @keys,$pos,1; unshift @keys , $user; } foreach my $key (@keys) { for my $tool (sort keys %{$licHash->{$key}}) { # _insertData($path,$tool,$key); $path++; } } # make a lower bound for timer # in case your user sets $sec to 0 if( $sec < 1){ $sec = 1 } # reinstall 1 shot timer for another run $mw->after( $sec*1000, \&clearAndLoadData); } sub _insertData { # some itemCreate statements here } MainLoop;

Replies are listed 'Best First'.
Re: how to change the font of a perl tk gui
by choroba (Archbishop) on Aug 16, 2013 at 13:04 UTC
    This short programme demonstrates how to change font size. I hope it can help you.
    #!/usr/bin/perl use warnings; use strict; use Tk; use Tk::Font; sub change { my ($size_ref, $change, $l) = @_; $$size_ref += $change; $l->configure(-font => $l->fontCreate(-size => $$size_ref)); } my $mw = 'MainWindow'->new(-title => 'Scalable'); my $size = 12; my $font = $mw->fontCreate(-size => $size); my $l = $mw->Label(-text => 'Some text', -font => $font)->pack; my $f = $mw->Frame->pack; my $plus = $f->Button(-text => '+', -command => [\&change, \$size, 1 +, $l])->pack(-side => 'left'); my $minus = $f->Button(-text => '-', -command => [\&change, \$size, -1 +, $l])->pack(-side => 'right'); my $quit = $mw->Button(-text => 'Quit', -command => sub { exit })->pack; MainLoop();
    لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

      Hi,
      It is easy for a Tk::Label widget to change its font by passing the $l object to the change(). But in my case , how can this be achieved , where I have Frames and on that HList widget and ItemStyles .

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1049729]
Approved by ww
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (1)
As of 2022-05-19 03:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (71 votes). Check out past polls.

    Notices?