home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / lib / regexpviewer / about.tcl next >
Encoding:
Text File  |  2004-03-23  |  1.8 KB  |  77 lines
  1. # about.tcl -- Provide an about window.
  2.  
  3. # Copyright 2004 David N. Welton <davidw@dedasys.com>
  4.  
  5. package provide about 0.1
  6.  
  7. namespace eval about {
  8.     proc mc {arg} {
  9.     return $arg
  10.     }
  11. }
  12.  
  13. # about::about --
  14. #
  15. #    Creates an about dialog.
  16. #
  17. # Arguments:
  18. #    codename - name of the program.
  19. #    devname - name (and email address) of the developer.
  20. #    text - text to write in the widget, in the form "blah blah"
  21. #    TAG "blah blah" TAG, where TAG can be one of title, center,
  22. #    bold.
  23. #
  24. # Side Effects:
  25. #    Creates/Destroys .about widget.
  26. #
  27. # Results:
  28. #    None.
  29.  
  30. proc about::about {codename devname txt} {
  31.     variable a
  32.     catch { destroy .about }
  33.     set a [toplevel .about]
  34.  
  35.     wm title $a "About $codename"
  36.     button $a.b -text [mc "Close"] -command [list wm withdraw $a]
  37.  
  38.     text $a.text -height 9 -bd 1 -width 60
  39.     pack $a.b -side bottom
  40.     pack $a.text -fill both -side left -expand 1
  41.     $a.text configure -background "\#ffffff"
  42.     $a.text configure -foreground "\#ffffff"
  43.     $a.text configure -font {Helvetica -12}
  44.     $a.text tag config center -justify center
  45.     $a.text tag config bold -font {Helvetica -12 bold}
  46.     $a.text tag config title -justify center -font {Helvetica -18 bold}
  47.     $a.text insert 1.0 [mc "About $codename"] title \
  48.     "\n\nCopyright (C) [clock format [clock seconds] -format %Y] $devname\n\n" \
  49.     center
  50.     eval $a.text insert end "$txt"
  51.     $a.text config -state disabled
  52.     after 0 [list about::fade 255]
  53. }
  54.  
  55. # about::fade --
  56. #
  57. #    Fade in effect for text.
  58. #
  59. # Arguments:
  60. #    val - value from 0 to 255
  61. #
  62. # Side Effects:
  63. #    Changes text foreground color.
  64. #
  65. # Results:
  66. #    None.
  67.  
  68. proc about::fade {val} {
  69.     variable a
  70.     if { $val > 0 } {
  71.     incr val -1
  72.     after 1 [list about::fade $val]
  73.     }
  74.     set fval [format "%.2x" $val]
  75.     $a.text configure -foreground "\#$fval$fval$fval"
  76. }
  77.