view release on metacpan or  search on metacpan

lib/Tcl/pTk/demos/widget_lib/mclist.pl  view on Meta::CPAN

# Demo of tile widget

use warnings;
use strict;

use vars qw/$TOP/;

sub mclist {

        # Create a top-level window that displays a bunch of entries.
        
        my($demo) = @_;
        $TOP = $MW->WidgetDemo(
                -name     => $demo,
                -title    => 'Tile Widget Tree Demo',
                -text	  => '',
                -iconname => 'mclist',
        );

        my $msg = $TOP->ttkLabel( -text => 
                "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which can be configured to display multiple columns of informational data without displaying the tree itself. This is a simple way to build a listb...
                qw/ -wraplength 4i -justify left/)->pack(-side => 'top', -fill => 'x');
         
                
        # Make the button frame
        my $bigFrame = $TOP->ttkFrame()->pack(-expand => 'y', -fill => 'both');
        
        my $tree = $bigFrame->Scrolled('ttkTreeview',-columns => [qw/ country capital currency/], -show => 'headings',       -scrollbars => 'se' )->pack(-fill => 'both', -expand => 1);
        #my $tree = $bigFrame->ttkTreeview(-columns => [qw/ country capital currency/], -show => 'headings')->pack(-fill => 'both', -expand => 1);
        
        my @data = (        
            'Argentina',	'Buenos Aires',		'ARS',
            'Australia',	'Canberra',		'AUD',
            'Brazil',		'Brazilia',		'BRL',
            'Canada',		'Ottawa',		'CAD',
            'China',		'Beijing',		'CNY',
            'France',		'Paris',		'EUR',
            'Germany',		'Berlin',		'EUR',
            'India',		'New Delhi',		'INR',
            'Italy',		'Rome',			'EUR',
            'Japan',		'Tokyo',		'JPY',
            'Mexico',		'Mexico City',		'MXN',
            'Russia',		'Moscow',		'RUB',
            'South Africa',	'Pretoria',		'ZAR',
            'United Kingdom',	'London',		'GBP',
            'United States',	'Washington, D.C.',	'USD',
            );
        
        
        my $style = $tree->cget(-style);
        my $font = $tree->ttkStyleLookup( $style, -font);
        
        ## Code to insert the data nicely
        foreach my $col (qw/ country capital currency /){
                my $name = ucfirst($col);
                # Set heading name and sort fommand, using the real (not scrolled) tree widget
                $tree->heading($col, -command => [\&SortBy, $tree->Subwidget('scrolled'), $col, 0], -text => $name );
                
                my $len = $tree->fontMeasure($font, $name);
                #print "Setting $col width to $len\n";
                $tree->column($col, -width, $len+10);
        }
        
        
        while(@data){
                my $country  = shift @data;
                my $capital  = shift @data;
                my $currency = shift @data;
                
                $tree->insert('', 'end', -values => [$country, $capital, $currency]);
                
                # Auto-set length of field based on data init
                my %rowLookup; # Hash for quick lookup
                @rowLookup{qw/ country capital currency /} = ($country, $capital, $currency);
                foreach my $col (qw/ country capital currency /){
                     
                        my $len = $tree->fontMeasure($font, $rowLookup{$col}."  ");
                        if( $tree->column($col, -width) < $len ){
                                #print "setting $col width to $len\n";
                                $tree->column($col, -width => $len);
                        }
                }
                             
        }

}
 
## Code to do the sorting of the tree contents when clicked on
sub SortBy{