環境及版本說明:

OSX10.9?

tclsh -> tclsh8.5

wish -> wish8.5

查看本機運行環境:

1 which wish; 2 /usr/bin/wish 1 which tclsh; 2 /usr/bin/tclsh

Demo功能說明:

用戶登錄窗口,輸入用戶名,密碼.與文件中存儲內容校驗,如果相等,則提示"登錄成功",否則提示"是否需要新建用戶",點擊"否"退出messageBox,點擊"是"新建用戶.內容追加寫入文件.

1 #!/usr/bin/wish -f 2 # 3 # this is test login, Tk-style 4 5 set filename "usrfile.pwd"; 6 7 proc splitf { str index } { 8 set y [ split $str | ]; 9 list $y; 10 set w [ lindex $y $index ]; 11 return $w; 12 } 13 14 proc checkinfo {name pwd} { 15 global filename; 16 set iflag 0; 17 set isUser 0; 18 19 if { $name eq "" || $pwd eq "" } { 20 return 005; 21 } 22 23 set fileId [ open $filename r ]; 24 while { [ gets $fileId line ] >= 0 } { 25 set nameInfile [ splitf $line 0 ]; 26 set cmp [ string compare $name $nameInfile ]; 27 28 if { $cmp != 0 } { 29 set isUser [ expr $isUser + 1 ]; 30 } elseif { $cmp == 0 } { 31 set pwdInfile [ splitf $line 1 ]; 32 set cmp [ string compare $pwd $pwdInfile ]; 33 if { $cmp == 0 } { 34 close $fileId; 35 return 001; #login successful 36 } else { 37 close $fileId; 38 return 004; #err user pwd 39 } 40 } 41 set iflag [ expr $iflag + 1 ]; 42 } 43 close $fileId; 44 45 if { $iflag == 0 } { 46 return 002; #file is null,creat user; 47 } 48 if { $iflag == $isUser } { 49 return 002; #creat user 50 } 51 } 52 53 proc process { uname pwd } { 54 global filename; 55 set returnCheck [ checkinfo $uname $pwd ]; 56 switch -- $returnCheck { 57 001 { tk_messageBox -type ok -message "you are login successful" } 58 002 { set answer [ tk_messageBox -type yesno -icon question \ 59 -message "you need creat a user" ] ; 60 switch -- $answer { 61 no { } 62 yes { puts stdout [ createusr $uname $pwd ] } 63 } 64 } 65 //003 { tk_messageBox -type ok -icon warning -message "$filename file is null" } 66 004 { tk_messageBox -type ok -icon error -message "input err of user pwd" } 67 005 { tk_messageBox -type ok -icon info -message "user and pwd is not null" } 68 default { tk_messageBox -type ok -icon error -message "system err" } 69 } 70 } 71 72 proc createusr { uname pwd } { 73 global filename; 74 set fileId [ open $filename a ]; 75 puts $fileId "$uname|$pwd" ; 76 close $fileId; 77 return 1; 78 } 79 wm title . LOGIN 80 wm maxsize . 500 300 81 wm minsize . 500 300 82 wm resizable . 500 300 83 wm geometry . 500x300+300+200 84 85 label .ulname -text "userName" 86 87 entry .tuname -textvariable name 88 89 label .ulpwd -text "userPwd" 90 91 entry .tupwd -textvariable pwd 92 93 button .bOK -text OK \ 94 -command { puts stdout [ process $name $pwd] } 95 96 button .bExit -text Exit \ 97 -command {exit} 98 99 100 place .ulname -x 110 -y 50 101 place .tuname -x 200 -y 50 102 place .ulpwd -x 110 -y 100 103 place .tupwd -x 200 -y 100 104 105 place .bOK -x 150 -y 150 106 place .bExit -x 280 -y 150 1 wish tk.tcl

配置文件格式:

1 cat usrfile.pwd
2 userTmp|abc123

此Demo涉及控件,語法.足夠日常使用.望對新學者有點幫助.

特別需要注意:

1- 所有的關鍵字與{ 等之間一定要有空格,否則無法解析.

錯誤: proc sum{arg1 arg2}{ 正確: proc sum { arg1 arg2 } {

2- proc if switch等需要用{}包含的body 左括號一定要寫到 if {} { 與關鍵字同行

1 proc sum { arg1 arg2 } 2 3 { 4 5 　　.... 6 7 }

以上代碼將提示:

Error in startup script: wrong # args: should be "proc name args body"

?while executing

"proc sum {arg1 arg2} "

? ? (file "a.tcl" line 3)

需要修改為:

1 proc sum { arg1 arg2 } { 2 3 　　.... 4 5 }

?

?

學習網站:

http://www.tcl.tk/man/tcl8.5/TclCmd/contents.htm

http://www2.tcl.tk/1062

http://blog.csdn.net/dulixin/article/category/366323

?

read-only access to git repository:

git clone https://github.com/galoishelley/tcltk

?

轉載于:https://www.cnblogs.com/galoishelley/p/3411973.html

總結

以上是生活随笔為你收集整理的tcl/tk demo的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。