AF 24-06-2003
proc tk_getOption {w var title text initial args} {
global $var
variable ::tk::Priv
catch {unset $var}
catch {destroy $w}
set focus [focus]
set grab [grab current .]
toplevel $w -bd 1 -relief raised -class TkSDialog
wm title $w $title
wm iconname $w $title
wm protocol $w WM_DELETE_WINDOW {set ::tk::Priv(button) 0}
wm transient $w [winfo toplevel [winfo parent $w]]
set menu [eval tk_optionMenu $w.menu $var $args]
$w.menu configure -width 25
button $w.ok -bd 1 -width 5 -text Ok -default active -command {set ::tk::Priv(button) 1}
button $w.cancel -bd 1 -text Cancel -command {set ::tk::Priv(button) 0}
label $w.label -text $text
if {$text != ""} {grid $w.label -columnspan 2 -sticky ew -padx 3 -pady 3}
grid $w.menu -columnspan 2 -sticky ew -padx 3 -pady 3
grid $w.ok $w.cancel -padx 3 -pady 3
grid rowconfigure $w 2 -weight 1
grid columnconfigure $w {0 1} -uniform 1 -weight 1
bind $w <Return> {set ::tk::Priv(button) 1}
bind $w <Destroy> {set ::tk::Priv(button) 0}
bind $w <Escape> {set ::tk::Priv(button) 0}
if {$initial != ""} {set $var $initial}
wm withdraw $w
update idletasks
set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 - [winfo vrootx $w]}]
set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 - [winfo vrooty $w]}]
wm geom $w +$x+$y
wm deiconify $w
grab $w
tkwait variable ::tk::Priv(button)
bind $w <Destroy> {}
grab release $w
destroy $w
focus -force $focus
if {$grab != ""} {grab $grab}
update idletasks
return $::tk::Priv(button)
}proc tk_getOption {w var title text initial args} {
global $var
variable ::tk::Priv
catch {unset $var}
catch {destroy $w}
set focus [focus]
set grab [grab current .]
toplevel $w -class TkSDialog
wm title $w $title
wm iconname $w $title
wm protocol $w WM_DELETE_WINDOW {set ::tk::Priv(button) 0}
wm transient $w [winfo toplevel [winfo parent $w]]
puts [winfo toplevel [winfo parent $w]]
set f [ttk::frame $w.xf]
set combo [eval ttk::combobox $f.combo -textvariable $var -values [list $args] -state readonly]
$f.combo configure -width 25
ttk::button $f.ok -width 5 -text Ok -default active -command {set ::tk::Priv(button) 1}
ttk::button $f.cancel -text Cancel -command {set ::tk::Priv(button) 0}
ttk::label $f.label -text $text
if {$text != ""} {
grid $f.label -columnspan 2 -sticky ew -padx 3 -pady 3
}
grid $f.combo -columnspan 2 -sticky ew -padx 3 -pady 3
grid $f.ok $f.cancel -padx 3 -pady 3
grid rowconfigure $f 2 -weight 1
grid columnconfigure $f {0 1} -uniform 1 -weight 1
pack $f -expand 1 -fill both
bind $w <Return> {set ::tk::Priv(button) 1}
bind $w <Destroy> {set ::tk::Priv(button) 0}
bind $w <Escape> {set ::tk::Priv(button) 0}
if {$initial != ""} {set $var $initial}
wm withdraw $w
update idletasks
set parent [winfo toplevel [winfo parent $w]]
set pw [winfo reqwidth $parent]
set ph [winfo reqwidth $parent]
set width [winfo reqwidth $w]
set height [winfo reqheight $w]
if { $width < $pw && $height < $ph } {
set x [expr { [winfo x $parent] + ( $pw - $width ) / 2 }]
set y [expr { [winfo y $parent] + ( $ph - $height ) / 2 }]
} else {
set x [expr { ( [winfo vrootwidth $w] - $width ) / 2 }]
set y [expr { ( [winfo vrootheight $w] - $height ) / 2 }]
}
wm geometry $w +$x+$y
wm deiconify $w
grab $w
tkwait variable ::tk::Priv(button)
bind $w <Destroy> {}
grab release $w
destroy $w
focus -force $focus
if {$grab != ""} {grab $grab}
update idletasks
return $::tk::Priv(button)
}
tk_getOption .opt result "Option Dialog" "Please choose an option" three one two three four five six
tk_getOption .opt result "Option Dialog" {} "Choose an option" one two three four five six
tk_getOption .opt result "Option Dialog" {} {} one two three four five sixif 0 {
Usage:
tk_getOption w var title text prompt start args
w: toplevel name
var: global variable in which the result is stored
title: title of the toplevel
text: text for the prompt over the option menu, may be set to null if you do not wish for a static prompt
initial: set the initial value, this value does not have to be one of the options, and may be null
args: the values that will be selectable in the option menu }
Have you thought about adding this to tklib?
See also A not-so-little value dialog
TWu - 2025-03-04 14:20:45
I combined both source codes into one. You can switch using the variable ::tk_getOption_Style
(empty stands for Tk, anything else for ttk, if it is available)
You may test it via the three example lines above. Have a look at the picture for a preview.
proc tk_getOption {w var title text initial args} {
global $var
variable ::tk::Priv
catch {unset $var}
catch {destroy $w}
set focus [focus]
set grab [grab current .]
toplevel $w -class TkSDialog
# Only available for newer Tcl/Tk! Initialize if not yet done.
if {(![package vsatisfies $::tk_patchLevel 8.5a6-])\
||(![info exists ::tk_getOption_Style])} {
set ::tk_getOption_Style ""
}
if {[string length $::tk_getOption_Style]==0} {
$w configure -bd 1 -relief raised
} else {
# Make sure ttk will be used! (Older maybe use tile?)
set ::tk_getOption_Style "::ttk::"
}
wm title $w $title
wm iconname $w $title
wm protocol $w WM_DELETE_WINDOW {set ::tk::Priv(button) 0}
set parent [winfo toplevel [winfo parent $w]]
# puts $parent
wm transient $w $parent
set f [${::tk_getOption_Style}frame $w.xf]
${::tk_getOption_Style}button $f.ok -width 5 -text Ok -default active -command {set ::tk::Priv(button) 1}
${::tk_getOption_Style}button $f.cancel -text Cancel -command {set ::tk::Priv(button) 0}
if {[string length $::tk_getOption_Style]==0} {
set combo [eval tk_optionMenu $f.combo $var $args]
$f.ok configure -bd 1
$f.cancel configure -bd 1
} else {
set combo [eval ${::tk_getOption_Style}combobox $f.combo -textvariable $var -values [list $args] -state readonly]
}
$f.combo configure -width 25
if {[string length $text]>0} {
${::tk_getOption_Style}label $f.label -text $text
grid $f.label -padx 3 -pady 3 -columnspan 2 -sticky ew
}
grid $f.combo -padx 3 -pady 3 -columnspan 2 -sticky ew
grid $f.ok $f.cancel -padx 3 -pady 3
grid rowconfigure $f 2 -weight 1
grid columnconfigure $f {0 1} -weight 1 -uniform 1
pack $f -expand 1 -fill both
bind $w <Return> {set ::tk::Priv(button) 1}
bind $w <Destroy> {set ::tk::Priv(button) 0}
bind $w <Escape> {set ::tk::Priv(button) 0}
if {[string length $initial]>0} {
set $var $initial
}
wm withdraw $w
update idletasks
# Don't know where is the real difference?
if {[string length $::tk_getOption_Style]==0} {
set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 - [winfo vrootx $w]}]
set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 - [winfo vrooty $w]}]
} else {
set pw [winfo reqwidth $parent]
set ph [winfo reqheight $parent]
set width [winfo reqwidth $w]
set height [winfo reqheight $w]
if {$width<$pw&&$height<$ph} {
set x [expr {[winfo x $parent]+($pw-$width)>>1}]
set y [expr {[winfo y $parent]+($ph-$height)>>1}]
} else {
set x [expr {([winfo vrootwidth $w]-$width)>>1}]
set y [expr {([winfo vrootheight $w]-$height)>>1}]
}
}
wm geometry $w +$x+$y
wm deiconify $w
grab $w
tkwait variable ::tk::Priv(button)
bind $w <Destroy> {}
grab release $w
destroy $w
focus -force $focus
if {$grab!=""} {
grab $grab
}
update idletasks
return $::tk::Priv(button)
}