Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Canvas floating above another canvas

by perldough (Sexton)
on Jul 26, 2012 at 20:51 UTC ( #983934=perlquestion: print w/ replies, xml ) Need Help??
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); }

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"); }
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]); }

I'd appreciate any help you could offer.

Thanks,
Perldough

Comment on Canvas floating above another canvas
Select or Download Code
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

      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;
Re: Canvas floating above another canvas
by zentara (Archbishop) 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); } ####################################################################

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://983934]
Approved by BrowserUk
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (12)
As of 2014-10-21 11:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (100 votes), past polls