Posted to tcl by saedelaere at Wed Jun 24 12:07:02 GMT 2009view raw

  1. proc font_chooserUi {} {
  2.  
  3. set w [toplevel .fontchooser]
  4.  
  5. place [ttk::frame $w.bgcolor] -x 0 -y 0 -relwidth 1 -relheight 1
  6.  
  7. set mffont [ttk::frame $w.f_ch_font]
  8.  
  9. set mfpre [ttk::frame $w.f_ch_pre]
  10.  
  11. set mfbottom [ttk::frame $w.f_ch_bottom \
  12. -borderwidth 2 \
  13. -relief groove]
  14.  
  15. ttk::label $mffont.l_fam \
  16. -text [mc "Family:"]
  17. listbox $mffont.lb_fam \
  18. -exportselection false \
  19. -yscrollcommand [list $mffont.scrollb_famy set] \
  20. -xscrollcommand [list $mffont.scrollb_famx set]
  21. ttk::scrollbar $mffont.scrollb_famy \
  22. -orient vertical \
  23. -command [list $mffont.lb_fam yview]
  24. ttk::scrollbar $mffont.scrollb_famx \
  25. -orient horizontal \
  26. -command [list $mffont.lb_fam xview]
  27.  
  28. ttk::label $mffont.l_style \
  29. -text [mc "Style:"]
  30. listbox $mffont.lb_style \
  31. -exportselection false \
  32. -yscrollcommand [list $mffont.scrollb_styley set]
  33. ttk::scrollbar $mffont.scrollb_styley \
  34. -orient vertical \
  35. -command [list $mffont.lb_style yview]
  36.  
  37. ttk::label $mffont.l_size \
  38. -text [mc "Size:"]
  39. listbox $mffont.lb_size \
  40. -exportselection false \
  41. -yscrollcommand [list $mffont.scrollb_sizey set] \
  42. -width 0
  43. ttk::scrollbar $mffont.scrollb_sizey \
  44. -orient vertical \
  45. -command [list $mffont.lb_size yview]
  46.  
  47. ttk::label $mfpre.l_prev \
  48. -text [mc "Preview:"]
  49. ttk::frame $mfpre.f_prev \
  50. -borderwidth 2 \
  51. -relief groove
  52. ttk::entry $mfpre.f_prev.e_abc \
  53. -textvariable font(abc)
  54.  
  55. ttk::button $mfbottom.b_apply \
  56. -text [mc "Apply"] \
  57. -command "" \
  58. -compound left \
  59. -image $::icon_s(dialog-ok-apply)
  60. ttk::button $mfbottom.b_cancel \
  61. -text [mc "Cancel"] \
  62. -command "" \
  63. -compound left \
  64. -image $::icon_s(dialog-cancel)
  65.  
  66.  
  67. grid columnconfigure $mfpre 0 -weight 1
  68. grid columnconfigure $mfpre.f_prev 0 -weight 1
  69.  
  70. grid $mffont -in $w -row 0 -column 0 \
  71. -sticky ew \
  72. -padx 8 \
  73. -pady 8
  74. grid $mfpre -in $w -row 1 -column 0 \
  75. -sticky ew \
  76. -padx 8
  77. grid $mfbottom -in $w -row 2 -column 0 \
  78. -sticky ew \
  79. -padx 8 \
  80. -pady 8
  81.  
  82. grid anchor $mfbottom e
  83.  
  84. grid $mffont.l_fam -in $mffont -row 0 -column 0 \
  85. -sticky w
  86. grid $mffont.lb_fam -in $mffont -row 1 -column 0
  87. grid $mffont.scrollb_famy -row 1 -column 1 \
  88. -sticky ns \
  89. -padx "1 4"
  90. grid $mffont.scrollb_famx -row 2 -column 0 \
  91. -sticky ew \
  92. -pady "1 0"
  93.  
  94. grid $mffont.l_style -in $mffont -row 0 -column 2 \
  95. -sticky w
  96. grid $mffont.lb_style -in $mffont -row 1 -column 2 \
  97. -rowspan 2 \
  98. -sticky ns
  99. grid $mffont.scrollb_styley -in $mffont -row 1 -column 3 \
  100. -rowspan 2 \
  101. -sticky ns \
  102. -padx "1 4"
  103.  
  104. grid $mffont.l_size -in $mffont -row 0 -column 4 \
  105. -sticky w \
  106. -columnspan 2
  107. grid $mffont.lb_size -in $mffont -row 1 -column 4 \
  108. -rowspan 2 \
  109. -sticky ns
  110. grid $mffont.scrollb_sizey -in $mffont -row 1 -column 5 \
  111. -rowspan 2 \
  112. -sticky ns \
  113. -padx "1 0"
  114.  
  115. grid $mfpre.l_prev -in $mfpre -row 0 -column 0 \
  116. -sticky w
  117. grid $mfpre.f_prev -in $mfpre -row 1 -column 0 \
  118. -sticky ew
  119. grid $mfpre.f_prev.e_abc -in $mfpre.f_prev -row 0 -column 0 \
  120. -padx 3 \
  121. -pady 7 \
  122. -sticky ew
  123.  
  124. grid $mfbottom.b_apply -in $mfbottom -row 0 -column 0 \
  125. -pady 7
  126. grid $mfbottom.b_cancel -in $mfbottom -row 0 -column 1 \
  127. -padx 3
  128.  
  129. foreach fam [lsort [font families]] {
  130. $mffont.lb_fam insert end " $fam"
  131. }
  132. $mffont.lb_fam insert end " Sans"
  133. set avail_styles {Regular Italic Bold "Bold Italic"}
  134.  
  135. foreach style $avail_styles {
  136. $mffont.lb_style insert end " $style"
  137. }
  138.  
  139. set avail_sizes {8 9 10 11 12 14 16 18 20 22 24 26 28 32 36 40 48 54 60 66 72 80 88 96}
  140.  
  141. foreach size $avail_sizes {
  142. $mffont.lb_size insert end " $size "
  143. }
  144.  
  145. bind $mffont.lb_fam <<ListboxSelect>> [list font_chooserUiCfont $mffont.lb_fam $mffont.lb_style $mffont.lb_size $mfpre.f_prev.e_abc]
  146. bind $mffont.lb_style <<ListboxSelect>> [list font_chooserUiCfont $mffont.lb_fam $mffont.lb_style $mffont.lb_size $mfpre.f_prev.e_abc]
  147. bind $mffont.lb_size <<ListboxSelect>> [list font_chooserUiCfont $mffont.lb_fam $mffont.lb_style $mffont.lb_size $mfpre.f_prev.e_abc]
  148.  
  149. ####
  150. $mffont.lb_fam selection set 0
  151. $mffont.lb_style selection set 0
  152. $mffont.lb_size selection set 0
  153.  
  154. set ::font(abc) "abcdefghijk ABCDEFGHIJK"
  155.  
  156. #wm resizable $w 0 0
  157. }
  158.  
  159. proc font_chooserUiCfont {lb1 lb2 lb3 pre_entry} {
  160. set font "[string trim [$lb1 get [$lb1 curselection]]]"
  161. set style "[string trim [string tolower [$lb2 get [$lb2 curselection]]]]"
  162. set size "[string trim [$lb3 get [$lb3 curselection]]]"
  163. puts "font $font style $style size $size"
  164. if {"$style" == "regular"} {
  165. $pre_entry configure -font "{$font} $size"
  166. } else {
  167. $pre_entry configure -font "{$font} $size $style"
  168. }
  169. }
  170.