A tile exercise!
# ImageLib.tcl --- # Automatically created by: CreateImageLib.tcl set images(scope-oval) [image create photo -data { R0lGODlhGAAOAIAAAAAAAAAAACH5BAkAAAEALAAAAAAYAA4AAAIcjAOpy3Df IntI2nSudrv7D4biSFalcWYhhX5PAQA7 }] set images(scope-ovalBlank) [image create photo -data { R0lGODlhGAAOAJEAAAAAAKSkpAAAAAAAACH5BAkKAAIAIf/8SUNDUkdCRzEw MTIAAALAYXBwbAIAAABtbnRyUkdCIFhZWiAH2QAHAB4AAAAAAABhY3NwQVBQ TAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA9tYAAQAAAADTLWFwcGwAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAxy WFlaAAABFAAAABRnWFlaAAABKAAAABRiWFlaAAABPAAAABR3dHB0AAABUAAA ABRjaGFkAAABZAAAACxyVFJDAAABkAAAAA5nVFJDAAABoAAAAA5iVFJDAAAB sAAAAA52Y2d0AAABwAAAADBu/2RpbgAAAfAAAAA4ZGVzYwAAAigAAAB0Y3By dAAAApwAAAAkWFlaIAAAAAAAAHRLAAA+HQAAA8xYWVogAAAAAAAAWnMAAKym AAAXJlhZWiAAAAAAAAAoGAAAFVcAALgzWFlaIAAAAAAAAPNRAAEAAAABFsxz ZjMyAAAAAAABDEIAAAXe///zJgAAB5MAAP2Q///7ov///aMAAAPcAADAbmN1 cnYAAAAAAAAAAQIzAABjdXJ2AAAAAAAAAAECMwAAY3VydgAAAAAAAAABAjMA AHZjZ3QAAAAAAAAAAQABAAAAAAAAAAEAAAABAAAAAAAAAAEAAAABAAAAAAAA AAEAANBuZGluAAAAAAAAADAAAKFIAABXCgAAS4UAAJrhAAAnrgAAE7YAAFAN AABUOQACMzIAAjMyAAIzMmRlc2MAAAAAAAAAGkNhbGlicmF0ZWQgUkdCIENv bG9yc3BhY2UAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAdGV4 dAAAAABDb3B5cmlnaHQgQXBwbGUsIEluYy4sIDIwMDkAACwAAAAAGAAOAAAC HJQVqctx3yJ7SNp0rna7+w+G4khWpXFmIYV+TwEAOw== }] set images(scope-ovalDark) [image create photo -data { R0lGODlhGAAOAIAAAAAAAAAAACH5BAkAAAEALAAAAAAYAA4AAAIcjAOpy3Df IntI2nSudrv7D4biSFalcWYhhX5PAQA7 }]
The code:
# scopebutton.tcl --- # ------------------------------------------------------------------------- # Includes code (styling and graphics) from the Coccinella application. # Copyright (c) 2005-2008 Mats Bengtsson # # Additional modifications # (c) 2009 Kevin Walzer/WordTech Communications LLC. # # Further modifications for inclusion into TclMacBag # (C) 2007-2009 Peter Caffin and other parties. # # Turned the original source into a namespace's package + # further changes where done to eliminate the need of the Img library. # (c) 2009, Johann Oberdorfer [email protected] # # This file is BSD style licensed. # ------------------------------------------------------------------------- # # From Apple's Human Interface Guidelines: # "The scope button is used in a scope bar to specify the scope of an # operation, such as search... # Scope buttons are designed to be used in scope bars and related filter # rows only. They are not intended to be used in the toolbar or # bottom-bar areas or outside of a scope bar in the window body. # The recessed scope button style is used to display types or # groups of objects or locations the user can select to narrow the # focus of a search or other operation." # In this context, we are implementing a scopebutton as a styled # ttk::radiobutton. # # A command will fire when the ttk::radiobutton variable changes. # The "scope bar" should be a simple frame widget. # We are not implementing scope-style menubuttons because they # add interface and programming complexity. # ------------------------------------------------------------------------- package provide scopebutton 0.1 if { [info patchlevel] < 8.5 } { package require tile 0.8 } namespace eval ::scopebutton:: { variable wLocals namespace export scopebutton set thisDir [file dirname [info script]] array set wLocals [list \ imageDir [file join $thisDir "images"] \ imageLib [file join $thisDir "ImageLib.tcl"] \ imageArrayName "images" \ ] # try to load image library file... if { [file exists $wLocals(imageLib)] } { source $wLocals(imageLib) array set wLocals [array get images] } else { proc LoadImages {imgdir {patterns {*.gif}}} { foreach pattern $patterns { foreach file [glob -directory $imgdir $pattern] { set img [file tail [file rootname $file]] if {![info exists images($img)]} { set images($img) [image create photo -file $file] } }} return [array get images] } array set wLocals [LoadImages $wLocals(imageDir) "*.gif"] } } proc ::scopebutton::DefineOrUpdateCustomStyle {} { variable wLocals # create a new element for each available theme foreach themeName [ttk::style theme names] { # temporarily sets the current theme to themeName, # evaluate script, then restore the previous theme. ttk::style theme settings $themeName { # make sure, element is created only once: set elementNames [ttk::style element names] if { [lsearch $elementNames ScopeButtonStyle.background] == -1 } { # scope type button--create the layout ttk::style element create ScopeButtonStyle.background image \ [list $wLocals(scope-ovalBlank) \ {background} $wLocals(scope-ovalBlank) \ {active !disabled !pressed} $wLocals(scope-oval) \ {pressed !disabled} $wLocals(scope-ovalDark) \ {selected !disabled !pressed} $wLocals(scope-ovalDark) \ {selected disabled} $wLocals(scope-ovalDark)] \ \ -border {6 6 6 6} -padding {0} -sticky news ttk::style layout ScopeButtonStyle { ScopeButtonStyle.background -children { ScopeButtonStyle.padding -children { ScopeButtonStyle.label } } } ttk::style configure ScopeButtonStyle \ -padding {6 0 6 1} -relief flat -font TkTooltipFont ttk::style map ScopeButtonStyle -foreground { {active !disabled !pressed} white {pressed !disabled !disabled} white {selected !disabled !pressed} white } } } } } proc ::scopebutton::scopebutton {w args} { variable wLocals DefineOrUpdateCustomStyle set w [eval ttk::radiobutton $w $args -style ScopeButtonStyle] return $w } # ------------------------------------------------------------------------- # test code: # ------------------------------------------------------------------------- if 0 { package require tile 0.8 package require scopebutton wm withdraw . set t [toplevel .test] wm geometry $t "400x200" set f [ttk::frame $t.status] pack $f -side top -fill x for {set cnt 0} {$cnt < 5} {incr cnt} { set scb $f.scb1_{$cnt} ::scopebutton::scopebutton $scb \ -text "Test:$cnt" -variable ::v -value $cnt pack $scb -side left -padx 5 } }