1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
#!/usr/bin/perl use strict; use warnings; use Data::Dumper qw/Dumper/; use Tk; my $mw = tkinit(-width => 640, -height => 480); $mw->packPropagate(0); my $btn = $mw->Button(-text => 'show / hide left pane')->pack(); my $pane = $mw->Panedwindow()->pack(-fill => 'both', -expand => 1,); my $frame1 = $pane->Frame(-bg => 'blue'); my $canvas = $pane->Scrolled('Canvas', -bg => 'red', -scrollbars => 'se',); $pane->add($frame1, -width => 100,); $pane->add($canvas, -width => 400,); # -- canvas resize binding $canvas->Tk::bind('<Configure>' => sub{ my @bbox = $canvas->bbox("all"); $canvas->configure(-scrollregion => [ @bbox ]); }); $btn->configure(-command => sub{ toogle_frame($frame1, $canvas, $pane); return 1; }); $mw->MainLoop(); sub toogle_frame { my $frame1 = shift or die('Missing frame'); my $frame2 = shift or die('Missing frame'); my $pane = shift or die('Missing pane'); if( scalar( @{$pane->panes()} ) == 2 ) { $pane->forget($frame1); }else{ $pane->add($frame1, -before => $frame2, -width => 100); } } # /toogle_frame
QuoteTcl_GetStringFromObj @ 566 not utf8
SV = PV(0x36d4ec0) at 0x36f4c78
REFCNT = 1
FLAGS = (POK,pPOK,UTF8)
PV = 0x3818f28 "bad scrollRegion \"\310=O\3\""\0Malformed UTF-8 character (unexpected non-continuation byte 0x3d, immediately after start byte 0xc8) in subroutine entry at C:\Users\root\workspace\pd_tm\test\pane_n_canvas.pl line 22.
[UTF8 "bad scrollRegion "\x{0}O\x{3}""]
CUR = 23
LEN = 24
SV = PV(0x36d4ec0) at 0x36f4c78
REFCNT = 1
FLAGS = (POK,pPOK,UTF8)
PV = 0x3818f28 "bad scrollRegion \"\310=O\3\""\0Malformed UTF-8 character (unexpected non-continuation byte 0x3d, immediately after start byte 0xc8) in subroutine entry at C:\Users\root\workspace\pd_tm\test\pane_n_canvas.pl line 22.
[UTF8 "bad scrollRegion "\x{0}O\x{3}""]
CUR = 23
LEN = 24
Tk::Error: bad scrollRegion "?=O" at C:\Users\root\workspace\pd_tm\test\pane_n_canvas.pl line 22.
Tk callback for .panedwindow.canvas
<Configure>
(command bound to event)
1 2 3 4 5 6
# -- canvas resize binding $canvas->Tk::bind('<Configure>' => sub{ my @bbox = $canvas->bbox("all"); @bbox = (0, 0, 0, 0) if @bbox != 4; $canvas->configure(-scrollregion => [ @bbox ]); });
perldoc Tk::Canvas[...]
$canvas->bbox(tagOrId, ?tagOrId, tagOrId, ...?)
[...]If no items match any of the tagOrId arguments or if the matching items have empty bounding boxes (i.e. they have nothing to display) then an empty string is returned.