* Purpose: Demonstrate an animated vertical tab scheme
This provides a vertical column of buttons on the lefthand side of the screen. Click a button and a frame and associated widgets slides out. Click it again and the frame slides back in. Click an alternate button and the currently displayed frame slides back and the new frame slides out.
I wrote this in one sitting and have not actually used it in any app yet, so if you see any problems with the concept or have other ideas of how to implement this, please feel free to add to the page. I don't know if I am reinventing a wheel here but didn't find a similar page.
#!/bin/bash
# the next line restarts using wish \
exec /usr/bin/wish "$0" "$@"
#
# by Mike Tuxford
#################################
# GLOBALS
#
array set opt {
"gui,x" 640 "gui,y" 480
}
array set vt {
"0,bg" "#deb887" "1,bg" "#000000" "2,bg" "#ff0000"
"3,bg" "#00ff00" "4,bg" "#0000ff" "5,bg" "#ffffff"
"current" -1
}
### Begin Bitmaps ###
array set bmp {
"dot" "#define dot11_width 11 #define dot11_height 11
static unsigned char dot11_bits[] = {
0x00, 0x00, 0xf8, 0x00, 0xfc, 0x01, 0xfe, 0x03, 0xfe, 0x03, 0xfe, 0x03,
0xfe, 0x03, 0xfe, 0x03, 0xfc, 0x01, 0xf8, 0x00, 0x00, 0x00};"
}
### end Bitmaps ###
image create bitmap dot -data $bmp(dot)
#################################
# PROCEDURES
#
proc buildTab {n} {
global colors opt vt
button .g.v.vt$n \
-activebackground #c6e2ff -bg #eaeaea -fg #000000 -image dot \
-bd 3 -relief raised -command "animate $n"
pack .g.v.vt$n -in .g.v -side top -fill y -expand 1
frame .g.f$n -bd 1
label .g.f$n.top -relief solid -bd 1 -bg #eaeaea -image dot \
-height 13 -width [expr $opt(gui,x) - 22]
pack .g.f$n.top -side top -expand 1
canvas .g.f$n.c -bd 1 -relief solid -bg $vt($n,bg) \
-width [expr $opt(gui,x) - 22] -height [expr $opt(gui,y) - 31]
pack .g.f$n.c -side top -expand 1
return
}
proc animate {n} {
global opt vt
if {$vt(current) >= 0} {
for {set i 0} {$i >= [expr 20 - $opt(gui,x)]} {incr i -10} {
place .g.f$vt(current) -in .g -x $i -y 0
update
after 10
}
}
if {$vt(current) == $n} {
set vt(current) -1
} else {
for {set i [expr 20 - $opt(gui,x)]} {$i <= 20} {incr i 10} {
place .g.f$n -in .g -x $i -y 0
update
after 10
}
set vt(current) $n
}
return
}
proc GUI {} {
global opt
set w .g
toplevel $w
wm focusmodel $w passive
wm geometry $w $opt(gui,x)x$opt(gui,y)
wm minsize $w $opt(gui,x) $opt(gui,y)
wm maxsize $w $opt(gui,x) $opt(gui,y)
wm deiconify $w
wm title $w "Vertical Tabs Test"
wm withdraw .
########################
# MAIN MENU
#
menu $w.main -tearoff 0
$w.main configure -font {Helvetica 10}
set ma $w.main.net
menu $ma -tearoff 0
$ma configure -font {Helvetica 10}
$w.main add cascade -label "File" -menu $ma -underline 0
$ma add command -label "Exit" -command {destroy . .g}
set mz $w.main.help
menu $mz -tearoff 0
$mz configure -font {Helvetica 10}
$w.main add cascade -label "Help" -menu $mz -underline 0
$mz add command -label "About"
$mz add command -label "Item 2"
#
$w configure -cursor draft_small
$w configure -menu $w.main
# END MAIN MENU
####################
####################
# WIDGETS
#
frame $w.v -height $opt(gui,y)
for {set i 0} {$i < 6} {incr i} {
buildTab $i
}
place $w.v -in $w -relheight 1.0 -x 0 -y 0
# END GUI
####################
}
GUI
# key bindings
bind .g <Control-c> {destroy .}
FW: This doesn't work on my XP box, the text in the labels just mushes together into a circle-looking black blog.
MNO: That's a bitmap of a dot (i.e. intentional) - see the "image create" and "-image dot" sections of the code.