summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog12
-rw-r--r--library/demos/ttkscale.tcl41
-rw-r--r--library/demos/widget4
3 files changed, 52 insertions, 5 deletions
diff --git a/ChangeLog b/ChangeLog
index 89cc0b2..c5b3c75 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,9 +1,13 @@
+2009-12-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/demos/ttkscale.tcl: Added demo of [ttk::scale] widget.
+
2009-12-09 Andreas Kupries <andreask@activestate.com>
- * library/safetk.tcl (::safe::loadTk): [Bug 2902573]: Fixed access
- to the cleanupHook of the safe base. The code used the old
- internal commands which have been removed since 2009-12-09. See
- Tcl's ChangeLog.
+ * library/safetk.tcl (::safe::loadTk): [Bug 2902573]: Fixed access to
+ the cleanupHook of the safe base. The code used the old internal
+ commands which have been removed since 2009-12-09. See Tcl's
+ ChangeLog.
2009-12-09 Donal K. Fellows <dkf@users.sf.net>
diff --git a/library/demos/ttkscale.tcl b/library/demos/ttkscale.tcl
new file mode 100644
index 0000000..473dbdb
--- /dev/null
+++ b/library/demos/ttkscale.tcl
@@ -0,0 +1,41 @@
+# ttkscale.tcl --
+#
+# This demonstration script shows an example with a horizontal scale.
+#
+# RCS: @(#) $Id: ttkscale.tcl,v 1.1.2.1 2009/12/10 11:44:07 dkf Exp $
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+package require Tk
+
+set w .ttkscale
+catch {destroy $w}
+toplevel $w -bg [ttk::style lookup TLabel -background]
+wm title $w "Themed Scale Demonstration"
+wm iconname $w "ttkscale"
+positionWindow $w
+
+pack [ttk::frame [set w $w.contents]] -fill both -expand 1
+
+ttk::label $w.msg -font $font -wraplength 3.5i -justify left -text "A label tied to a horizontal scale is displayed below. If you click or drag mouse button 1 in the scale, you can change the contents of the label; a callback command is used to couple the slider to both the text and the coloring of the label."
+pack $w.msg -side top -padx .5c
+
+## See Code / Dismiss buttons
+set btns [addSeeDismiss $w.buttons [winfo toplevel $w]]
+pack $btns -side bottom -fill x
+
+ttk::frame $w.frame -borderwidth 10
+pack $w.frame -side top -fill x
+
+# List of colors from rainbox; "Indigo" is not a standard color
+set colors {Red Orange Yellow Green Blue Violet}
+ttk::label $w.frame.label
+ttk::scale $w.frame.scale -from 0 -to 5 -command [list apply {{w idx} {
+ set c [lindex $::colors [tcl::mathfunc::int $idx]]
+ $w.frame.label configure -foreground $c -text "Color: $c"
+}} $w]
+# Trigger the setting of the label's text
+$w.frame.scale set 0
+pack $w.frame.label $w.frame.scale
diff --git a/library/demos/widget b/library/demos/widget
index 6974a38..8fefbbd 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -10,7 +10,7 @@ exec wish "$0" "$@"
# separate ".tcl" files is this directory, which are sourced by this script as
# needed.
#
-# RCS: @(#) $Id: widget,v 1.51.2.1 2009/04/10 16:40:12 das Exp $
+# RCS: @(#) $Id: widget,v 1.51.2.2 2009/12/10 11:44:07 dkf Exp $
package require Tcl 8.5
package require Tk 8.5
@@ -365,6 +365,8 @@ addFormattedText {
@@demo hscale Horizontal scale
@@demo vscale Vertical scale
@@new
+ @@demo ttkscale Themed scale linked to a label with traces
+ @@new
@@demo ttkprogress Progress bar
@@subtitle Paned Windows and Notebooks