comment on

I think you are looking for a canvas set with linked scrollbars. Here is a general purpose example. You will notice, that you need to be extremely careful making sure the scrolled canvas regions are identical (pixel wise) in both directions. This means having a table setup, with the corners empty. If you try to make independent scrollbars and canveses, side by-side, you will find it difficult to get the exact pixel width to match and it will slightly throw off the scrolling at the extreme ends of the scrollregion. I also included a rudimentary example of binding to tags.....tags are the key to succesfull canvas useage. You will see as you move your mouse over the entries, that the colorboxes and the text interfere with one another........it is easily fixed by a better tag setup, but I leave it as is, to emphasize how the tags work. You can search groups.google.com for "Perl Tk canvas tags" and get many examples of clever tag usage.....it becomes a juggling act where you dynamically add/remove tags to items.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

# the left side canvas
my @chs = (0..48);  # ascending order
my $num_channels = scalar @chs;

my $mw =  new MainWindow();
$mw->geometry("600x400+200+200");

$mw->fontCreate('big',
   -family=>'arial',
  -weight=>'bold',
  -size=>int(-18*18/14));

$mw->fontCreate('medium',
   -family=>'arial',
   -weight=>'bold',
   -size=>int(-12*12/10));

$mw->fontCreate('small',
   -family=>'arial',
   -weight=>'normal',
   -size=>int(-10*10/10));


my $topframe = $mw->Frame(-bg=>'grey45')->pack();
my $infolab = $topframe->Label(-text =>'Some Info',
                               -bg=>'grey45',
                               -fg=>'lightgreen',
                                )->pack();

my $midframe = $mw->Frame(-bg=>'grey45')->pack();
my $midframel = $midframe->Frame(-bg=>'grey45')
                   ->pack(-side=>'left',-expand=>1,-fill=>'y');
my $midframer = $midframe->Frame(-bg=>'grey45')
                   ->pack(-side=>'right');

my $botframe = $mw->Frame(-bg=>'grey45')->pack();

my $canvast = $midframer->Scrolled('Canvas',
             -bg =>'lightyellow',
             -width=>2400,
             -height=>25,
         -scrollregion=>[-10,0,7250,25],
         -scrollbars =>'e',
         -xscrollincrement => 1,
         ) ->pack(-side=>'top');

my $canvasp = $midframer->Scrolled('Canvas',
             -bg =>'lightsteelblue',
             -width=>2400,
             -height=> 50 * $num_channels,
             -scrollregion=>[-10,0,7250,(50 * $num_channels)],
             -scrollbars=>'se',
         -xscrollincrement => 1,
         -yscrollincrement => 1,
         ) ->pack(-side=>'bottom',-fill=>'both');

#need real canvas for binding
my $realcan = $canvasp->Subwidget("scrolled");

my $canvasd = $midframel->Canvas(
             -bg =>'grey45',
             -width=>75,
             -height=>25,
         ) ->pack(-side=>'top');

my $canvass = $midframel->Scrolled('Canvas',
             -bg =>'lightsteelblue',
             -width=>75,
             -height=> 50 * $num_channels,
             -scrollregion=>[0,0,75,(50 * $num_channels)],
             -scrollbars =>'s',
         -yscrollincrement => 1,
         ) ->pack(-side=>'top');


my $xscroll = $canvasp->Subwidget("xscrollbar");
my $yscroll = $canvasp->Subwidget("yscrollbar");
$xscroll->configure(-troughcolor =>'grey45',
                    -activebackground =>'lightseagreen',
            -background =>'lightseagreen',
            -command => \&xscrollit,
            );
$yscroll->configure(-troughcolor =>'grey45',
                    -activebackground =>'lightseagreen',
            -background => 'lightseagreen',
            -command => \&yscrollit,
            );

#hidden and disabled scrollbars
my $xscroll1 = $canvass->Subwidget("xscrollbar");
my $yscroll1 = $canvast->Subwidget("yscrollbar");
$xscroll1->configure(-troughcolor =>'grey45',
                    -activebackground =>'grey45',
            -background =>'grey45',
            -highlightcolor =>'grey45',
            -highlightbackground => 'grey45',
            -elementborderwidth => 0,
            -relief => 'flat',
            );

