Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
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 romping around the Monastery: (7)
As of 2014-07-24 05:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (158 votes), past polls