source: proiecte/pmake3d/make3d_original/Make3dSingleImageStanford_version0.1/third_party/vrippack-0.31/lib/linux/tk8.4/demos/msgbox.tcl @ 37

Last change on this file since 37 was 37, checked in by (none), 14 years ago

Added original make3d

File size: 2.1 KB
Line 
1# msgbox.tcl --
2#
3# This demonstration script creates message boxes of various type
4#
5# RCS: @(#) $Id: msgbox.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $
6
7if {![info exists widgetDemo]} {
8    error "This script should be run from the \"widget\" demo."
9}
10
11set w .msgbox
12catch {destroy $w}
13toplevel $w
14wm title $w "Message Box Demonstration"
15wm iconname $w "messagebox"
16positionWindow $w
17
18label $w.msg -font $font -wraplength 4i -justify left -text "Choose the icon and type option of the message box. Then press the \"Message Box\" button to see the message box."
19pack $w.msg -side top
20
21frame $w.buttons
22pack $w.buttons -side bottom -fill x -pady 2m
23button $w.buttons.dismiss -text Dismiss -command "destroy $w"
24button $w.buttons.code -text "See Code" -command "showCode $w"
25button $w.buttons.vars -text "Message Box"  \
26    -command "showMessageBox $w"
27pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
28
29frame $w.left 
30frame $w.right
31pack $w.left $w.right -side left -expand yes -fill y  -pady .5c -padx .5c
32
33label $w.left.label -text "Icon"
34frame $w.left.sep -relief ridge -bd 1 -height 2
35pack $w.left.label -side top
36pack $w.left.sep -side top -fill x -expand no
37
38set msgboxIcon info
39foreach i {error info question warning} {
40    radiobutton $w.left.b$i -text $i -variable msgboxIcon \
41        -relief flat -value $i -width 16 -anchor w
42    pack $w.left.b$i  -side top -pady 2 -anchor w -fill x
43}
44
45label $w.right.label -text "Type"
46frame $w.right.sep -relief ridge -bd 1 -height 2
47pack $w.right.label -side top
48pack $w.right.sep -side top -fill x -expand no
49
50set msgboxType ok
51foreach t {abortretryignore ok okcancel retrycancel yesno yesnocancel} {
52    radiobutton $w.right.$t -text $t -variable msgboxType \
53        -relief flat -value $t -width 16 -anchor w
54    pack $w.right.$t -side top -pady 2 -anchor w -fill x
55}
56
57proc showMessageBox {w} {
58    global msgboxIcon msgboxType
59    set button [tk_messageBox -icon $msgboxIcon -type $msgboxType \
60        -title Message -parent $w\
61        -message "This is a \"$msgboxType\" type messagebox with the \"$msgboxIcon\" icon"]
62   
63    tk_messageBox -icon info -message "You have selected \"$button\"" -type ok\
64        -parent $w
65}
Note: See TracBrowser for help on using the repository browser.