Search for a command to run...
How to create a custom dialogue window using Tcl/Tk
I have over 40 years of programming experience using a variety of languages over the course of my career to develop real-time solutions for real-world problems.
Keyboards connect us to the world and, as a keyboard enthusiast, I am searching for the ideal keyboard.
No comments yet. Be the first to comment.
Looking at an article for the book “Gist of Go: Concurrency,” I also stumbled across a reference to “High-precision date/time in SQLite” written by the same author, Anton Zhiyanov. I use SQLite in man
Happy 10th Anniversary - RUST!
Login failed. It appears you are offline
Modern Fortran: Tricks of the Software Engineering Trade by Damian Rouson Sometimes I think I'm one of the few programmers routinely using Fortran long after my Engineering studies too many years ago. As such, I'm pleasantly surprised when a new book...
Make GIT a Habit
The following code demonstrates how to create a simple custom dialogue window using Tcl/Tk. This is an embellishment to the code presented in Practical Programming in Tcl and Tk - 4th Edition, chapter 39, pages 602-609.
Book Errata for 4th Edition: http://beedub.com/book/4th/Errata1.html Note: For performance reasons, preference is given to map and unmap windows instead of destroying them. Reference chapter 44, page 661 that captures the tricks used here.
This module can run independently
package require Tk
proc Dialog_Create {top title width height xScreenPos yScreenPos args} {
global dialog
set winexist [winfo exists $top]
if [ winfo exists $top ] {
switch -- [wm state $top] {
normal -
zoomed {
raise $top
}
withdrawn -
iconic {
wm deiconify $top
catch {wm geometry $top $::dialog(geo,$top)}
}
}
return 0
} else {
eval {toplevel $top} $args
wm title $top $title
puts "Dialog_Create Window Geometry: [wm geometry $top]"
wm resizable $top 1 0
return 1
}
}
proc Dialog_Wait {top varName { focus {} }} {
upvar $varName var
bind $top <Destroy> [list set $varName 0]
if { [ string length $focus ] == 0 } {
set focus $top
}
set old [focus -displayof $top]
focus $focus
catch {tkwait visibility $top}
catch {grab $top}
tkwait variable $varName
catch {grab release $top}
focus $old
}
proc Dialog_Dismiss {top} {
global dialog
catch {
set ::dialog(geo,$top) [list [wm geometry $top]]
wm withdraw $top
}
}
proc verifyEntry {} {
global signIn
puts "Entered validateEntry procedure"
puts "String $::signIn(username)\nLength: [string length $::signIn(username)]"
puts "String $::signIn(password)\nLength: [string length $::signIn(password)]"
if { [string length $::signIn(username)] > 0 && [string length $::signIn(password)] > 0} {
puts "Entry validated"
set ::signIn(ok) 1
} else {
puts "Entry error: Zero length entries.\nSignIn(ok) = $::signIn(ok)"
}
}
proc validateEntry {} {
puts "Entered proc validateEntry "
puts "Exiting proc validateEntry "
}
proc Dialog_Manager { username password width height xpos ypos } {
global signIn
set f .prompt
if { [Dialog_Create $f "Sign In" $width $height $xpos $ypos -borderwidth 10 ] } {
labelframe $f.userframe -text $username
label $f.userframe.msguser -text $username
entry $f.userframe.username -textvariable ::signIn(username); #-validate validateEntry
pack $f.userframe.username -side top -padx 4 -expand yes -fill x
pack $f.userframe.msguser -side left -padx 4 -anchor w
labelframe $f.passframe -text $password
label $f.passframe.msgpass -text $password
entry $f.passframe.password -show "*" -textvariable ::signIn(password); #-validate validateEntry
pack $f.passframe.password -side top -padx 4 -expand yes -fill x
pack $f.passframe.msgpass -side top -anchor w
set b [frame $f.buttons]
button $b.signin -text "Sign In" -command { verifyEntry }
button $b.cancel -text Cancel -command {set ::signIn(ok) 0}
pack $b.signin -side left -ipadx 5 -padx 20 -pady 5
pack $b.cancel -side right -ipadx 5 -padx 20 -pady 5
pack $f.buttons -side bottom -expand yes -padx 5 -pady 5
pack $f.userframe $f.passframe -side top -expand no -fill x -anchor n -padx 5 -pady 5
update idletasks
puts "Dialog_Manager AFTER packing."
puts "Dialog_Manager is $f Mapped? (0=No, 1=Yes): [winfo ismapped ${f}]"
puts "Dialog Manager - winfo reqwidth: [winfo reqwidth $f]"
puts "Dialog_Manager - winfo reqheight: [winfo reqheight $f]"
wm minsize $f $width [winfo reqheight $f]
bind $f.userframe.username <Return> { verifyEntry }
bind $f.userframe.username <Control-c> {set ::signIn(ok) 0 ; break }
bind $f.passframe.password <Return> { verifyEntryEntry }
bind $f.passframe.password <Control-c> {set ::signIn(ok) 0 ; break }
}
set ::signIn(ok) 0
set ::signIn(username) ""
set ::signIn(password) ""
set ::signIn(result) ""
bell -displayof .prompt -nice
Dialog_Wait $f ::signIn(ok) $f.userframe.username
Dialog_Dismiss $f
if { $::signIn(ok) } {
return [list $::signIn(username) $::signIn(password)]
} else {
return {}
}
}
proc signIn {} {
Dialog_Manager "Username" "Password" "300" "250" "50" "50"
puts "UserName = $::signIn(username)"
puts "PassWord = $::signIn(password)"
}
label .lblWelcome -text "Welcome to TclTk.ca\n\nSimple Custom Dialogue Demonstration"
frame .btnFrame
button .btnFrame.btnSignIn -text "Launch" -command { signIn }
button .btnFrame.btnExit -text "Exit/Cancel" -command exit
pack .btnFrame.btnSignIn -side left -ipadx 5 -padx 20
pack .btnFrame.btnExit -side right -ipadx 5 -padx 20
pack .btnFrame -side bottom -expand no -pady 10
pack .lblWelcome -side top -pady 10 -expand yes -fill x
wm geometry . 400x155+100+100
wm title . "Tcl/Tk Custom Dialogue"
This code will be refined in future posts to add real verification