#!/usr/bin/perl use warnings; use strict; use Tk; use Tk::NoteBook; use Tk::Pane; use Tk::DialogBox; my $mw = new MainWindow; $mw->geometry("600x350"); my @files = qw/standard crystal ikons kde klassic sat slick /; my %page; my $topframe = $mw->Frame(-background => 'lightsteelblue') ->pack( -fill =>'x'); my $topframe1 = $mw->Frame(-background => 'skyblue') ->pack( -fill =>'x'); $topframe->Label(-text=>'Left Click - copy&paste', -background=> 'lightsteelblue') ->pack(-side =>'left',-padx=>20); $topframe->Button(-text => 'Exit', -command => sub{Tk::exit} )->pack(-side =>'right',-padx=>20); my $selected = 'No Selection'; $topframe1->Label( -width => 30, -textvariable => \$selected, -background=>'white')->pack(-side =>'top'); my $nb = $mw->NoteBook( -font => "Arial 24", -background=>'lightgreen', -inactivebackground => "grey", -tabpadx => 5, -tabpady => 5, )->pack( -expand => 1, -fill => 'both' ); ### add tabs to notebook foreach my $file (@files){ my $title = $file; $page{$file}{'tab'} = $nb->add( $file, -label => $title, -raisecmd =>[\&load_frame,$file], ); $page{$file}{'pane'} = $page{$file}{'tab'}->Scrolled('Pane', -scrollbars=>'osoe', sticky=>'nwse') ->pack(-expand => 1 , -fill => 'both'); $page{$file}{'loaded'} = 0; } MainLoop; sub load_frame{ my $file = shift; if($page{$file}{'loaded'} == 1){return}; #only load icons once open my $fh, "ICONS/$file" or die $!; my %icons; while (<$fh>) { chomp; my ($n, $d) = (split /:/)[0, 4]; $icons{$n} = $mw->Photo(-data => $d); } close $fh; my $f = $page{$file}{'pane'}; my $r = my $c = 0; my %labels; for my $n (sort keys %icons) { $labels{$file}{$n} = $page{$file}{'pane'}->Label( -image => $icons{$n}, )->grid(-column => $c, -row => $r, ); $labels{$file}{$n}->bind("", sub {$labels{$file}{$n}->configure( -bg => 'white'); $selected = $n; }); $labels{$file}{$n}->bind("", sub {$labels{$file}{$n}->configure( -bg => 'lightgrey'); $selected = $n; }); $labels{$file}{$n}->bind('<1>', sub { &copaste($file,$n) } ); $c++; if ($c == 20) { $r++; $c = 0; } } $page{$file}{'loaded'} = 1; } sub copaste { my($file,$name) = @_; my $data; open my $fh, "ICONS/$file" or die $!; while (<$fh>) { chomp; my ($n, $d) = (split /:/)[0, 4]; next unless $n eq $name; $data = "\'".$d."\'"; last; } close $fh; my $string = "my \$$name = \$mw->Photo(-data => $data);"; my $top = $mw->Toplevel(-title => 'Cut-&-Paste'); my $text = $top->Text( -bg=>'white'); $text->insert('end',$string); $text->pack; $top->Button( -text => 'Exit', -command => sub{$top->destroy}, )->pack; $top->transient($mw); }