fontchoose.tcl 1.7 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667
  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. ## See Code / Dismiss buttons
  46. set btns [addSeeDismiss $w.buttons $w]
  47. grid $f -sticky news
  48. grid $btns -sticky ew
  49. grid columnconfigure $w 0 -weight 1
  50. grid rowconfigure $w 0 -weight 1
  51. update idletasks
  52. grid propagate $f 0