$yscroll1->configure(-troughcolor =>'grey45',
                    -activebackground =>'grey45',
            -background =>'grey45',
            -highlightcolor =>'grey45',
            -highlightbackground => 'grey45',
            -elementborderwidth => 0,
            -relief => 'flat',
            );

##############################################################

#create timebar and markers

for(0..24000){
  if( $_ % 100 == 0){
      $canvast->createLine($_,0,$_,10);
      $canvast->createText($_,20,-text=>$_);
      next;
   }
}

=head
for(0..7200){
       
      if( $_ % 300 == 0){
         my $time =  $_ / 300;
         my $padded = ("0" x (2-length( $time ))).$time;
         $canvast->createLine($_,0,$_,12,-width=> 4 );
         $canvast->createText($_, 20, -text=> "$padded:00" );
 
      }elsif( $_ % 150 == 0){
          my $time =  ($_ - 150) / 300;
          my $padded = ("0" x (2-length( $time ))).$time;
         
         $canvast->createLine($_,0,$_,10,-width => 2);
         $canvast->createText($_, 20, -text=> "$padded:30" );
      
      }elsif( $_ % 75 == 0){
         $canvast->createLine($_,0,$_,6,-width => 1);
         
      }      
 
}
=cut

#--create left side station boxes---------------------------------
#need to store y pixel locations to fill in data in an orderly manner
my %slots;  #used to hold locations for main data positions

foreach my $slotnum (0 .. $num_channels){
   my $ch = shift @chs;

   $slots{$slotnum}{'channel'} = $ch;
   $slots{$slotnum}{'top'} =  2 + $slotnum * 50;
   $slots{$slotnum}{'bottom'} = 48 + $slotnum * 50;
   $slots{$slotnum}{'toptext'} = 15 + $slotnum * 50;
   $slots{$slotnum}{'midtext'} = 30 + $slotnum * 50;
   $slots{$slotnum}{'bottext'} = 45 + $slotnum * 50;

   $canvass->createRectangle(0, 2 + $slotnum * 50, 75, 48 + $slotnum *
+ 50 ,
              -fill =>'#f4dae4',
            );
   
   $canvass->createText(38, 15 + $slotnum * 50,
              -text => $ch ,
              -font => 'big',
        );
  
   $canvass->createText(38, 35 + $slotnum * 50,
              -text => $ch ,
              -font => 'medium',
          -fill => 'blue'
        );
}

#########################################
# now fill in some data
 
foreach my $slotnum (0 .. $num_channels){
    
    for(0..24000){
         if( $_ % 100 == 0){
             
        # actually you should do a bbox of the text below
        # to find the rect boundaries, but I cheat here
        # and hardwire in a 60 pixel width 
        my $rect = $canvasp->createRectangle($_- 30 ,$slots{$slotnum}{
+'top'} - 2,
                                      $_+ 30 ,$slots{$slotnum}{'bottom
+'} - 2,
              -fill =>'#dddddd',
              -tags => ['rect',$_,$slotnum],
            );
             
         my $text = $canvasp->createText( $_, $slots{$slotnum}{'midtex
+t'},
                  -text=>  $slotnum.'-'.$_,
                  -tags => ['text',$_,$slotnum]
                  );
             next;
          
          }
     }

}

# add some bindings
$realcan->bind("rect", "<Enter>", 
         sub { $realcan->itemconfigure("current", -fill => '#ffffff');
+ });
# When the mouse is not over, color it grey.
$realcan->bind("rect", "<Leave>",
         sub { $realcan->itemconfigure("current", -fill => '#dddddd');
+ });

#get info on left mouse click
$realcan->bind('rect',"<1>",sub {  
     my $item = $realcan->find('withtag','current');
     my (@tags) = $realcan->gettags($item);
     print join '-',@tags,"\n";
});

MainLoop;

#########
sub xscrollit{
 my $fraction = $_[1];
 $canvast->xviewMoveto($fraction);
 $canvasp->xviewMoveto($fraction);
}
########################################
sub yscrollit{
  my $fraction = $_[1];
  $canvass->yviewMoveto($fraction);
  $canvasp->yviewMoveto($fraction);

}
[download]

I'm not really a human, but I play one on earth Remember How Lucky You Are

In reply to Re: I seek illumination and knowledge by zentara
in thread I seek illumination and knowledge by deesler

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.