Posted to tcl by patthoyts at Mon Jan 18 20:08:22 GMT 2010view raw

  1. # Vista theme checking.
  2. #
  3. # Also tester for a frame with ttk::entry border style for wrapping
  4. # around text+scrollbar
  5. #
  6.  
  7. package require Tk
  8.  
  9. set EFSTYLE TEntryFrame ;# set this to EntryFrame to use the local version
  10. set EFCLASS TEntryFrame
  11.  
  12. if {[catch {ttk::style layout TEntryFrame}]} {
  13. set EFSTYLE [set EFCLASS EntryFrame]
  14. }
  15.  
  16.  
  17. ttk::style theme settings default {
  18. ttk::style layout SFrame {
  19. SFrame.field -sticky nswe -border 0 -children {
  20. SFrame.fill -sticky nswe -children {
  21. SFrame.padding -sticky nswe
  22. }
  23. }
  24. }
  25. ttk::style configure SFrame -padding {1 1 0 0} -relief sunken
  26. ttk::style map SFrame -background {}
  27. }
  28.  
  29.  
  30. ttk::style theme settings default {
  31. ttk::style layout EntryFrame {
  32. EntryFrame.field -sticky nswe -border 0 -children {
  33. EntryFrame.fill -sticky nswe -children {
  34. EntryFrame.padding -sticky nswe
  35. }
  36. }
  37. }
  38. ttk::style configure EntryFrame -padding 1 -relief sunken
  39. ttk::style map EntryFrame -background {}
  40. }
  41. ttk::style theme settings classic {
  42. ttk::style configure EntryFrame -padding 2 -relief sunken
  43. ttk::style map EntryFrame -background {}
  44. }
  45. ttk::style theme settings alt {
  46. ttk::style configure EntryFrame -padding 2
  47. ttk::style map EntryFrame -background {}
  48. }
  49. ttk::style theme settings clam {
  50. ttk::style configure EntryFrame -padding 2
  51. ttk::style map EntryFrame -background {}
  52. }
  53.  
  54. catch {
  55. ttk::style theme settings winnative {
  56. ttk::style configure EntryFrame -padding 2
  57. }
  58. ttk::style theme settings xpnative {
  59. ttk::style configure EntryFrame -padding 1
  60. ttk::style element create EntryFrame.field vsapi \
  61. EDIT 1 {disabled 4 focus 3 active 2 {} 1} -padding 1
  62. }
  63. ttk::style theme settings vista {
  64. ttk::style configure EntryFrame -padding 2
  65. ttk::style element create EntryFrame.field vsapi \
  66. EDIT 6 {disabled 4 focus 3 active 2 {} 1} -padding 2
  67. }
  68. }
  69.  
  70. bind EntryFrame <Enter> {%W instate !disabled {%W state active}}
  71. bind EntryFrame <Leave> {%W state !active}
  72. bind EntryFrame <<ThemeChanged>> {
  73. set pad [ttk::style lookup EntryFrame -padding]
  74. %W configure -padding [expr {$pad eq {} ? 1 : $pad}]
  75. }
  76.  
  77. proc Once {} {
  78. rename Once {} ;# Only call this once per interp.
  79.  
  80. #bind [winfo class .] <<ThemeChanged>> \
  81. # [list +ttk::style layout EditFrame [ttk::style layout EditFrame]]
  82. bind . <Control-F2> {console show}
  83. }
  84. Once
  85.  
  86. # -------------------------------------------------------------------------
  87. ttk::frame .main
  88.  
  89. ttk::frame .ef
  90. ttk::entry .e0
  91. ttk::entry .e1
  92. ttk::entry .e2
  93.  
  94. grid .e0 .e1 .e2 -in .ef -padx 1 -pady 1
  95.  
  96. ttk::frame .sf
  97. ttk::spinbox .s0 -from 0 -to 100 ; .s0 set 0
  98. ttk::spinbox .s1 -values [info vars] ; .s1 set [lindex [.s1 cget -values] 0]
  99. ttk::spinbox .s2 -from 0 -to 100 ; .s2 set 0
  100.  
  101. grid .s0 .s1 .s2 -in .sf -padx 1 -pady 1
  102.  
  103. ttk::combobox .a -values {disabled reallydisabled}
  104. ttk::combobox .b -values [info vars]
  105. ttk::combobox .c -values [list oneoneoneoneoneoneoneoneone \
  106. twotwotwotwotwotwotwotwotwotwotwotwotwo \
  107. threethreethreethreethreethreethreethreethree]
  108. ttk::combobox .d -values [lsort [ttk::style theme names]]
  109. ttk::button .apply -text Apply -command {ttk::style theme use [.d get]}
  110. ttk::frame .f -relief solid -borderwidth 1 -height 20 -width 40
  111. ttk::frame .f2 -height 20 -width 40 -style $EFSTYLE -class $EFCLASS
  112.  
  113. set menu [menu .menu -tearoff 0]
  114. .menu add command -label One
  115. .menu add command -label Two
  116. ttk::menubutton .mbut -text "Menu" -menu .menu
  117.  
  118. ttk::frame .tf -style $EFSTYLE -class $EFCLASS
  119. text .tf.t -width 40 -height 8 -wrap none -borderwidth 0 -relief flat \
  120. -yscrollcommand {.tf.vs set} -xscrollcommand {.tf.hs set}
  121. ttk::scrollbar .tf.vs -orient vertical -command {.tf.t yview}
  122. ttk::scrollbar .tf.hs -orient horizontal -command {.tf.t xview}
  123. ttk::sizegrip .tf.sg
  124. .tf.t insert end [info body [lindex [info procs] 0]]
  125.  
  126. grid .tf.t .tf.vs -sticky news
  127. grid .tf.hs x -sticky ew
  128. grid rowconfigure .tf 0 -weight 1
  129. grid columnconfigure .tf 0 -weight 1
  130.  
  131. .a current 0
  132. .a state disabled
  133. .b current 0
  134. .c current 0
  135. .d current [lsearch [.d cget -values] [ttk::style theme use]]
  136. .d state readonly
  137.  
  138. .e0 insert end Normal
  139. .e1 insert end Readonly ; .e1 state readonly
  140. .e2 insert end Disabled ; .e2 state disabled
  141.  
  142. .s1 state readonly
  143. .s2 state disabled
  144.  
  145. ttk::progressbar .pb -mode indeterminate ; .pb start
  146. ttk::scale .sc
  147.  
  148. ttk::frame .vf
  149. ttk::progressbar .vpb -orient vertical -mode indeterminate ;.vpb start
  150. ttk::scale .vsc -orient vertical
  151. grid .vpb .vsc -in .vf -sticky ns -padx 1 -pady 1
  152.  
  153. ttk::treeview .tv -height 4 -columns {one two}
  154. .tv heading one -text First
  155. .tv heading two -text Second
  156. set a [.tv insert {} end -text Aleph -values {aleph alpha}]
  157. .tv insert $a end -text Beth -values {beth beta}
  158. .tv insert $a end -text Kif -values {kif gamma}
  159.  
  160. grid .ef - - -in .main -sticky ew -padx 5 -pady 5
  161. grid .sf - - -in .main -sticky ew -padx 5 -pady 5
  162. grid .a .mbut .vf -in .main -sticky w -padx 5 -pady 5
  163. grid .b - ^ -in .main -sticky w -padx 5 -pady 5
  164. grid .c - ^ -in .main -sticky w -padx 5 -pady 5
  165. grid .d .apply - -in .main -sticky w -padx 5 -pady 5
  166. grid .f .f2 - -in .main -sticky w -padx 5 -pady 5
  167. grid .pb .sc - -in .main -sticky w -padx 5 -pady 5
  168. grid .tv - - -in .main -sticky news -padx 5 -pady 5
  169. grid .tf - - -in .main -sticky news -padx 5 -pady 5
  170.  
  171. grid columnconfigure .main 0 -weight 1
  172. grid rowconfigure .main 9 -weight 1
  173.  
  174. grid .main -sticky news
  175. grid rowconfigure . 0 -weight 1
  176. grid columnconfigure . 0 -weight 1