fontchoose.tcl 1.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869
  1. # fontchoose.tcl --
  2. #
  3. # Show off the stock font selector dialog
  4. if {![info exists widgetDemo]} {
  5. error "This script should be run from the \"widget\" demo."
  6. }
  7. package require Tk
  8. set w .fontchoose
  9. catch {destroy $w}
  10. toplevel $w
  11. wm title $w "Font Selection Dialog"
  12. wm iconname $w "fontchooser"
  13. positionWindow $w
  14. catch {font create FontchooseDemoFont {*}[font actual TkDefaultFont]}
  15. # The font chooser needs to be configured and then shown.
  16. proc SelectFont {parent} {
  17. tk fontchooser configure -font FontchooseDemoFont \
  18. -command ApplyFont -parent $parent
  19. tk fontchooser show
  20. }
  21. proc ApplyFont {font} {
  22. font configure FontchooseDemoFont {*}[font actual $font]
  23. }
  24. # When the visibility of the fontchooser changes, the following event is fired
  25. # to the parent widget.
  26. #
  27. bind $w <<TkFontchooserVisibility>> {
  28. if {[tk fontchooser configure -visible]} {
  29. %W.f.font state disabled
  30. } else {
  31. %W.f.font state !disabled
  32. }
  33. }
  34. set f [ttk::frame $w.f -relief sunken -padding 2]
  35. text $f.msg -font FontchooseDemoFont -width 40 -height 6 -borderwidth 0 \
  36. -yscrollcommand [list $f.vs set]
  37. ttk::scrollbar $f.vs -command [list $f.msg yview]
  38. $f.msg insert end "Press the buttons below to choose a new font for the\
  39. text shown in this window.\n" {}
  40. ttk::button $f.font -text "Set font ..." -command [list SelectFont $w]
  41. grid $f.msg $f.vs -sticky news
  42. grid $f.font - -sticky e
  43. grid columnconfigure $f 0 -weight 1
  44. grid rowconfigure $f 0 -weight 1
  45. bind $w <Visibility> {
  46. bind %W <Visibility> {}
  47. grid propagate %W.f 0
  48. }
  49. ## See Code / Dismiss buttons
  50. set btns [addSeeDismiss $w.buttons $w]
  51. grid $f -sticky news
  52. grid $btns -sticky ew
  53. grid columnconfigure $w 0 -weight 1
  54. grid rowconfigure $w 0 -weight 1