From Tcl 8.4a1, this will be possible inside Tk core
Richard Suchenwirth -- By popular demand, here's a quick hack for a button-like widget "xbutton" that holds both an image and/or a text. It is called like this:
xbutton .foo -text xx ?-font xx? ?-bitmap xx? ?-image xx? \ ?-side xx? ?-background xx? ?-activebackground xx? -command xx \ ?-expand xx? ?-relief xx*? ?-borderwidth xx*?
Most switches are as with the button widget. -side (left/right/top/bottom) specifies where the image goes. -expand 0 turns off centering. -relief flat emulates the recent Windows fashion that buttons get raised only when the pointer is over them. *: Newly added in version 1.1. Tested on 8.0.5/Solaris, 8.1a1/W95, 8.2.2/NT. No warranty, but enjoy:
proc xbutton {w args} {
button $w ;# only for getting defaults
foreach i {-background -activebackground -font} {
set a($i) [$w cget $i]
}
destroy $w
array set a [concat {
-side top -relief raised -borderwidth 2 -command {} -expand 1
} $args]
frame $w -relief $a(-relief) -borderwidth $a(-borderwidth)
if [info exists a(-image)] {
label $w.b -image $a(-image) -bg $a(-background)
} elseif [info exists a(-bitmap)] {
label $w.b -bitmap $a(-bitmap) -bg $a(-background)
}
if [info exists a(-text)] {
label $w.t -text $a(-text) -font $a(-font) -bg $a(-background)
}
eval pack [winfo children $w] -side $a(-side) -fill both \
-expand $a(-expand)
xbind $w <Enter> "xconfigure %W -bg $a(-activebackground);
$w configure -relief raised; update"
xbind $w <Leave> "xconfigure %W -bg $a(-background);
$w configure -relief $a(-relief); update"
xbind $w <ButtonPress-1> \
"$w configure -relief sunken; update; eval [list $a(-command)]"
xbind $w <ButtonRelease-1> "$w configure -relief raised"
}
proc xbind {w event body} {
if ![llength [winfo children $w]] {set w [winfo parent $w]}
foreach i [concat $w [winfo children $w]] {
bind $i $event $body
}
} ;# binds to children and parent
proc xconfigure {w args} {
if ![llength [winfo children $w]] {set w [winfo parent $w]}
foreach i [concat $w [winfo children $w]] {
eval $i configure $args
}
}To do: xbuttons cannot yet be reconfigured, nor dis/reactivated. Feel free to contribute (click Edit.. below ;-)
DKF: No time to contribute properly, but is there a good reason for not building the 'button' in a [canvas] widget instead? That would give you a lot more flexibility...
RS: Indeed, but as I was only implementing some advice given by others to a semi-FAQ, I preferred the simplicity of the packer. On a canvas it would also be easier to shift the button contents slightly southeast when pushed and back northwest when released, as real buttons do. Maybe later when I have some idle time again ..;-)
DKF: ''A different version that covers other tricks you might wish to look at. Only known to work right on Unix/X versions of Tk...
# Make and pack the widgets.
pack [frame .f -relief raised -bd 1 -highlightthick 1 -takefocus 1 -class MyButton]
pack [button .f.i -relief raised -bd 0 -highlightthick 0 -takefocus 0 -bitmap questhead]
pack [button .f.t -relief raised -bd 0 -highlightthick 0 -takefocus 0 -text Question]
# We are *not* conventional widgets
bindtags .f {.f MyButton . all}
bindtags .f.t {.f MyButton . all}
bindtags .f.i {.f MyButton . all}
# Some utility procedures
proc doEnter {} {
.f conf -bg [.f.t cget -activeback]
# Change colour when we enter
.f.t conf -state active
.f.i conf -state active
}
proc doLeave {} {
.f conf -bg [.f.t cget -bg]
# Change colour when we leave
.f.t conf -state normal
.f.i conf -state normal
}
proc b1 {} {
.f conf -relief sunken
# Text and picture move when clicked!
.f.t conf -relief sunken
.f.i conf -relief sunken
}
proc b1r {} {
.f conf -relief raised
# Text and picture move when clicked!
.f.t conf -relief raised
.f.i conf -relief raised
}
# Set up some basic bindings. Note that these are nowhere near as
# sophisticated as those used in the Tk library. But they'll do for now...
bind MyButton <1> b1
bind MyButton <ButtonRelease-1> b1r
bind MyButton <Enter> {if {[winfo class %W] == "MyButton"} doEnter}
bind MyButton <Leave> {if {[winfo class %W] == "MyButton"} doLeave}It should be relatively easy to add disabling (change what the bindings do, and make the bitmap and label sub-buttons disabled too for the visual effect) but getting the behaviour right when you press a button over a sub-widget and then leave the widget as a whole is tricky...