From Tcl 8.4a1 on, this is possible in Tk, using button and image
Could someone show an example of how to do this in Tk 8.4?
image create photo .cow -format GIF -file cowmoo.gif button .b -image .cow
is a plain button with image.
button .b -text Moo
is a plain button with text.
To get both, you need to use the -compound option to tell it which side to put the icon (one of bottom, center, left, none, right, or top). With the value 'none', acts like version 8.3 (i.e. priority is given to -image over -text). For instance:
button .b -image .cow -text Moo -compound top
results in a button with the image icon on top, and the text looking like a caption centered underneath the image.
For versions of Tk before Tk 8.4alpha:
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...
See http://www.changhai.org/articles/technology/programming/tcltricks.php for an example of putting images on various control elements, from buttons, to labels, etc.
JPT: Here's another simple variant. Button's bindings are copied to the label, but are redirected to the button, so that mouse clicks on the label could also work. Note that the width and height must be given, for the button doesn't size itself automatically.
proc xBtn {w {args {}} } {
catch {destroy $w}
catch {destroy ${w}_lbl}
eval button $w $args
pack propagate $w 0
pack [label ${w}_lbl -text [$w cget -text] ] -side bottom -in $w
foreach item [bind Button] {
bind ${w}_lbl $item [string map "%W $w" [bind Button $item]]
}
return $w
}
pack [xBtn .myB -image image1 -text "Test button" -height 40 -width 80]PWQ 7 July 05, You could use bindtags instead of the above to add the Button bindings to the widget.