Current Version: 1.0
bll 2018-8-16: This version is much simpler. It does not attempt to match the styling that the various available styles use.
There are 7 different indicator styles. At a later date, I will add in indicator coloring.
If you know of other unicode character pairs that will work as indicators, let me know.
I will be dropping support for the 'checkButtonScaled' version below, and it will be removed from this page at a later date.
Code#!/usr/bin/tclsh # # Copyright 2018 Brad Lanam Walnut Creek, CA # # TODO: Indicator on/off color, font # package require Tk proc scheckbutton { nm args } { scbwidget new $nm {*}$args return $nm } namespace eval ::scbcmd { variable vars proc handler { w args } { $w {*}$args } proc initializeAll { } { variable vars if { [info exists ::scbcmd::initialized] } { return } set ::scbcmd::initialized true set tbg [ttk::style lookup TFrame -background] if { $::tcl_platform(os) eq "Darwin" } { # this isn't going to work... set tbg #ececec } lassign [winfo rgb . $tbg] bg_r bg_g bg_b set bg [format {#%02x%02x%02x} \ [expr {$bg_r / 256}] \ [expr {$bg_g / 256}] \ [expr {$bg_b / 256}]] ttk::style configure Scheckbutton.TFrame \ -background $bg ttk::style configure SCheckbutton.TLabel \ -anchor e \ -width {} \ -background $bg \ -highlightthickness 0 ttk::style configure Indicator.SCheckbutton.TLabel \ -anchor {} } } ::oo::class create ::scbwidget { constructor { nm args } { my variable vars ::scbcmd::initializeAll # set vars(ind.styles) { 1 {chars {\u2610 \u2611} padding {0 0 0 0}} 2 {chars {\u2610 \u2612} padding {0 0 0 0}} 3 {chars {\u25ab \u25aa} padding {0 0 0 3}} 4 {chars {\u25a1 \u25a0} padding {0 0 0 3}} 5 {chars {\u25a1 \u25a3} padding {0 0 0 4}} 6 {chars {\u25fb \u25fc} padding {0 0 0 3}} 7 {chars {\u25fd \u25fe} padding {0 0 0 3}} } set vars(max.style) 7 set vars(char.off) \u2610 set vars(char.on) \u2611 set vars(char.disp) $vars(char.off) set vars(-indicatorstyle) 1 set vars(-onvalue) 1 set vars(-offvalue) 0 set vars(currvalue) 0 set vars(currstate) off set vars(-command) {} set vars(font.basesize) 11 # some defaults set vars(frame.cont) [ttk::frame $nm \ -class Scaled.checkbutton \ -style SCheckbutton.TFrame \ ] set vars(widget) [ttk::label $nm.indicator \ -style Indicator.SCheckbutton.TLabel \ -textvariable [self]::vars(char.disp) \ ] $vars(widget) configure -style 1.Indicator.SCheckbutton.TLabel set vars(label) [ttk::label ${nm}.label \ -style SCheckbutton.TLabel \ ] set vars(scb) ${nm}_scb rename $vars(frame.cont) ::$vars(scb) interp alias {} $vars(frame.cont) {} ::scbcmd::handler [self] uplevel 2 [list $vars(frame.cont) configure {*}$args] set vars(bind.tag) scbbt$vars(widget) bindtags $vars(widget) [concat [bindtags $vars(widget)] $vars(bind.tag)] grid $vars(widget) $vars(label) -in $vars(frame.cont) \ -sticky {} -padx 0 -pady 0 grid configure $vars(label) -sticky e grid configure $vars(label) -ipadx 1p # make sure any binds on the main hull get propagated to the display widget set bt [bindtags $vars(widget)] bindtags $vars(widget) [list $nm {*}$bt] bind $vars(widget) <Destroy> [list [self] destruct] bind $vars(widget) <ButtonRelease-1> [list [self] setvalue] bind $vars(label) <ButtonRelease-1> [list [self] setvalue] my adjustpadding } method adjustpadding { } { my variable vars set style [$vars(label) cget -style] set font [$vars(label) cget -font] if { $font eq {} } { set font TkDefaulFont } dict for {key info} $vars(ind.styles) { set opad [dict get $info padding] set sz [font metrics $font -ascent] set adj [expr {double($sz)/$vars(font.basesize)}] set npad [list] foreach {p} $opad { set np [expr {round(double($p)*$adj)}] lappend npad $np } ttk::style configure $key.Indicator.$style -padding $npad } } method destruct { } { my variable vars interp alias {} $vars(frame.cont) {} [self] destroy } method setvalue { } { my variable vars if { $vars(currstate) } { set vars(currstate) off } else { set vars(currstate) on } set k -variable if { [info exists vars($k)] && [info exists $vars($k)] } { if { $vars(currstate) } { set $vars($k) $vars(-onvalue) } else { set $vars($k) $vars(-offvalue) } } my checkvalue if { $vars(-command) ne {} } { {*}$vars(-command) } } method checkvalue { args } { my variable vars set k -variable if { [info exists vars($k)] && [info exists $vars($k)] } { if { [set $vars($k)] eq $vars(-onvalue) } { set vars(currstate) on } else { set vars(currstate) off } } if { $vars(currstate) } { set vars(char.disp) $vars(char.on); } else { set vars(char.disp) $vars(char.off); } } method starttrace { } { my variable vars set k -variable if { [info exists vars($k)] && [info exists $vars($k)] } { trace add variable $vars($k) write [list [self] checkvalue] } } method unknown { args } { my variable vars set nm $vars(label) return [uplevel 2 [list $nm {*}$args]] } method cget { key } { my variable vars set rv {} if { $key eq "-variable" || $key eq "-command" || $key eq "-onvalue" || $key eq "-offvalue" } { set rv $vars($key) } else { set rv [$vars(label) cget $key] } return $rv } method configure { args } { my variable vars foreach {key val} $args { if { $key eq "-indicatorstyle" } { if { ! [string is entier $val] || $val < 1 || $val > $vars(max.style) } { return } set vars(-indicatorstyle) $val lassign [dict get $vars(ind.styles) $val chars] \ vars(char.off) vars(char.on) set style [$vars(label) cget -style] $vars(widget) configure -style $val.Indicator.$style my checkvalue my adjustpadding } elseif { $key eq "-onvalue" || $key eq "-offvalue" } { set vars($key) $val my checkvalue } elseif { $key eq "-command" } { set vars($key) $val } elseif { $key eq "-variable" } { set fqv {} if { [string match {::*} $val] } { set fqv $val } if { $fqv eq {} } { set fqv [uplevel 2 [list namespace which -variable $val]] if { $fqv eq {} } { set ns [uplevel 2 [list namespace current]] set fqv $ns$val if { [string match ::::* $fqv] } { set fqv [string range $fqv 2 end] } } } set vars($key) $fqv if { ! [info exists $vars($key)] } { set $vars($key) {} } my starttrace my checkvalue } elseif { $key eq "-style" } { $vars(label) configure -style $val my adjustpadding $vars(widget) configure -style $vars(-indicatorstyle).Indicator.$val } else { uplevel 2 [list $vars(label) configure $key $val] } } return -code ok } } package provide scheckbutton 1.0
package require Tk source code/scheckbutton.tcl proc p { x } { puts "cmd: $x" } font create eee font configure eee -size 28 set ::x 0 set ::y 1 foreach {st} [list 1 2 3 4 5 6 7] { scheckbutton .sa$st -variable ::x -text AAAA \ -indicatorstyle $st -command [list p e] scheckbutton .sb$st -variable ::y -text BBBB \ -indicatorstyle $st -command [list p f] grid .sa$st .sb$st } set st 2 ttk::style configure B.SCheckbutton.TLabel -font eee scheckbutton .s1z -variable ::z -text EE\ -indicatorstyle $st -command [list p e] -style B.SCheckbutton.TLabel scheckbutton .s2z -variable ::z2 -text FF \ -indicatorstyle $st -command [list p f] -style B.SCheckbutton.TLabel set ::z 0 set ::z2 1 grid .s1z .s2z
Current Version: 1.22
bll 2016-05-10: The standard ttk::checkbutton does not scale well for 4K displays. This code is a pure tcl implementation of checkbuttons with no graphics. It includes styling for all 30 themes. I have attempted to match each theme's styling reasonably well. The package will change themes on a <<ThemeChanged>> event.
Place the package require in your code after tk scaling has been set.
Download from:
https://gentoo.com/tcl/checkButtonScaled.tcl%|%https://gentoo.com/tcl/checkButtonScaled.tcl%|%
Version 1.22 2018-7-29
Version 1.21 2018-4-23
Version 1.20 2018-1-22
Version 1.19 2018-1-6
Version 1.18 2017-9-14
Version 1.17 2017-8-19
Version 1.16 2016-8-16
Version 1.14 2016-7-4
Version 1.13 2016-7-2
Version 1.12 2016-6-14
Version 1.11 2016-6-9
Version 1.10 2016-6-3
Version 1.9 2016-5-16
Version 1.8 2016-5-15
Version 1.7 2016-5-11
Version 1.6 2016-5-10
dbohdan 2016-05-12: The fact that you have a styling for each of the 22 themes is impressive.
Could you put a high-DPI screenshot of the widget on this page?
bll 2016-5-12: Well, I actually don't have a 4K screen to test with. But I can set a windows VM to 3840x2160 video mode. Which I can then view in VirtualBox's scaled mode (it's quite horrible). The image below was made with Window's snipping tool inside the VM with tk scaling set to 2.67 (192 dpi). Windows mentioned 192 dpi when I set the custom text size to 200%, so I used that number. On the left is a standard ttk::checkbutton, on the right is the scaled checkbutton.
dbohdan 2016-05-13: Looks good! I've moved the screenshot higher on the page.