Canvas floating above another canvas

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

I started work on a working GUI:

use Tk;
use Tk;
use Tk::PNG;
use Tk::LabFrame;
use Tk::Radiobutton;
use Tk::Pane;
use strict;

our $MW  = MainWindow->new(-title => " PROXY FOR MW");
$MW->geometry("+4+5");

review($MW);

MainLoop;


sub review
{
    my ($MW)    = @_;

    my ($RW, $FW, $CW) = makeReviewScreen($MW);  
   
}

sub makeReviewScreen
{
    my ($MW)    = @_;
    our $width  = $MW->screenwidth - 145;


    my $RW = $MW->Toplevel(-title => 'XXX');
    $RW->geometry("+0+5");

    my $LW = $RW->Frame;
    my $FW = $LW->Scrolled('Frame', -scrollbars => 'e')->pack(-expand 
+=> '1', -fill => 'y');
    my $ZW = $LW->LabFrame(-label => " ZOOM ", -labelside => "acrossto
+p", -bg => 'white');

    my $CW = $RW->Scrolled('WorldCanvas', -width        => $width,
                                     -height       => '480',
                                     -background   => 'white',
                                     -borderwidth  => '3',
                                     -scrollbars   => 'se',
                                     -relief       => 'sunken',
                                     -scrollregion => [-100,0, 6000,40
+00]);

    foreach my $zoom (-4, -3, -2, 1, 2, 3)                 # Make the 
+diagram zoom buttons here
    {
        my $text = ($zoom > 0) ? 100 * $zoom : 100 / $zoom;
        $text    = int($text);

        $ZW->Radiobutton( -text     => "$text Percent",
                          -bg       => 'white',
                          -value    => $zoom

                        )->pack;
    }

    $ZW->pack(-pady => 5);
    $LW->pack(-side => 'left', -fill => 'y',    -expand => '1', -ancho
+r => 'nw', );
    $CW->pack(-side => 'left', -fill => 'both', -expand => '1' );
    
    #addFloatingCanvas($RW, $FW, $CW);
    
    return( $RW, $FW, $CW);
}
[download]

I want to place a much smaller, non-scrolling Canvas such that it is floating in the top-right corner of the existing WorldCanvas. In other words, I want the new canvas to always be there and visible regardless of scrolling in the existing WorldCanvas.

================== Attempts ==================

The code for my failed attempts goes into a function named addFloatingCanvas($RW, $FW, $CW). The function call is commented out the code above.

I tried packing the new canvas it into the existing WorldCanvas, but it screws up all the dimensions:

sub addFloatingCanvas
{
    my ( $RW, $FW, $CW) = @_;
    
    my $CC = $CW->Canvas(-width        => '100',
                                        -height       => '100',
                                        -background   => 'grey',
                                        -borderwidth  => '3',
                                        -relief       => 'sunken'
                                        )->pack(-side => "right");
    
    
}
[download]

I also tried putting the new Canvas into the top-level and using form, but it get's really glitchy.

sub addFloatingCanvas
{
    my ( $RW, $FW, $CW) = @_;
    
    my $CC = $RW->Canvas(-width        => '100',
                                        -height       => '100',
                                        -background   => 'grey',
                                        -borderwidth  => '3',
                                        -relief       => 'sunken'
                                        )->form(-left => [$CW, -150]);
    
    
}
[download]

I'd appreciate any help you could offer.

Thanks,
Perldough

Comment on Canvas floating above another canvas Select or Download Code

Replies are listed 'Best First'.
Re: Canvas floating above another canvas by Anonymous Monk on Jul 26, 2012 at 21:41 UTC
There are other geometry managers besides pack, like Tk::place	[reply]
Re^2: Canvas floating above another canvas by Anonymous Monk on Jul 26, 2012 at 23:27 UTC
This "works" `use Tk; $mw=tkinit; $ca=$mw->Canvas(qw{-bg white})->pack; $fl=$mw->Canvas(qw{-bg red width 60 height 50 }); $fl->place(qw{ -anchor n -relx 1.0 }, -in => $ca ); MainLoop;` [download]	[reply] [d/l]
Re: Canvas floating above another canvas by zentara (Cardinal) on Jul 27, 2012 at 13:24 UTC
You might find nested and scrollbar linked Canvases what you need. #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = new MainWindow(); $mw->geometry("600x400+200+200"); #for xscroll, must be packed before midframe to be visible my $botframe = $mw->Frame(-bg=>'grey45') ->pack(-fill=>'x',-side=>'bottom'); 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 $num_channels = 40; my $canvasp; my $canvast = $midframer->Canvas( -bg =>'pale goldenrod', -width=>2400, -height=>25, #need to set scrollregion with a bit extra to ensure #endpoint accuracy. See xscrollit sub -scrollregion=>[-10,0,7450,25], -xscrollincrement => 1, )->pack(-side=>'top'); #for canvasp and yscroll my $midframer1 = $midframer->Frame(-bg=>'grey45') ->pack(-side=>'top'); my $yscroll = $midframer1->Scrollbar( -orient => 'vertical', -command => \&yscrollit, -troughcolor =>'grey45', -activebackground =>'lightseagreen', -background => 'lightseagreen', )->pack(-side=>'right',-fill=>'y'); my $canvasxsd = $botframe->Canvas( #dummy filler -bg =>'grey45', -width=>75, -height=>25, -borderwidth=>0, ) ->pack(-side=>'left'); my $xscroll = $botframe->Scrollbar( -orient => 'horizontal', -command => \&xscrollit , -troughcolor =>'grey45', -activebackground =>'lightseagreen', -background => 'lightseagreen', )->pack(-side=>'right', -fill=>'x',-expand =>1); print "$xscroll\n"; $canvasp = $midframer1->Canvas( -bg =>'lightsteelblue', -width=>2400, -height=> 50 * $num_channels, -scrollregion=>[-10,0,7450,(33 * $num_channels)], -xscrollincrement => 1, -yscrollincrement => 1, -xscrollcommand => [ 'set', $xscroll ], -yscrollcommand => [ 'set', $yscroll ], ) ->pack(-side=>'left');#,-fill=>'both'); my $canvasd = $midframel->Canvas( #top of left frame dummy filler -bg =>'grey45', -width=>75, -height=>25, -borderwidth =>0, )->pack(-side=>'top'); my $canvass = $midframel->Canvas( #left frame canvas -bg =>'lightseagreen', -width=>75, -height=> 50 * $num_channels, -scrollregion=>[0,0,75,(33 * $num_channels)], -yscrollincrement => 1, ) ->pack(-side=>'top'); #fill in some sample data to see scrolling action for( 1 .. 33 * $num_channels){ $canvass->createText(38, 10 + $_ * 33, -text => "C $_" , ); } #set up top frame canvas... a timeline for(0..7200){ if( $_ % 300 == 0){ my $time = $_ / 300; my $padded = ("0" x (2-length( $time ))).$time; $canvast->createLine($_,0,$_,12,-width=> 4,-tags=>['tick'] ); $canvast->createText($_, 20, -text=> "$padded:00",-tags=>['ti +ck'] ); }elsif( $_ % 150 == 0){ my $time = ($_ - 150) / 300; my $padded = ("0" x (2-length( $time ))).$time; $canvast->createLine($_,0,$_,10,-width => 2,-tags=>['tick']); $canvast->createText($_, 20, -text=> "$padded:30",-tags=>['ti +ck'] ); }elsif( $_ % 75 == 0){ $canvast->createLine($_,0,$_,6,-width => 1, -tags=>['tick']); } } #set up main frame canvas for(0..7200){ $canvasp->createText($_ * 20, 5 + $_ * 20, -text=> "Test $_", -tags=>['data'] ); } #--------------------------------------------------------------- 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. Old Perl Programmer Haiku ................... flash japh	[reply] [d/l]