1###################################################################### 2# Modified on January 4, 1998 to correct order of insertion problem # 3# Modified on January 7, 1998 to add slider decoration # 4# Modified on January 9, 1998 to correct color name problem # 5# Modified on January 27, 1998 to correct inaccurate border layout # 6# Modified on January 27, 1998 to use proper notify method overload # 7# Modified on January 27, 1998 added -padafter and -padbefore params # 8# for controlling size of inner widget # 9# Modified on April 6, 1998 Incorporated into release library # 10###################################################################### 11# THIS IS THE CORRECT ONE # 12###################################################################### 13 14package Tk::SplitFrame; 15 16use Tk; 17use Tk::ChildNotification; 18use Tk::Derived; 19use Tk::Widget; 20use Tk::Frame; 21 22use base qw (Tk::Derived Tk::Widget Tk::Frame); 23use vars qw ($VERSION); 24use strict; 25use Carp; 26 27$VERSION = '0.02'; 28 29Tk::Widget->Construct ('SplitFrame'); 30 31sub Populate 32 { 33 my ($this) = (shift, @_); 34 35 $this->SUPER::Populate (@_); 36 37 my $l_LastBorder = $this->Component 38 ( 39 'Frame' => 'LastBorder', 40 '-relief' => 'sunken', 41 ); 42 43 my $l_FirstBorder = $this->Component 44 ( 45 'Frame' => 'FirstBorder', 46 '-relief' => 'sunken', 47 ); 48 49 my $l_Slider = $this->Component 50 ( 51 'Frame' => 'Slider', 52 '-relief' => 'sunken', 53 '-borderwidth' => 0, 54 '-relief' => 'flat', 55 ); 56 57 $l_Slider->bind ('<ButtonRelease-1>' => sub {$this->SliderReleased();}); 58 $l_Slider->bind ('<ButtonPress-1>' => sub {$this->SliderClicked();}); 59 $l_Slider->bind ('<B1-Motion>' => sub {$this->SliderMoved();}); 60 $this->bind ('<Configure>' => sub {$this->Redraw();}); 61 $this->bind ('<Map>' => sub {$this->Redraw();}); 62 63 $this->Advertise (FirstBorder => $l_FirstBorder); 64 $this->Advertise (LastBorder => $l_LastBorder); 65 $this->Advertise (Slider => $l_Slider); 66 67 my $l_BaseColor = $this->cget ('-background'); 68 69 $this->ConfigSpecs 70 ( 71 '-orientation' => [['SELF', 'PASSIVE'], 'orientation', 'Orientation', 'vertical'], 72 '-trimcolor' => [['SELF', 'PASSIVE'], 'trimcolor','trimcolor', $l_BaseColor], 73 '-background' => ['SELF','background', 'Background', $l_BaseColor], 74 '-borderwidth' => ['METHOD', 'borderwidth', 'BorderWidth', 2], 75 '-sliderposition' => ['METHOD', 'sliderposition', 'SliderPosition', 60], 76 '-sliderwidth' => [['SELF', 'PASSIVE'], 'SliderWidth', 'SliderWidth', 7], 77 '-relief' => [['SELF', 'PASSIVE'], 'relief', 'Relief', 'flat'], 78 '-height' => [['SELF', 'PASSIVE'], 'height', 'Height', 100], 79 '-width' => [['SELF', 'PASSIVE'], 'width', 'Width', 100], 80 '-opaque' => [['SELF', 'PASSIVE'], 'opaque', 'Opaque', 1], 81 '-trimcount' => [['SELF', 'PASSIVE'], 'trimCount', 'TrimCount', 5], 82 '-padbefore' => [['SELF', 'PASSIVE'], 'padbefore', 'PadBefore', 0], 83 '-padafter' => [['SELF', 'PASSIVE'], 'padafter', 'PadAfter', 0], 84 ); 85 86 return $this; 87 } 88 89sub Redraw 90 { 91 my ($l_Cursor, $this) = (undef, shift, @_); 92 93 my ($l_FirstClient, $l_LastClient) = @{$this->{m_ClientList}}; 94 my $l_FirstBorderWidth = $this->cget ('-borderwidth'); 95 my $l_LastBorderWidth = $this->cget ('-borderwidth'); 96 my $l_Foreground = $this->cget ('-trimcolor'); 97 my $l_Background = $this->cget ('-background'); 98 my $l_FirstBorder = $this->Subwidget ('FirstBorder'); 99 my $l_LastBorder = $this->Subwidget ('LastBorder'); 100 my $l_Slider = $this->Subwidget ('Slider'); 101 my $l_Position = $this->cget ('-sliderposition'); 102 my $l_SliderWidth = $this->cget ('-sliderwidth'); 103 my @l_FirstDimensions = (0, 0, 0, 0); 104 my @l_LastDimensions = (0, 0, 0, 0); 105 my $l_Height = $this->height(); 106 my $l_Width = $this->width(); 107 108 $l_FirstBorder->configure 109 ( 110 '-borderwidth' => $l_FirstBorderWidth, 111 '-background' => $l_Foreground, 112 ); 113 114 $l_LastBorder->configure 115 ( 116 '-borderwidth' => $l_LastBorderWidth, 117 '-background' => $l_Foreground, 118 ); 119 120 if ($l_FirstClient->class() eq $this->class()) 121 { 122 $l_FirstBorder->configure ('-borderwidth' => 0, '-relief' => 'flat'); 123 $l_FirstBorderWidth = 0; 124 } 125 126 if ($l_LastClient->class() eq $this->class()) 127 { 128 $l_LastBorder->configure ('-borderwidth' => 0, '-relief' => 'flat'); 129 $l_LastBorderWidth = 0; 130 } 131 132 if ($this->cget ('-orientation') eq 'vertical') 133 { 134 $l_Slider->place 135 ( 136 '-x' => $l_Position, 137 '-y' => 0, 138 '-width' => $l_SliderWidth, 139 '-height' => $l_Height, 140 ); 141 142 $l_FirstBorder->place 143 ( 144 '-x' => $l_FirstDimensions [0] = 0, 145 '-y' => $l_FirstDimensions [1] = 0, 146 '-width' => $l_FirstDimensions [2] = $l_Position, 147 '-height' => $l_FirstDimensions [3] = $l_Height, 148 ); 149 150 $l_LastBorder->place 151 ( 152 '-x' => $l_LastDimensions [0] = $l_Position + $l_SliderWidth, 153 '-y' => $l_LastDimensions [1] = 0, 154 '-width' => $l_LastDimensions [2] = $l_Width - ($l_Position + $l_SliderWidth), 155 '-height' => $l_LastDimensions [3] = $l_Height, 156 ); 157 158 $l_Cursor = 'sb_h_double_arrow'; 159 } 160 else 161 { 162 $l_Slider->place 163 ( 164 '-x' => 0, 165 '-y' => $l_Position, 166 '-width' => $l_Width, 167 '-height' => $l_SliderWidth, 168 ); 169 170 $l_FirstBorder->place 171 ( 172 '-x' => $l_FirstDimensions [0] = 0, 173 '-y' => $l_FirstDimensions [1] = 0, 174 '-width' => $l_FirstDimensions [2] = $l_Width, 175 '-height' => $l_FirstDimensions [3] = $l_Position, 176 ); 177 178 $l_LastBorder->place 179 ( 180 '-x' => $l_LastDimensions [0] = 0, 181 '-y' => $l_LastDimensions [1] = $l_Position + $l_SliderWidth, 182 '-width' => $l_LastDimensions [2] = $l_Width, 183 '-height' => $l_LastDimensions [3] = $l_Height - ($l_Position + $l_SliderWidth), 184 ); 185 186 $l_Cursor = 'sb_v_double_arrow'; 187 } 188 189 if (Exists ($l_FirstClient)) 190 { 191 $this->Advertise (FirstClient => $l_FirstClient); 192 $this->Advertise (LastClient => $l_FirstClient); 193 $l_FirstClient->packForget(); 194 195 $l_FirstClient->place 196 ( 197 '-x' => $l_FirstDimensions [0] + $l_FirstBorderWidth, 198 '-y' => $l_FirstDimensions [1] + $l_FirstBorderWidth, 199 '-width' => $l_FirstDimensions [2] - ($l_FirstBorderWidth * 2), 200 '-height' => $l_FirstDimensions [3] - ($l_FirstBorderWidth * 2), 201 ); 202 203 $l_FirstClient->GeometryRequest 204 ( 205 $l_FirstDimensions [2] - ($l_FirstBorderWidth * 2), 206 $l_FirstDimensions [3] - ($l_FirstBorderWidth * 2), 207 ); 208 } 209 210 if (Exists ($l_LastClient)) 211 { 212 $this->Advertise (LastClient => $l_LastClient); 213 214 $l_LastClient->packForget(); 215 216 $l_LastClient->place 217 ( 218 '-x' => $l_LastDimensions [0] + $l_LastBorderWidth, 219 '-y' => $l_LastDimensions [1] + $l_LastBorderWidth, 220 '-width' => $l_LastDimensions [2] - ($l_LastBorderWidth * 2), 221 '-height' => $l_LastDimensions [3] - ($l_LastBorderWidth * 2), 222 ); 223 224 $l_LastClient->GeometryRequest 225 ( 226 $l_LastDimensions [2] - ($l_LastBorderWidth * 2), 227 $l_LastDimensions [3] - ($l_LastBorderWidth * 2), 228 ); 229 } 230 231 $l_Slider->configure 232 ( 233 '-background' => $l_Foreground, 234 '-cursor' => $l_Cursor, 235 ); 236 237 $this->RedrawTrim(); 238 } 239 240sub SliderClicked 241 { 242 my ($this) = (shift, @_); 243 244 if ((my $l_Slider = $this->Subwidget ('Slider'))->IsMapped()) 245 { 246 $l_Slider->{m_Offset} = 247 ( 248 $this->cget ('-orientation') eq 'vertical' ? 249 $l_Slider->pointerx() - $l_Slider->rootx() : 250 $l_Slider->pointery() - $l_Slider->rooty() 251 ); 252 } 253 } 254 255sub SliderMoved 256 { 257 my ($this) = (shift, @_); 258 259 if ((my $l_Slider = $this->Subwidget ('Slider'))->IsMapped()) 260 { 261 my $l_BorderWidth = ($this->cget ('-borderwidth') || 1) * 2; 262 my $l_Vertical = $this->cget ('-orientation') eq 'vertical'; 263 my $l_PadBefore = $this->cget ('-padbefore'); 264 my $l_PadAfter = $this->cget ('-padafter'); 265 266 my $l_Limit = 267 ( 268 $l_Vertical ? 269 $this->width() : 270 $this->height() 271 ) - ($l_PadAfter + $l_BorderWidth); 272 273 my $l_Position = 274 ( 275 $l_Vertical ? 276 $this->pointerx() - $this->rootx() : 277 $this->pointery() - $this->rooty() 278 ); 279 280 if ($l_Position > $l_Limit) 281 { 282 $l_Position = $l_Limit; 283 } 284 elsif ($l_Position < $l_BorderWidth + $l_PadBefore) 285 { 286 $l_Position = $l_BorderWidth + $l_PadBefore; 287 } 288 289 $this->configure 290 ( 291 '-sliderposition' => $l_Position - $l_Slider->{m_Offset} 292 ); 293 294 $this->Redraw() if ($this->cget ('-opaque')); 295 } 296 } 297 298sub SliderReleased() 299 { 300 $_[0]->Redraw() if (! $_[0]->cget ('-opaque')); 301 } 302 303sub RedrawTrim 304 { 305 my $this = shift; 306 307 if (Exists (my $l_Slider = $this->Subwidget ('Slider'))) 308 { 309 my $l_Horizontal = $this->cget ('-orientation') eq 'vertical' ? 0 : 1; 310 my $l_Count = $this->cget ('-trimcount'); 311 312 for (my $l_Index = 0; $l_Index < $l_Count && $l_Count >= 0; ++$l_Index) 313 { 314 my $l_Widget; 315 316 if (! Exists ($l_Widget = $l_Slider->Subwidget ('Trim_'.$l_Index))) 317 { 318 $l_Widget = $l_Slider->Component 319 ( 320 'Frame' => 'Trim_'.$l_Index, 321 '-borderwidth' => 2, 322 '-relief' => 'raised', 323 '-width' => ($l_Horizontal ? 25 : 2), 324 '-height' => ($l_Horizontal ? 2 : 25), 325 '-background' => 'white', 326 ); 327 328 $l_Widget->bind ('<ButtonPress-1>' => sub {$this->SliderClicked();}); 329 $l_Widget->bind ('<B1-Motion>' => sub {$this->SliderMoved();}); 330 } 331 332 my $l_Where = (($l_Index - int ($l_Count / 2)) * 3) + 1; 333 334 $l_Widget->place 335 ( 336 '-relx' => 0.5, 337 '-rely' => 0.5, 338 '-x' => ($l_Horizontal ? 0 : $l_Where), 339 '-y' => ($l_Horizontal ? $l_Where : 0), 340 '-anchor' => 'center', 341 ); 342 } 343 344 $l_Slider->raise(); 345 } 346 } 347 348sub borderwidth 349 { 350 my ($this, $p_BorderWidth) = (shift, @_); 351 $this->{m_BorderWidth} = $p_BorderWidth if (defined ($p_BorderWidth)); 352 return $this->{m_BorderWidth}; 353 } 354 355sub sliderposition 356 { 357 my ($this, $p_SliderPosition) = (shift, @_); 358 359 if (defined ($p_SliderPosition)) 360 { 361 $this->{m_SliderPosition} = $p_SliderPosition; 362 $this->Redraw() if ($this->ismapped()); 363 } 364 365 return $this->{m_SliderPosition}; 366 } 367 368sub ChildNotification 369 { 370 my ($this, $p_Child) = (shift, @_); 371 my $l_Name = $p_Child->name(); 372 373 if ($l_Name ne 'lastBorder' && $l_Name ne 'firstBorder' && $l_Name ne 'slider') 374 { 375 push (@{$this->{m_ClientList}}, $p_Child); 376 $p_Child->packForget(); 377 } 378 } 379 3801; 381 382__END__ 383 384=cut 385 386=head1 NAME 387 388Tk::SplitFrame - a geometry manager for scaling two subwidgets 389 390=head1 SYNOPSIS 391 392 use Tk; 393 394 use Tk::SplitFrame; 395 396 my $MainWindow = MainWindow->new(); 397 398 my $SplitFrame = $MainWindow->SplitFrame 399 ( 400 '-orientation' => 'vertical', 401 '-trimcolor' => '#c7c7c7', 402 '-background' => 'white', 403 '-sliderposition' => 60, 404 '-borderwidth' => 2, 405 '-sliderwidth' => 7, 406 '-relief' => 'sunken', 407 '-height' => 100, 408 '-width' => 100, 409 '-padbefore' => 0, 410 '-padafter' => 0 411 ); 412 413 # Values shown above are defaults. 414 415 my $LeftLabel = $SplitFrame->Label ('-text' => 'Left'); 416 417 my $RightLabel = $SplitFrame->Label ('-text' => 'Right'); 418 419 $SplitFrame->pack (-expand => true, -fill => both); 420 421 $SplitFrame->configure ('-sliderposition' => 22); 422 423 Tk::MainLoop; 424 425=head1 DESCRIPTION 426 427A SplitFrame is a geometry manager for the two subwidgets instantiated 428against it. It has a sliding divider between them which, when moved, resizes 429them so that they each remain in contact with it. 430 431The divider can be arranged vertically or horizontally at create time. The 432children our arranged in the order that they are instantiated, from left to 433right or from top to bottom. After instantiation, the order is fixed. The children 434should NOT be packed or placed, the split frame is responsible for this. 435 436The split frame will adjust itself initially to the preferred size of the 437children. 438 439It is a basic frame itself and can be packed or placed wherever needed in other 440frames or toplevel windows. 441 442=head1 AUTHORS 443 444Damion K. Wilson, dkw@rcm.bm 445 446Based on the split windows that you see all the time in Windows, Mac, Java, etc. 447 448=head1 HISTORY 449 450October 1997: Actually started using it 451 452=cut 453