Documented the variable tk::scalingPct; improvements in the Widget Demonstration application.

4 files changed, 91 insertions, 31 deletions

diff --git a/library/demos/image2.tcl b/library/demos/image2.tcl
index 34c94a4..9691b87 100644
--- a/library/demos/image2.tcl
+++ b/library/demos/image2.tcl
@@ -55,8 +55,14 @@ proc loadImage {w x y} {
     global dirName
 
     set file [file join $dirName [$w.f.list get @$x,$y]]
+    set opts [list -file $file]
+    if {[string tolower [file extension $file]] eq ".svg"} {
+	lappend opts -format $tk::svgFmt
+    } else {
+	lappend opts -format {}
+    }
     if {[catch {
-	image2a configure -file $file
+	image2a configure {*}$opts
     }]} then {
 	# Mark the file as not loadable
 	$w.f.list itemconfigure @$x,$y -bg \#c00000 -selectbackground \#ff0000
diff --git a/library/demos/print.tcl b/library/demos/print.tcl
index ebe6553..00ccd2a 100644
--- a/library/demos/print.tcl
+++ b/library/demos/print.tcl
@@ -13,24 +13,66 @@ toplevel $w
 wm title $w "Printing Demonstration"
 positionWindow $w
 
-image create photo logo -data {R0lGODlhMABLAPUAAP//////zP//mf//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz//8zM/8zMzMyZzMyZmcyZZsyZAMxmZsxmM8xmAMwzM8wzAJnMzJmZzJmZmZlmmZlmZplmM5kzZpkzM5kzAGaZzGZmzGZmmWYzZmYzMzNmzDNmmTMzmTMzZgAzmQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH+BSAtZGwtACH5BAEKAAIALAAAAAAwAEsAAAb+QIFwSCwahY9HRMI8Op/JJVNSqVqv2OvjyRU8slbIJGwYg60S5ZR6jRi/4ITBOhkYIOd8dltEnAdmFQMJeoVXCEd/VnKGjRVOZ3NVgHlsjpBxVRCEYBIEAAARl4lgZmVgEQAKFx8Mo0ZnpqgAFyi2JqKGmGebWRIAILbCIo27cYFWASTCtievRXqSVwQfzLYeeYESxlnSVRIW1igjWHJmjBXbpKXeFQTizlh1eJNVHbYf0LGc39XW2PIoVZE0whasWPSqFBBHrkKEA3QG0DFTEMXBUsjCWesg4oMFAGwgtKsiwqA+jGiCiRPGAM6pLCVLGKHQ6EGJlc0IuDxzAgX+CCOW9DjAaUsEyAoT+GHpeSRoHgxEUWgAUEUpFhMWgTbKEPUBAU15TBZxekYD0RMEqCDLIpYIWTAcmGEd9rWQBxQyjeQqdK/ZTWEO3mK5l+9No75SrcHhm9WwnlzNoA5zdM+JHz0HCPQdUauZowoFnSw+c2CBvw6dUXT4LMKE6EIHUqMexgCiIREknOwl7Q+FhNQoLuzOc6Kw3kIIVOLqjYKBYCwinmgo9CBEswfMAziK7mRDoQhcUZxwoBKFibq3n3jXI0GyCPLC0DrS8GR1oaEoRBRYVhT99/qG4DcCA/yNU4Ajbjhhnx4P2DJggR3YZog6RyyYxwM9PSgMBaP+sQdgIRL0JAKBwnTooRMAFWLdiPyJ8JwvTnyQoh5midCASh149ZkTIFAmHnzOZOBfIU6U4Mhd4zF34DNEoDAhARGY50BvJkioyxFOGkKAShGkFsJwejiR5Xf8aZAaBp89coQJjuDXAQOApekEm45ANaAtIbyYxREf0OlICCK841uaahZBQjyfjXCACYjuaASjhFagRKSFNtloHg+hYWIxRohnBQWCSSAhBVZ+hkgRnlbxwJIVgIqGlaU6wkeTxHxjm6gVLImrFbHWVEQ1taZjWxJX7KqqnqgUEUxDwtqajrOaRkqhEDcxWwECbEjxTYe9gojqOJQ6JO231ob72bSqAjh4RgfsjiDCCfDCK8K8I9TL7r33nvGtCO7CO1dUAONk3LcBFxzwwEMwZ/DC4iAsRIE+CWNCbzeV8FfEtoDwVwnlacxMkcKQYIE/F5TQ2QcedUZCagyc3NsFGrXVZMipWVBCzKv4Q0JvCviDsjAwf4ylxBeX0KcwGs81ccgqGS3MBxc3RjDDVAvdBRcfeFy1MFd3bcQHJEQdlddkP5E1Cf9yXfbaV2d9RBAAOw==
-}
+pack [label $w.l -text "This demonstration showcases
+the tk print command. Clicking the buttons below
+prints the data from the canvas and text widgets
+using platform-native dialogs."] -side top
 
+## See Code / Dismiss buttons
+pack [addSeeDismiss $w.buttons $w] -side bottom -fill x
 
-pack [label $w.l -text "This demonstration showcases
-        the tk print command. Clicking the buttons below
-        print the data from the canvas and text widgets
-        using platform-native dialogs."] -side top
+frame $w.m
 
-pack [frame $w.m] -fill both -expand yes -side top
+image create photo logo -data {
+R0lGODlhMABLAPUAAP//////zP//mf//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz//8zM/8zMzMyZzMyZ
+mcyZZsyZAMxmZsxmM8xmAMwzM8wzAJnMzJmZzJmZmZlmmZlmZplmM5kzZpkzM5kzAGaZzGZmzGZm
+mWYzZmYzMzNmzDNmmTMzmTMzZgAzmQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH+BSAtZGwtACH5BAEKAAIALAAAAAAw
+AEsAAAb+QIFwSCwahY9HRMI8Op/JJVNSqVqv2OvjyRU8slbIJGwYg60S5ZR6jRi/4ITBOhkYIOd8
+dltEnAdmFQMJeoVXCEd/VnKGjRVOZ3NVgHlsjpBxVRCEYBIEAAARl4lgZmVgEQAKFx8Mo0ZnpqgA
+Fyi2JqKGmGebWRIAILbCIo27cYFWASTCtievRXqSVwQfzLYeeYESxlnSVRIW1igjWHJmjBXbpKXe
+FQTizlh1eJNVHbYf0LGc39XW2PIoVZE0whasWPSqFBBHrkKEA3QG0DFTEMXBUsjCWesg4oMFAGwg
+tKsiwqA+jGiCiRPGAM6pLCVLGKHQ6EGJlc0IuDxzAgX+CCOW9DjAaUsEyAoT+GHpeSRoHgxEUWgA
+UEUpFhMWgTbKEPUBAU15TBZxekYD0RMEqCDLIpYIWTAcmGEd9rWQBxQyjeQqdK/ZTWEO3mK5l+9N
+o75SrcHhm9WwnlzNoA5zdM+JHz0HCPQdUauZowoFnSw+c2CBvw6dUXT4LMKE6EIHUqMexgCiIREk
+nOwl7Q+FhNQoLuzOc6Kw3kIIVOLqjYKBYCwinmgo9CBEswfMAziK7mRDoQhcUZxwoBKFibq3n3jX
+I0GyCPLC0DrS8GR1oaEoRBRYVhT99/qG4DcCA/yNU4Ajbjhhnx4P2DJggR3YZog6RyyYxwM9PSgM
+BaP+sQdgIRL0JAKBwnTooRMAFWLdiPyJ8JwvTnyQoh5midCASh149ZkTIFAmHnzOZOBfIU6U4Mhd
+4zF34DNEoDAhARGY50BvJkioyxFOGkKAShGkFsJwejiR5Xf8aZAaBp89coQJjuDXAQOApekEm45A
+NaAtIbyYxREf0OlICCK841uaahZBQjyfjXCACYjuaASjhFagRKSFNtloHg+hYWIxRohnBQWCSSAh
+BVZ+hkgRnlbxwJIVgIqGlaU6wkeTxHxjm6gVLImrFbHWVEQ1taZjWxJX7KqqnqgUEUxDwtqajrOa
+RkqhEDcxWwECbEjxTYe9gojqOJQ6JO231ob72bSqAjh4RgfsjiDCCfDCK8K8I9TL7r33nvGtCO7C
+O1dUAONk3LcBFxzwwEMwZ/DC4iAsRIE+CWNCbzeV8FfEtoDwVwnlacxMkcKQYIE/F5TQ2QcedUZC
+agyc3NsFGrXVZMipWVBCzKv4Q0JvCviDsjAwf4ylxBeX0KcwGs81ccgqGS3MBxc3RjDDVAvdBRcf
+eFy1MFd3bcQHJEQdlddkP5E1Cf9yXfbaV2d9RBAAOw==
+}
+
+#
+# Create a copy of the image just created, magnified according
+# to the display's DPI scaling level.  Note that the copy will
+# only be effectively magnified if $tk::scalingPct >= 200.
+#
+image create photo logo2
+logo2 copy logo -zoom [expr {$tk::scalingPct / 100}]
 
 set c [canvas $w.m.c -bg white]
-pack $c -fill both -expand no -side left
+pack $c -fill both -expand yes -fill both -side left
 
-$c create rectangle 30 10 200 50 -fill blue -outline black
-$c create oval 30 60 200 110 -fill green
-$c create image 130 150 -image logo
-$c create text 150 250   -anchor n -font {Helvetica 12}  \
+#
+# For scaling-awareness specify the coordinates of the canvas items in points
+# rather than pixels.  Create the items with a left and top padding of 15 pt.
+#
+$c create rectangle 15p 15p 165p 60p -fill blue -outline black	;# 150p x 45p
+$c create oval 15p 75p 165p 120p -fill green			;# 150p x 45p
+set imgId [$c create image 90p 135p -image logo2 -anchor n]
+ 
+#
+# Compute the scaled y coordinate of the next canvas item's top edge in pixels
+#
+lassign [$c bbox $imgId] x1 y1 x2 y2		;# x1, y1, x2, y2 are in pixels
+incr y2 [expr {int(15 * [tk scaling])}]		;# convert 15 pt to pixels
+
+$c create text 15p $y2 -anchor nw -font {Helvetica 12} \
 	-text "A short demo of simple canvas elements."
 
 set txt {
@@ -40,14 +82,15 @@ Tcl is fit for both the smallest and largest programming tasks, obviating the ne
 }
 
 set t [text $w.m.t -wrap word]
-pack $t -side right -fill both -expand no
+pack $t -side right -expand yes -fill both
 $t insert end $txt
 
-pack [frame $w.f] -side top -fill both -expand no
-pack [button $w.f.b -text "Print Canvas" -command [list tk print $w.m.c]]  -expand no
-pack [button $w.f.x -text "Print Text" -command [list tk print $w.m.t]]   -expand no
-
-## See Code / Dismiss buttons
-pack [addSeeDismiss $w.buttons $w] -side bottom -fill x
+frame $w.f
 
+pack [button $w.f.c -text "Print Canvas" -command [list tk print $w.m.c]] \
+	-side left -anchor w -padx 4
+pack [button $w.f.t -text "Print Text" -command [list tk print $w.m.t]] \
+	-side right -anchor e -padx 4
 
+pack $w.f -side bottom -fill x
+pack $w.m -expand yes -fill both -side top
diff --git a/library/demos/systray.tcl b/library/demos/systray.tcl
index 05315bb..9ca9745 100644
--- a/library/demos/systray.tcl
+++ b/library/demos/systray.tcl
@@ -13,6 +13,9 @@ toplevel $w
 wm title $w "System Tray Demonstration"
 positionWindow $w
 
+## See Code / Dismiss buttons
+pack [addSeeDismiss $w.buttons $w] -side bottom -fill x
+
 catch {tk systray destroy}
 set trayIconExists false
 
@@ -37,7 +40,7 @@ button $w.f.b2 -text "Destroy" -command remove
 pack $w.f.b0 $w.f.b1 $w.f.b2 -padx 5 -pady 3 -side left -expand true -fill x
 
 button $w.b3 -text "Display Notification" -command notify
-pack $w.f $w.b3 -expand true -fill x -padx 5 -pady 5
+pack $w.f $w.b3 -fill x -padx 4 -pady 4
 
 proc create {} {
     global trayIconExists
@@ -84,6 +87,3 @@ proc remove {} {
 }
 
 create
-
-## See Code / Dismiss buttons
-pack [addSeeDismiss $w.buttons $w] -side bottom -fill x
diff --git a/library/demos/windowicons.tcl b/library/demos/windowicons.tcl
index f89d252..25c8308 100644
--- a/library/demos/windowicons.tcl
+++ b/library/demos/windowicons.tcl
@@ -13,6 +13,9 @@ toplevel $w
 wm title $w "Window Icon Demonstration"
 positionWindow $w
 
+## See Code / Dismiss buttons
+pack [addSeeDismiss $w.buttons $w] -side bottom -fill x
+
 image create photo icon -data {
     iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGP
     C/xhBQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3Cc
@@ -89,11 +92,19 @@ image create photo icon -data {
 
 set ::tk::icons::base_icon(.) icon
 
-pack [button $w.i -text "Set Window Icon to Globe" -image $::tk::icons::base_icon(.) \
-        -compound top -command {wm iconphoto . $::tk::icons::base_icon(.) }]
-pack [button $w.b -text "Set Badge to 3" -command {wm iconbadge . 3}]
-pack [button $w.e -text "Set Badge to 11" -command {wm iconbadge . 11}]
-pack [button $w.f -text "Reset Badge" -command {wm iconbadge . ""}]
+#
+# Create a copy of the image just created, magnified according
+# to the display's DPI scaling level.  Note that the copy will
+# only be effectively magnified if $tk::scalingPct >= 200.
+#
+image create photo icon2
+icon2 copy icon -zoom [expr {$tk::scalingPct / 100}]
 
-## See Code / Dismiss buttons
-pack [addSeeDismiss $w.buttons $w] -side bottom -fill x
+pack [button $w.i -text "Set Window Icon to Globe" -image icon2 \
+        -compound top -command {wm iconphoto . icon}] -fill x -padx 4
+pack [button $w.b -text "Set Badge to 3" -command {wm iconbadge . 3}] \
+	-fill x -padx 4
+pack [button $w.e -text "Set Badge to 11" -command {wm iconbadge . 11}] \
+	-fill x -padx 4
+pack [button $w.f -text "Reset Badge" -command {wm iconbadge . ""}] \
+	-fill x -padx 4