filebox.tcl
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:2k
源码类别:

通讯编程

开发平台:

Visual C++

  1. # filebox.tcl --
  2. #
  3. # This demonstration script prompts the user to select a file.
  4. #
  5. # RCS: @(#) $Id: filebox.tcl,v 1.3.4.1 2004/09/10 20:48:41 dkf Exp $
  6. if {![info exists widgetDemo]} {
  7.     error "This script should be run from the "widget" demo."
  8. }
  9. set w .filebox
  10. catch {destroy $w}
  11. toplevel $w
  12. wm title $w "File Selection Dialogs"
  13. wm iconname $w "filebox"
  14. positionWindow $w
  15. label $w.msg -font $font -wraplength 4i -justify left -text "Enter a file name in the entry box or click on the "Browse" buttons to select a file name using the file selection dialog."
  16. pack $w.msg -side top
  17. frame $w.buttons
  18. pack $w.buttons -side bottom -fill x -pady 2m
  19. button $w.buttons.dismiss -text Dismiss -command "destroy $w"
  20. button $w.buttons.code -text "See Code" -command "showCode $w"
  21. pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
  22. foreach i {open save} {
  23.     set f [frame $w.$i]
  24.     label $f.lab -text "Select a file to $i: " -anchor e
  25.     entry $f.ent -width 20
  26.     button $f.but -text "Browse ..." -command "fileDialog $w $f.ent $i"
  27.     pack $f.lab -side left
  28.     pack $f.ent -side left -expand yes -fill x
  29.     pack $f.but -side left
  30.     pack $f -fill x -padx 1c -pady 3
  31. }
  32. if {![string compare $tcl_platform(platform) unix]} {
  33.     checkbutton $w.strict -text "Use Motif Style Dialog" 
  34. -variable tk_strictMotif -onvalue 1 -offvalue 0
  35.     pack $w.strict -anchor c
  36.     # This binding ensures that we don't run the rest of the demos
  37.     # with motif style interactions
  38.     bind $w.strict <Destroy> {set tk_strictMotif 0}
  39. }
  40. proc fileDialog {w ent operation} {
  41.     #   Type names Extension(s) Mac File Type(s)
  42.     #
  43.     #---------------------------------------------------------
  44.     set types {
  45. {"Text files" {.txt .doc} }
  46. {"Text files" {} TEXT}
  47. {"Tcl Scripts" {.tcl} TEXT}
  48. {"C Source Files" {.c .h} }
  49. {"All Source Files" {.tcl .c .h} }
  50. {"Image Files" {.gif} }
  51. {"Image Files" {.jpeg .jpg} }
  52. {"Image Files" "" {GIFF JPEG}}
  53. {"All files" *}
  54.     }
  55.     if {$operation == "open"} {
  56. set file [tk_getOpenFile -filetypes $types -parent $w]
  57.     } else {
  58. set file [tk_getSaveFile -filetypes $types -parent $w 
  59.     -initialfile Untitled -defaultextension .txt]
  60.     }
  61.     if {[string compare $file ""]} {
  62. $ent delete 0 end
  63. $ent insert 0 $file
  64. $ent xview end
  65.     }
  66. }