home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2000 December
/
PCWorld_2000-12_cd.bin
/
Komunikace
/
Comanche
/
BWidget-1.2
/
scrollw.tcl
< prev
next >
Wrap
Text File
|
2000-11-02
|
9KB
|
255 lines
# ------------------------------------------------------------------------------
# scrollw.tcl
# This file is part of Unifix BWidget Toolkit
# $Id: scrollw.tcl,v 1.1.1.1 1996/02/22 06:05:56 daniel Exp $
# ------------------------------------------------------------------------------
# Index of commands:
# - ScrolledWindow::create
# - ScrolledWindow::getframe
# - ScrolledWindow::setwidget
# - ScrolledWindow::configure
# - ScrolledWindow::cget
# - ScrolledWindow::_set_hscroll
# - ScrolledWindow::_set_vscroll
# - ScrolledWindow::_realize
# ------------------------------------------------------------------------------
namespace eval ScrolledWindow {
Widget::declare ScrolledWindow {
{-background TkResource "" 0 button}
{-scrollbar Enum both 1 {none both vertical horizontal}}
{-auto Enum both 0 {none both vertical horizontal}}
{-relief TkResource flat 0 frame}
{-borderwidth TkResource 0 0 frame}
{-bg Synonym -background}
{-bd Synonym -borderwidth}
}
Widget::addmap ScrolledWindow "" ._grid.f {-relief {} -borderwidth {}}
proc ::ScrolledWindow { path args } { return [eval ScrolledWindow::create $path $args] }
proc use {} {}
variable _widget
}
# ------------------------------------------------------------------------------
# Command ScrolledWindow::create
# ------------------------------------------------------------------------------
proc ScrolledWindow::create { path args } {
variable _widget
Widget::init ScrolledWindow $path $args
set bg [Widget::cget $path -background]
set sw [frame $path -relief flat -bd 0 -bg $bg -highlightthickness 0 -takefocus 0]
set grid [frame $path._grid -relief flat -bd 0 -bg $bg -highlightthickness 0 -takefocus 0]
set sb [lsearch {none horizontal vertical both} [Widget::cget $path -scrollbar]]
set auto [lsearch {none horizontal vertical both} [Widget::cget $path -auto]]
set rspan [expr {1 + !($sb & 1)}]
set cspan [expr {1 + !($sb & 2)}]
set _widget($path,realized) 0
set _widget($path,sb) $sb
set _widget($path,auto) $auto
set _widget($path,hpack) [expr {$rspan == 1}]
set _widget($path,vpack) [expr {$cspan == 1}]
# scrollbar horizontale ou les deux
if { $sb & 1 } {
scrollbar $grid.hscroll \
-highlightthickness 0 -takefocus 0 \
-orient horiz \
-relief sunken \
-bg $bg
$grid.hscroll set 0 1
grid $grid.hscroll -column 0 -row 1 -sticky we -columnspan $cspan -pady 1
}
# scrollbar verticale ou les deux
if { $sb & 2 } {
scrollbar $grid.vscroll \
-highlightthickness 0 -takefocus 0 \
-orient vert \
-relief sunken \
-bg $bg
$grid.vscroll set 0 1
grid $grid.vscroll -column 1 -row 0 -sticky ns -rowspan $rspan -padx 1
}
eval frame $grid.f -bg $bg -highlightthickness 0 [Widget::subcget $path ._grid.f]
grid $grid.f -column 0 -row 0 -sticky nwse -columnspan $cspan -rowspan $rspan
grid columnconfigure $grid 0 -weight 1
grid rowconfigure $grid 0 -weight 1
pack $grid -fill both -expand yes
bind $grid <Configure> "ScrolledWindow::_realize $path"
bind $grid <Destroy> "ScrolledWindow::_destroy $path"
rename $path ::$path:cmd
proc ::$path { cmd args } "return \[eval ScrolledWindow::\$cmd $path \$args\]"
return $path
}
# ------------------------------------------------------------------------------
# Command ScrolledWindow::getframe
# ------------------------------------------------------------------------------
proc ScrolledWindow::getframe { path } {
return $path
}
# ------------------------------------------------------------------------------
# Command ScrolledWindow::setwidget
# ------------------------------------------------------------------------------
proc ScrolledWindow::setwidget { path widget } {
variable _widget
set grid $path._grid
set sb $_widget($path,sb)
set option {}
pack $widget -in $grid.f -fill both -expand yes
# scrollbar horizontale ou les deux
if { $sb & 1 } {
$grid.hscroll configure -command "$widget xview"
lappend option "-xscrollcommand" "ScrolledWindow::_set_hscroll $path"
}
# scrollbar verticale ou les deux
if { $sb & 2 } {
$grid.vscroll configure -command "$widget yview"
lappend option "-yscrollcommand" "ScrolledWindow::_set_vscroll $path"
}
if { [llength $option] } {
eval $widget configure $option
}
}
# ------------------------------------------------------------------------------
# Command ScrolledWindow::configure
# ------------------------------------------------------------------------------
proc ScrolledWindow::configure { path args } {
variable _widget
set grid $path._grid
set res [Widget::configure $path $args]
if { [Widget::hasChanged $path -background bg] } {
$path configure -background $bg
$grid configure -background $bg
$grid.f configure -background $bg
catch {$grid.hscroll configure -background $bg}
catch {$grid.vscroll configure -background $bg}
}
if { [Widget::hasChanged $path -auto auto] } {
set _widget($path,auto) [lsearch {none horizontal vertical both} $auto]
if { $_widget($path,sb) & 1 } {
eval _set_hscroll $path [$grid.hscroll get]
}
if { $_widget($path,sb) & 2 } {
eval _set_vscroll $path [$grid.vscroll get]
}
}
return $res
}
# ------------------------------------------------------------------------------
# Command ScrolledWindow::cget
# ------------------------------------------------------------------------------
proc ScrolledWindow::cget { path option } {
return [Widget::cget $path $option]
}
# ------------------------------------------------------------------------------
# Command ScrolledWindow::_destroy
# ------------------------------------------------------------------------------
proc ScrolledWindow::_destroy { path } {
variable _widget
unset _widget($path,sb)
unset _widget($path,auto)
unset _widget($path,hpack)
unset _widget($path,vpack)
Widget::destroy $path
rename $path {}
}
# ------------------------------------------------------------------------------
# Command ScrolledWindow::_set_hscroll
# ------------------------------------------------------------------------------
proc ScrolledWindow::_set_hscroll { path vmin vmax } {
variable _widget
if { $_widget($path,realized) } {
set grid $path._grid
if { $_widget($path,auto) & 1 } {
if { $_widget($path,hpack) && $vmin == 0 && $vmax == 1 } {
grid configure $grid.f -rowspan 2
if { $_widget($path,sb) & 2 } {
grid configure $grid.vscroll -rowspan 2
}
set _widget($path,hpack) 0
} elseif { !$_widget($path,hpack) && ($vmin != 0 || $vmax != 1) } {
grid configure $grid.f -rowspan 1
if { $_widget($path,sb) & 2 } {
grid configure $grid.vscroll -rowspan 1
}
set _widget($path,hpack) 1
}
}
$grid.hscroll set $vmin $vmax
}
}
# ------------------------------------------------------------------------------
# Command ScrolledWindow::_set_vscroll
# ------------------------------------------------------------------------------
proc ScrolledWindow::_set_vscroll { path vmin vmax } {
variable _widget
if { $_widget($path,realized) } {
set grid $path._grid
if { $_widget($path,auto) & 2 } {
if { $_widget($path,vpack) && $vmin == 0 && $vmax == 1 } {
grid configure $grid.f -columnspan 2
if { $_widget($path,sb) & 1 } {
grid configure $grid.hscroll -columnspan 2
}
set _widget($path,vpack) 0
} elseif { !$_widget($path,vpack) && ($vmin != 0 || $vmax != 1) } {
grid configure $grid.f -columnspan 1
if { $_widget($path,sb) & 1 } {
grid configure $grid.hscroll -columnspan 1
}
set _widget($path,vpack) 1
}
}
$grid.vscroll set $vmin $vmax
}
}
# ------------------------------------------------------------------------------
# Command ScrolledWindow::_realize
# ------------------------------------------------------------------------------
proc ScrolledWindow::_realize { path } {
variable _widget
set grid $path._grid
bind $grid <Configure> {}
set _widget($path,realized) 1
place $grid -anchor nw -x 0 -y 0 -relwidth 1.0 -relheight 1.0
}