modal.tcl

来自「一个跨平台的TCL/TK可视开发环境类似VC. TCL/TK是一个跨平台的脚本」· TCL 代码 · 共 486 行 · 第 1/2 页

        set set,size 0
        set runvisible 1
    }
    namespace eval ::widgets::$base.lab80 {
        array set save {-background 1 -justify 1 -text 1}
    }
    namespace eval ::widgets::$base.lab81 {
        array set save {-anchor 1 -background 1 -text 1}
    }
    namespace eval ::widgets::$base.lab83 {
        array set save {-anchor 1 -text 1}
    }
    namespace eval ::widgets::$base.lab82 {
        array set save {-anchor 1 -background 1 -text 1}
    }
    namespace eval ::widgets::$base.but84 {
        array set save {-command 1 -pady 1 -text 1}
    }
    set base .top81
    namespace eval ::widgets::$base {
        set set,origin 1
        set set,size 0
        set runvisible 0
    }
    namespace eval ::widgets::$base.lab82 {
        array set save {-background 1 -justify 1 -text 1}
    }
    namespace eval ::widgets::$base.but83 {
        array set save {-command 1 -pady 1 -text 1}
    }
    namespace eval ::widgets_bindings {
        set tagslist _TopLevel
    }
    namespace eval ::vTcl::modules::main {
        set procs {
            init
            main
        }
        set compounds {
        }
    }
}
}

#################################
# USER DEFINED PROCEDURES
#
#############################################################################
## Procedure:  main

proc ::main {argc argv} {}

#############################################################################
## Initialization Procedure:  init

proc ::init {argc argv} {}

init $argc $argv

#################################
# VTCL GENERATED GUI PROCEDURES
#

proc vTclWindow. {base} {
    if {$base == ""} {
        set base .
    }
    ###################
    # CREATING WIDGETS
    ###################
    wm focusmodel $top passive
    wm geometry $top 200x200+132+150; update
    wm maxsize $top 1284 1006
    wm minsize $top 111 1
    wm overrideredirect $top 0
    wm resizable $top 1 1
    wm withdraw $top
    wm title $top "vtcl"
    bindtags $top "$top Vtcl all"
    vTcl:FireEvent $top <<Create>>
    wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <<DeleteWindow>>"

    ###################
    # SETTING GEOMETRY
    ###################

    vTcl:FireEvent $base <<Ready>>
}

