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