2 #############################################################################
3 # Visual Tcl v1.07 Project
5 # Copyright 1999 Jean-Louis Thirot
7 # This library is free software; you can redistribute it and/or
8 # modify it under the terms of the GNU Lesser General Public
9 # License as published by the Free Software Foundation; either
10 # version 2.1 of the License, or (at your option) any later version.
12 # This library is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # Lesser General Public License for more details.
17 # You should have received a copy of the GNU Lesser General Public
18 # License along with this library; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22 #################################
26 #################################
28 proc TkW
:GetFileName
{message opt1 opt2 searchtype
} {
29 global OK MSG_title WAITfilename TKW GetFileName BROWSE WAITbrowse
32 set SearchType
$searchtype
35 if {[winfo exists .getfilename
]} {
36 wm deiconify .getfilename
; return
41 toplevel .getfilename
-class Toplevel
\
43 wm focusmodel .getfilename passive
44 wm maxsize .getfilename
1265 994
45 wm minsize .getfilename
1 1
46 wm overrideredirect .getfilename
0
47 wm resizable .getfilename
1 1
48 wm deiconify .getfilename
49 wm geometry .getfilename
+100+100
50 wm title .getfilename
$MSG_title
51 #wm iconbitmap .getfilename @$TKW/shared/images/setup2.xbm
52 #wm iconmask .getfilename @$TKW/shared/images/setupmask2.xbm
54 #creates the message widget:
55 message .getfilename.msg
-justify center
-text $message \
56 -background #dddddd -aspect 300
58 # Creates the entry box:
60 entry .getfilename.ent
-textvar GetFileName
-relief sunken
-width 50
62 button .getfilename.but1
\
64 -font -Adobe-Helvetica
-Medium
-R
-Normal
-*-*-120-*-*-*-*-*-* -padx 9 \
65 -pady 3 -text $opt1 -width 8 -state disabled
\
71 button .getfilename.but2
\
73 -font -Adobe-Helvetica
-Medium
-R
-Normal
-*-*-120-*-*-*-*-*-* -padx 9 \
74 -pady 3 -text $opt2 -width 8\
75 -command {destroy .getfilename
; set WAITfilename opt2
; return}
76 button .getfilename.but3
\
78 -font -Adobe-Helvetica
-Medium
-R
-Normal
-*-*-120-*-*-*-*-*-* -padx 9 \
79 -pady 3 -text $BROWSE -width 8\
80 -command {TkW
:dirbrowse
* * $SearchType
82 while {$WAITbrowse == 1} {update}
83 if {$WAITbrowse == 0} {
84 if {$SearchType == "File"} {
85 set GetFileName
$SelectFile
87 set GetFileName
$SelectFolder
97 pack .getfilename.msg
-padx 5 -pady 5
98 #-anchor nw -bordermode ignore
99 pack .getfilename.ent
-padx 5 -pady 5
100 pack .getfilename.but1
-padx 30 -pady 10 -side left
101 pack .getfilename.but3
-padx 0 -pady 10 -side left
102 pack .getfilename.but2
-padx 30 -pady 10 -side left
103 #-x 110 -y $H2 -width 100 -height 28 -anchor nw -bordermode ignore
105 #bind .getfilename.ent <KeyPress-Return> {.getfilename.but1 invoke}
107 while {[winfo exists .getfilename
]} {
108 if {[file exists
$GetFileName]} {
109 .getfilename.but1 configure
-state normal
111 .getfilename.but1 configure
-state disabled