Toplevel Watermark edit
- 2nd October 2012 -
SeS Herewith, I would like to share a piece of code to mimick a watermark on any specified toplevel. The input is a base64 string representation of the image,
tG² offers easy drag-drop functionality to create this string of any .png or .gif image.
The presented code is only for the Windows OS, since 'alpha' transparency option in Linux is not supported.
Overquoted Version
# ------------------------------------------------------------------------------
# All scripts presented in this page are under BSD License
# Part of TopTcl_1.tcl, see also http://wiki.tcl.tk/27347
# copyright (C) 2012 by Sedat Serper
#
# Permission is hereby granted, free of charge, to any person obtaining a copy of
# this software and associated documentation files (the ``Software''), to deal in
# the Software without restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the
# Software, and to permit persons to whom the Software is furnished to do so,
# subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
# FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHOR
# BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
# CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
# ------------------------------------------------------------------------------
# ------------------------------------------------------------------------------
# Purpose : creates centred image on any toplevel, with transparency to mimick a watermark
# ------------------------------------------------------------------------------
proc TLWmark {im {w .} {imW 30} {imH 30}} {
if {$w!="."} {set wmrk ${w}.wmrk} {set wmrk .wmrk}
if {![catch {winfo class ${w}wmrk}]} {return} ;# if already called once for this toplevel, exit...
toplevel $wmrk
wm geo $wmrk 1x1+5000+5000
wm attribute $wmrk -alpha 0.1
wm overrideredirect $wmrk 1
wm deiconify $wmrk
#set imW 30 ;# image width in pixels
#set imH 30 ;# image height in pixels
pack [label $wmrk.l -image $im] -expand 1 -fill both ;# this will hold the image
bind $w <FocusIn> "+; raise $wmrk"
bind $w <Configure> "+;
raise $wmrk
set tmp \[split \[split \[wm geo $w] x] +]
set wW \[lindex \$tmp 0 0]
set wH \[lindex \$tmp 0 1]
if {\$wH>2*$imH} {wm geo $wmrk +\[expr \[lindex \$tmp 1]+\$wW/2]+\[expr \[lindex \$tmp 2]+\$wH/2]}
if {(\$wH<2*$imH) || (\$wW<2*$imW)} {wm withdraw $wmrk} {wm deiconify $wmrk}
"
bind $w <FocusOut> "+; if {\[wm state $w]!=\"normal\"} {wm withdraw $wmrk}"
wm geo $wmrk ${imW}x${imH}
# In case of rounded images, one can actually trim the toplevel to it's circular form with DLL calls
# in tG2 there is a wrapper which can perform this, see TopTcl_1.tcl
catch {
source $::dev_folder/procedures/TopTcl_1.tcl ;# to generate this wrapper, see Project Properties
TopTcl $wmrk elliptic ${imW} ${imH} {0 0} 1
wm attribute ${wmrk}copy -alpha 0.01
}
event generate $w <Configure>
}
# ------------------------------------------------------------------------------
# DEMO:
# ALl code developed within Windows Vista, using ActiveTcl v8.4.19, tG² v1.06.01.43
#
image create photo pause_icon -data {
R0lGODlhHgAeAP8AAAUFBgIUmg8QEABVyQBGuAEKmQEqqGt6zAA7sj3E+i2x
93yK1CSn9DxDU9ze4QAjngYGFcHM8t7h4guG6ABn1wM1qgN35CUpKomi4tLS
02yC0zQ5RVd10zpCWYL2/3x+gwgIJAIZopqboTtFZhua8Dl1tUXN+y4zQkVM
WXyH0BCM7mLZ/YyW1lVqwmJ2y7nD1gUOpnKL1I2RmYWQ1UNJV32UxDZVwQRj
ylBmwVptxDtHdVNuynOE0WB70goYs7u7vnZ6goKVzBEZRg0QQIur9Iya2ict
OEtpuUhUg4Sj8F14uC5PtX2AiLLF8rrG8Hh8iBseIdjc7HnQ7XyLwEar7Gtu
ddTa7DtIfhw1gUp+uhUuvxaT7nWLvG18tBUrmRUgorjM+ExalBY8pWLP+EzY
/3X1/1hnnjuk/FfU/B5LpRI2rzVbkg0TjTRIi6zB8yo8rTNIphUYGja794iK
krvL9DCF61VYW01SXt3e3q670khOWg4QPmaG4xBRy05tzKaw4V10zJ6n3klN
VnKK2M7Q1WaA1zQ7SomW2IGL04CV3UJFRdHU2ZGc2liYyRAVckJjxUJmyXOL
yEhoxxwwcIObym7A5V9iaGRpcgsNNhQlbxcmcCwwMmtxejY/Vio0VzlGfDA8
YzdAYoCCinyAhUlTai86YjI1NXN3fT4/QGlqbGlwgKOv1ZCY1pao1J2s1Jag
2qu02qWw1miD2M3Nz21/0L3CzsfKzyNe1CNg1MfK0LC80X6e7a2+7svW6puy
7KTA+oXv/7bJ96G9+dba3qGq3weC3oOZ3snO55at6nWU4HiX4iA/tiBAtiBa
tBxJtR5ruhBYu6CpuTtXukhgoyhHpR0+n0leohQ5sFZ0syFCq6Worj1kx3KH
x1uGxUtnxn2TylRwzMTGyXyMylZtvF5zvlZ6uz1avDV1xGZ5xLy/wi9Zw/7+
/gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAACH5BAEAAOsALAAAAAAeAB4AAAj/ANcJHEiwoMGD
CAk6SCfiw6VLQET8cJAwYQYmNGh06NShYwcUKJhkqEgQzwc9DUYgMdNlypQu
ZpCMaIDiAx6SGVCOCBOkSYSfQHkFCTNT0EiEGe400BEJDJ0/gVixYMHo1R8n
wbjpoHEHYbgNKD5hAENsKqIFKVIsQDTjUCA6GK4YenJQVYMrGJwwSpT2gN+/
PBbMKNIEg44GhApG2xAqhpsiM3gcAIQDR4sWOHLkOBD4kJsYnjgVJGVo2i8M
CzS4yIHOyrEW5sStg9XCBa0FRYRZOyGD4AZQynyldgFIWiyBlLJFEUjOmwsN
MZAlK3VioK0NbYgY09Bjh58lqwQG/xGzfN24Rzt6aEhEpM2GXAKBnIBDZFAh
cJIeLXEl8JsYKwIdYYMk6Q2SBBy8rfOCESC8kYQsHHAAyTbOtCJQJBX0EqA6
kPjBQSG7vAFBFevUcgEEX/DBgQ3MqKHGAzUIpEQALwhETQXXLGMDB3x8AcEm
6yxiCggBwBBAAQGEYEAAXEggATYB5OGAA9WEEEIAWPpQAAgXCKQIBEci+YAB
FTzAhYwP6CKBA2kY8MADYQYAgSIC2QEAGzAUEMIDFSBQQYzrlFOBlMOkgQAC
BoRQAAxsAGCHQKMA4IgPARiAAAGY1iDBOt0g8IIDEjSDKaIB+OAIAKcI9EMc
Q2hhKQEDxO2axToSnDMAJQpCEysBiGqxhwC9CXSBAF70ASsFFFhAQQklUDDB
DVk8k+yufXgBgBEEpQLAELjckOwEKmwxwQQkkLBFMSqoMIEFA9xwyx4AfEDQ
LAIIkEkdFqhAAgMMKODvvwowQMK6dWgCACoGWQKAAFicwa8cCUQsccRy8HsG
FgIA8MNBVWQ8CRVkmGACGiuUvAIaIpNBxSQZi5DQExkLUcIYZXhgMzA2lzFG
CUMsLApJc0ABAABCrNFIJVJIUUkjawgxNBRzkCTQIh9cMDQEIGCCCQgQDH0B
EIlJTZAIgsRRb71GWKKN2GyLHRAAOw==
}
TLWmark pause_iconWith Over-quoting Removed
proc TLWmark {im {tParent .}} {
set ::wmrk(parent) $tParent
set ::wmrk(path) .wmrk
set ::wmrk(imW) 30 ;# image width in pixels
set ::wmrk(imH) 30 ;# image height in pixels
if {![catch {winfo class $::wmrk(path)}]} {return} ;# if already called once for this toplevel, exit...
toplevel $::wmrk(path)
wm geo $::wmrk(path) 1x1+5000+5000
wm attribute $::wmrk(path) -alpha 0.1
wm overrideredirect $::wmrk(path) 1
wm deiconify $::wmrk(path)
pack [label $::wmrk(path).l -image $im] -expand 1 -fill both ;# this will hold the image
bind $::wmrk(parent) <FocusIn> {+; raise $::wmrk(path)}
bind $::wmrk(parent) <Configure> {+;
raise $::wmrk(path)
set tmp [split [split [wm geo $::wmrk(parent)] x] +]
set wW [lindex $tmp 0 0]
set wH [lindex $tmp 0 1]
if {$wH>2*$::wmrk(imH)} {wm geo $::wmrk(path) +[expr [lindex $tmp 1]+$wW/2]+[expr [lindex $tmp 2]+$wH/2]}
if {($wH<2*$::wmrk(imH)) || ($wW<2*$::wmrk(imW))} {wm withdraw $::wmrk(path)} {wm deiconify $::wmrk(path)}
}
bind $::wmrk(parent) <FocusOut> {+; if {[wm state $::wmrk(parent)]!="normal"} {wm withdraw $::wmrk(path)}}
wm geo $::wmrk(path) ${::wmrk(imW)}x${::wmrk(imH)}
# In case of rounded images, one can actually trim the toplevel to it's circular form with DLL calls
# in tG2 there is a wrapper which can perform this, see TopTcl_1.tcl
catch {
source $::dev_folder/procedures/TopTcl_1.tcl ;# to generate this wrapper, see Project Properties
TopTcl $::wmrk(path) elliptic $::wmrk(imW) $::wmrk(imH) {0 0} 1
wm attribute ${::wmrk(path)}copy -alpha 0.01
}
event generate $::wmrk(parent) <Configure>
}See also
Tcl Quoting