proc vTclWindow.top79 {base} {
    if {$base == ""} {
        set base .top79
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    set top $base
    ###################
    # CREATING WIDGETS
    ###################
    vTcl:toplevel $top -class Toplevel
    wm focusmodel $top passive
    wm geometry $top +247+229; update
    wm maxsize $top 1284 1006
    wm minsize $top 111 1
    wm overrideredirect $top 0
    wm resizable $top 1 1
    wm deiconify $top
    wm title $top "Modal Dialog Tutorial"
    vTcl:DefineAlias "$top" "Toplevel1" vTcl:Toplevel:WidgetProc "" 1
    bindtags $top "$top Toplevel all _TopLevel"
    bind $top <<DeleteWindow>> {
        ## because of the modal dialog box, the toplevel
## count will not work correctly (modal box still hidden),
## and the interpreter will keep running in memory

## to ensure the application exits properly, make
## sure you add the <<DeleteWindow>> binding if
## you have modal dialog boxes in your project

## exit right there
exit
    }
    vTcl:FireEvent $top <<Create>>
    wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <<DeleteWindow>>"

    label $top.lab80 \
        -background #d53be243ecec -justify left \
        -text {A modal dialog box prevents interaction with any other window while it is shown.

To start a modal dialog box, use the toplevel alias for example:} 
    vTcl:DefineAlias "$top.lab80" "Label1" vTcl:WidgetProc "Toplevel1" 1
    label $top.lab81 \
        -anchor w -background #ffffff -text {Toplevel 2 startmodal} 
    vTcl:DefineAlias "$top.lab81" "Label2" vTcl:WidgetProc "Toplevel1" 1
    label $top.lab83 \
        -anchor w \
        -text {When the dialog box ends (for example, user clicks on OK), use:} 
    vTcl:DefineAlias "$top.lab83" "Label4" vTcl:WidgetProc "Toplevel1" 1
    label $top.lab82 \
        -anchor w -background #ffffff -text {Toplevel2 endmodal} 
    vTcl:DefineAlias "$top.lab82" "Label3" vTcl:WidgetProc "Toplevel1" 1
    button $top.but84 \
        \
        -command {## this shows the dialog box end starts the grab
Toplevel2 startmodal} \
        -pady 0 -text {Show Modal Dialog!} 
    vTcl:DefineAlias "$top.but84" "Button1" vTcl:WidgetProc "Toplevel1" 1
    ###################
    # SETTING GEOMETRY
    ###################
    pack $top.lab80 \
        -in $top -anchor center -expand 0 -fill none -padx 5 -pady 5 \
        -side top 
    pack $top.lab81 \
        -in $top -anchor center -expand 0 -fill x -padx 5 -pady 5 -side top 
    pack $top.lab83 \
        -in $top -anchor center -expand 0 -fill x -padx 5 -pady 5 -side top 
    pack $top.lab82 \
        -in $top -anchor center -expand 0 -fill x -padx 5 -pady 5 -side top 
    pack $top.but84 \
        -in $top -anchor center -expand 0 -fill none -padx 5 -pady 5 \
        -side top 

    vTcl:FireEvent $base <<Ready>>
}

proc vTclWindow.top81 {base} {
    if {$base == ""} {
        set base .top81
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    set top $base
    ###################
    # CREATING WIDGETS
    ###################
    vTcl:toplevel $top -class Toplevel
    wm withdraw $top
    wm focusmodel $top passive
    wm geometry $top +287+466; update
    wm maxsize $top 1284 1006
    wm minsize $top 111 1
    wm overrideredirect $top 0
    wm resizable $top 1 1
    wm title $top "This is the modal dialog box"
    vTcl:DefineAlias "$top" "Toplevel2" vTcl:Toplevel:WidgetProc "" 1
    bindtags $top "$top Toplevel all _TopLevel"
    vTcl:FireEvent $top <<Create>>
    wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <<DeleteWindow>>"

    label $top.lab82 \
        -background #ececcbc1d9af -justify left \
        -text {A modal dialog box has the "Run Visible" property set to "no".

This means that by default, the window will be hidden.

Only when modal interaction happens will the window be shown.} 
    vTcl:DefineAlias "$top.lab82" "Label1" vTcl:WidgetProc "Toplevel2" 1
    button $top.but83 \
        \
        -command {## this hides the dialog box end releases the grab
Toplevel2 endmodal} \
        -pady 0 -text {Click me!} 
    vTcl:DefineAlias "$top.but83" "Button1" vTcl:WidgetProc "Toplevel2" 1
    ###################
    # SETTING GEOMETRY
    ###################
    pack $top.lab82 \
        -in $top -anchor center -expand 0 -fill none -padx 5 -pady 5 \
        -side top 
    pack $top.but83 \
        -in $top -anchor center -expand 0 -fill none -padx 5 -pady 5 \
        -side top 

    vTcl:FireEvent $base <<Ready>>
}

#############################################################################
## Binding tag:  _TopLevel

bind "_TopLevel" <<Create>> {
    if {![info exists _topcount]} {set _topcount 0}; incr _topcount
}
bind "_TopLevel" <<DeleteWindow>> {
    if {[set ::%W::_modal]} {
                vTcl:Toplevel:WidgetProc %W endmodal
            } else {
                destroy %W; if {$_topcount == 0} {exit}
            }
}
bind "_TopLevel" <Destroy> {
    if {[winfo toplevel %W] == "%W"} {incr _topcount -1}
}

Window show .
Window show .top79
Window show .top81

main $argc $argv