use strict; use Tk; use Tk::Pane; my $mw = MainWindow->new; my $sPane = $mw->Scrolled("Pane", -scrollbars => 'se', -sticky => 'nsew', -bg => 'black', -width => 300, -height => 300 )->pack(qw/-expand 1 -fill both/); my $container = $sPane->Subwidget('scrolled'); foreach my $row (0 .. 3) { foreach my $col (0 .. 3) { createTile($container, $row, $col); } } foreach my $i (0 .. 3) { $container->gridRowconfigure($i, -weight => 1); $container->gridColumnconfigure($i, -weight => 1); } MainLoop; ## Each 'Tile' is a Frame containing a Scrolled Canvas + ## another Frame containing zoom controls. sub createTile { my ($parent, $x, $y) = @_; my $tileColor = "black"; my $tile = $parent->Frame(-bg => $tileColor)->grid( -padx => 5, -pady => 5, -row => $x, -column => $y, -sticky => 'nsew' ); my $sc = $tile->Scrolled('Canvas', -scrollbars => 'osoe', -scrollregion => [0, 0, 200, 200], -width => 125, -height => 125, -background => randColor() )->pack(qw/-fill both -side top -expand 1/); my $count = int(rand(6)) + 2; foreach my $i (1 .. $count) { my ($x, $y) = (randNumber(), randNumber()); my $size = randNumber(); $sc->createRectangle($x, $y, $x+$size, $y+$size, -fill => randColor(), -outline => 'black', -width => 2 ); } my $bFrame = $tile->Frame(-bg => $tileColor)->pack(qw/-side top/); $bFrame->Button( -text => " Zoom Out ", -command => sub { $sc->scale(qw/all 0 0 .5 .5/); } )->pack(qw/-side left -padx 5/); $bFrame->Button( -text => " Zoom In", -command => sub { $sc->scale(qw/all 0 0 2 2/); } )->pack(qw/-side right -padx 5/); } sub randColor { my @colors = qw(red yellow blue orange green purple); return $colors[rand($#colors + 1)]; } sub randNumber { my ($max, $min) = (100, 10); my $size = int(rand($max)); $size += $min if $size < $min; return $size; }