tcl/tk demo

环境及版本说明:

OSX10.9 

tclsh -> tclsh8.5

wish -> wish8.5

查看本机运行环境:

which wish;
2 /usr/bin/wish

which tclsh;
/usr/bin/tclsh

Demo功能说明:

用户登录窗口,输入用户名,密码.与文件中存储内容校验,如果相等,则提示"登录成功",否则提示"是否需要新建用户",点击"否"退出messageBox,点击"是"新建用户.内容追加写入文件.

#!/usr/bin/wish -f
#
# this is test login, Tk-style

set filename "usrfile.pwd";

proc splitf { str index } {
    set y [ split $str | ];
    list  $y;
    set w [ lindex $y $index ];
    return $w;
}

proc checkinfo {name pwd} {
    global filename;
    set iflag 0;
    set isUser 0;
    
    if { $name eq "" || $pwd eq "" } {
        return 005;
    }

    set fileId [ open $filename r ];   
    while { [ gets $fileId line ] >= 0 } {
        set nameInfile [ splitf $line 0 ];
        set cmp [ string compare $name $nameInfile ];

        if { $cmp != 0 } {
            set isUser [ expr $isUser + 1 ];
        } elseif { $cmp == 0 } {
            set pwdInfile [ splitf $line 1 ];
            set cmp [ string compare $pwd $pwdInfile ];
            if { $cmp == 0 } {
                close $fileId; 
                return 001; #login successful 
            } else {
                close $fileId;
                return 004; #err user pwd
            } 
        }
        set iflag [ expr $iflag + 1 ];
    }
    close $fileId;

    if { $iflag == 0 } {
        return 002; #file is null,creat user;
    }
    if { $iflag == $isUser } {
        return 002; #creat user
    }
}

proc process { uname pwd } {
    global filename;
    set returnCheck [ checkinfo $uname $pwd ];
    switch -- $returnCheck {
        001 { tk_messageBox -type ok -message "you are login successful" }
        002 { set answer [ tk_messageBox -type yesno -icon question \
                 -message "you need creat a user" ] ;
                switch -- $answer {
                    no { }
                    yes { puts stdout [ createusr $uname $pwd ] }
                }
            }
        //003 { tk_messageBox -type ok -icon warning -message "$filename file is null" }  
        004 { tk_messageBox -type ok -icon error -message "input err of user pwd" }
        005 { tk_messageBox -type ok -icon info -message "user and pwd is not null" }
        default { tk_messageBox -type ok -icon error -message "system err" }
    }
}

proc createusr { uname pwd } {
    global filename;
    set fileId [ open $filename a ];
    puts $fileId "$uname|$pwd" ;
    close $fileId;
    return 1; 
}
wm title . LOGIN
wm maxsize . 500 300
wm minsize . 500 300
wm resizable . 500 300
wm geometry . 500x300+300+200

label .ulname -text "userName"

entry .tuname -textvariable name 

label .ulpwd -text "userPwd"

entry .tupwd -textvariable pwd
 
button .bOK -text OK \
  -command { puts stdout [ process $name $pwd] }

button .bExit -text Exit \
  -command {exit}
 

place .ulname -x 110 -y 50 
place .tuname -x 200 -y 50 
place .ulpwd -x 110 -y 100 
place .tupwd -x 200 -y 100 

place .bOK -x 150 -y 150  
place .bExit -x 280 -y 150

wish tk.tcl

配置文件格式:

cat usrfile.pwd
2 userTmp|abc123

此Demo涉及控件,语法.足够日常使用.望对新学者有点帮助.

特别需要注意:

1- 所有的关键字与{ 等之间一定要有空格,否则无法解析.

错误: proc sum{arg1 arg2}{

正确: proc sum { arg1 arg2 } {

2- proc if switch等需要用{}包含的body 左括号一定要写到 if {} { 与关键字同行

proc sum { arg1 arg2 }

{

　　....

}

以上代码将提示:

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

 while executing

"proc sum {arg1 arg2} "

    (file "a.tcl" line 3)

需要修改为:

proc sum { arg1 arg2 } {

　　....

}

 

 

学习网站:

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