Posted to tcl by patthoyts at Mon Jan 18 20:08:22 GMT 2010view pretty
# Vista theme checking. # # Also tester for a frame with ttk::entry border style for wrapping # around text+scrollbar # package require Tk set EFSTYLE TEntryFrame ;# set this to EntryFrame to use the local version set EFCLASS TEntryFrame if {[catch {ttk::style layout TEntryFrame}]} { set EFSTYLE [set EFCLASS EntryFrame] } ttk::style theme settings default { ttk::style layout SFrame { SFrame.field -sticky nswe -border 0 -children { SFrame.fill -sticky nswe -children { SFrame.padding -sticky nswe } } } ttk::style configure SFrame -padding {1 1 0 0} -relief sunken ttk::style map SFrame -background {} } ttk::style theme settings default { ttk::style layout EntryFrame { EntryFrame.field -sticky nswe -border 0 -children { EntryFrame.fill -sticky nswe -children { EntryFrame.padding -sticky nswe } } } ttk::style configure EntryFrame -padding 1 -relief sunken ttk::style map EntryFrame -background {} } ttk::style theme settings classic { ttk::style configure EntryFrame -padding 2 -relief sunken ttk::style map EntryFrame -background {} } ttk::style theme settings alt { ttk::style configure EntryFrame -padding 2 ttk::style map EntryFrame -background {} } ttk::style theme settings clam { ttk::style configure EntryFrame -padding 2 ttk::style map EntryFrame -background {} } catch { ttk::style theme settings winnative { ttk::style configure EntryFrame -padding 2 } ttk::style theme settings xpnative { ttk::style configure EntryFrame -padding 1 ttk::style element create EntryFrame.field vsapi \ EDIT 1 {disabled 4 focus 3 active 2 {} 1} -padding 1 } ttk::style theme settings vista { ttk::style configure EntryFrame -padding 2 ttk::style element create EntryFrame.field vsapi \ EDIT 6 {disabled 4 focus 3 active 2 {} 1} -padding 2 } } bind EntryFrame <Enter> {%W instate !disabled {%W state active}} bind EntryFrame <Leave> {%W state !active} bind EntryFrame <<ThemeChanged>> { set pad [ttk::style lookup EntryFrame -padding] %W configure -padding [expr {$pad eq {} ? 1 : $pad}] } proc Once {} { rename Once {} ;# Only call this once per interp. #bind [winfo class .] <<ThemeChanged>> \ # [list +ttk::style layout EditFrame [ttk::style layout EditFrame]] bind . <Control-F2> {console show} } Once # ------------------------------------------------------------------------- ttk::frame .main ttk::frame .ef ttk::entry .e0 ttk::entry .e1 ttk::entry .e2 grid .e0 .e1 .e2 -in .ef -padx 1 -pady 1 ttk::frame .sf ttk::spinbox .s0 -from 0 -to 100 ; .s0 set 0 ttk::spinbox .s1 -values [info vars] ; .s1 set [lindex [.s1 cget -values] 0] ttk::spinbox .s2 -from 0 -to 100 ; .s2 set 0 grid .s0 .s1 .s2 -in .sf -padx 1 -pady 1 ttk::combobox .a -values {disabled reallydisabled} ttk::combobox .b -values [info vars] ttk::combobox .c -values [list oneoneoneoneoneoneoneoneone \ twotwotwotwotwotwotwotwotwotwotwotwotwo \ threethreethreethreethreethreethreethreethree] ttk::combobox .d -values [lsort [ttk::style theme names]] ttk::button .apply -text Apply -command {ttk::style theme use [.d get]} ttk::frame .f -relief solid -borderwidth 1 -height 20 -width 40 ttk::frame .f2 -height 20 -width 40 -style $EFSTYLE -class $EFCLASS set menu [menu .menu -tearoff 0] .menu add command -label One .menu add command -label Two ttk::menubutton .mbut -text "Menu" -menu .menu ttk::frame .tf -style $EFSTYLE -class $EFCLASS text .tf.t -width 40 -height 8 -wrap none -borderwidth 0 -relief flat \ -yscrollcommand {.tf.vs set} -xscrollcommand {.tf.hs set} ttk::scrollbar .tf.vs -orient vertical -command {.tf.t yview} ttk::scrollbar .tf.hs -orient horizontal -command {.tf.t xview} ttk::sizegrip .tf.sg .tf.t insert end [info body [lindex [info procs] 0]] grid .tf.t .tf.vs -sticky news grid .tf.hs x -sticky ew grid rowconfigure .tf 0 -weight 1 grid columnconfigure .tf 0 -weight 1 .a current 0 .a state disabled .b current 0 .c current 0 .d current [lsearch [.d cget -values] [ttk::style theme use]] .d state readonly .e0 insert end Normal .e1 insert end Readonly ; .e1 state readonly .e2 insert end Disabled ; .e2 state disabled .s1 state readonly .s2 state disabled ttk::progressbar .pb -mode indeterminate ; .pb start ttk::scale .sc ttk::frame .vf ttk::progressbar .vpb -orient vertical -mode indeterminate ;.vpb start ttk::scale .vsc -orient vertical grid .vpb .vsc -in .vf -sticky ns -padx 1 -pady 1 ttk::treeview .tv -height 4 -columns {one two} .tv heading one -text First .tv heading two -text Second set a [.tv insert {} end -text Aleph -values {aleph alpha}] .tv insert $a end -text Beth -values {beth beta} .tv insert $a end -text Kif -values {kif gamma} grid .ef - - -in .main -sticky ew -padx 5 -pady 5 grid .sf - - -in .main -sticky ew -padx 5 -pady 5 grid .a .mbut .vf -in .main -sticky w -padx 5 -pady 5 grid .b - ^ -in .main -sticky w -padx 5 -pady 5 grid .c - ^ -in .main -sticky w -padx 5 -pady 5 grid .d .apply - -in .main -sticky w -padx 5 -pady 5 grid .f .f2 - -in .main -sticky w -padx 5 -pady 5 grid .pb .sc - -in .main -sticky w -padx 5 -pady 5 grid .tv - - -in .main -sticky news -padx 5 -pady 5 grid .tf - - -in .main -sticky news -padx 5 -pady 5 grid columnconfigure .main 0 -weight 1 grid rowconfigure .main 9 -weight 1 grid .main -sticky news grid rowconfigure . 0 -weight 1 grid columnconfigure . 0 -weight 1