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

通讯编程

开发平台:

Visual C++

  1. # bitmap.tcl --
  2. #
  3. # This demonstration script creates a toplevel window that displays
  4. # all of Tk's built-in bitmaps.
  5. #
  6. # RCS: @(#) $Id: bitmap.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $
  7. if {![info exists widgetDemo]} {
  8.     error "This script should be run from the "widget" demo."
  9. }
  10. # bitmapRow --
  11. # Create a row of bitmap items in a window.
  12. #
  13. # Arguments:
  14. # w - The window that is to contain the row.
  15. # args - The names of one or more bitmaps, which will be displayed
  16. # in a new row across the bottom of w along with their
  17. # names.
  18. proc bitmapRow {w args} {
  19.     frame $w
  20.     pack $w -side top -fill both
  21.     set i 0
  22.     foreach bitmap $args {
  23. frame $w.$i
  24. pack $w.$i -side left -fill both -pady .25c -padx .25c
  25. label $w.$i.bitmap -bitmap $bitmap
  26. label $w.$i.label -text $bitmap -width 9
  27. pack $w.$i.label $w.$i.bitmap -side bottom
  28. incr i
  29.     }
  30. }
  31. set w .bitmap
  32. global tk_library
  33. catch {destroy $w}
  34. toplevel $w
  35. wm title $w "Bitmap Demonstration"
  36. wm iconname $w "bitmap"
  37. positionWindow $w
  38. label $w.msg -font $font -wraplength 4i -justify left -text "This window displays all of Tk's built-in bitmaps, along with the names you can use for them in Tcl scripts."
  39. pack $w.msg -side top
  40. frame $w.buttons
  41. pack $w.buttons -side bottom -fill x -pady 2m
  42. button $w.buttons.dismiss -text Dismiss -command "destroy $w"
  43. button $w.buttons.code -text "See Code" -command "showCode $w"
  44. pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
  45. frame $w.frame
  46. bitmapRow $w.frame.0 error gray12 gray25 gray50 gray75
  47. bitmapRow $w.frame.1 hourglass info question questhead warning
  48. pack $w.frame -side top -expand yes -fill both