obj method canvaseditor buildInfoWindow {} {
variable filename
variable width
variable height
variable background
variable message
#
set canvas [$self private canvas]
set info $canvas.info
if {[winfo exists $canvas.info]} return
toplevel $info
wm title $info Info
wm resizable $info yes no
wm transient $info [winfo toplevel $canvas]
#
set filename($canvas)\
[file tail\
[file rootname\
[dict get [$self private settings] filename]]]
grid\
[label $info.filenameLab -text Filename]\
[entry $info.filename -state readonly\
-textvariable [namespace current]::filename($canvas)]\
-sticky w
grid columnconfigure $info 0 -weight 0
grid columnconfigure $info 1 -weight 1
grid configure $info.filename -sticky ew
set width($canvas) [$canvas cget -width]
grid\
[label $info.widthLab -text Width]\
[entry $info.width\
-textvariable [namespace current]::width($canvas)]\
-sticky w
grid configure $info.width -sticky ew
set height($canvas) [$canvas cget -height]
grid\
[label $info.heightLab -text Height]\
[entry $info.height\
-textvariable [namespace current]::height($canvas)]\
-sticky w
grid configure $info.height -sticky ew
set background($canvas) [$canvas cget -background]
grid\
[label $info.backgroundLab -text Background]\
[entry $info.background\
-textvariable [namespace current]::background($canvas)]\
-sticky w
grid configure $info.background -sticky ew
#
grid\
[label $info.svgLab -text "SVG Viewer"]\
[entry $info.svgTool]\
-sticky w
grid configure $info.svgTool -sticky ew
$info.svgTool insert end [$self setting svgtool]
bind $info.svgTool <Key>\
[subst -nocommand {after idle {$self setting svgtool [%W get]}}]
#
grid\
[label $info.psLab -text "Postscript Viewer"]\
[entry $info.psTool]\
-sticky w
grid configure $info.psTool -sticky ew
$info.psTool insert end [$self setting pstool]
bind $info.psTool <Key>\
[subst -nocommand {after idle {$self setting pstool [%W get]}}]
#
grid [message $info.message -foreground navy\
-textvariable [namespace current]::message($canvas)\
-padx 1 -pady 0 -anchor nw -justify left -anchor nw\
-width [winfo reqwidth $info]] -\
-sticky news
after idle [subst -nocommand {
$info.message configure -width [- [winfo reqwidt $info] 2]
}]
bind $info <Configure> [subst -nocommand {
$info.message configure -width [- [winfo width $info] 2]
}]
#
bind $info.width <Return> [subst -nocommand {
expr [$info.width get]
$self setting width [$info.width get]
$canvas configure -width [* [$self setting width] [$self zoom]]
$canvas configure -scrollregion "0 0\
[int [* [$self setting width] [$self zoom]]]\
[int [* [$self setting height] [$self zoom]]]"
wm geometry . ""
}]
bind $info.height <Return> [subst -nocommand {
expr [$info.height get]
$self setting height [$info.height get]
$canvas configure -height [* [$self setting height] [$self zoom]]
$canvas configure -scrollregion "0 0\
[int [* [$self setting width] [$self zoom]]]\
[int [* [$self setting height] [$self zoom]]]"
wm geometry . ""
}]
bind $info.background <Return> [subst -nocommand {
winfo rgb . [$info.height get]
$self setting background [$info.height get]
$canvas configure -background [$self setting background]
}]
adjustChildGeometry $info
#
# Kontextmenü copy für Meldungszeile
#
bind $info.message <3> "tk_popup [menu $info.copy -tearoff no] %X %Y"
$info.copy add command -label Copy -command [subst -nocommand {
clipboard clear
clipboard append [$info.message cget -text]
}]
$info.copy add cascade -label Specific\
-menu [menu $info.copy.special -tearoff no]
foreach key {
Class coords color linecolor linewidth width height diagonale phi Id
} {
$info.copy.special add command -label [string totitle $key]\
-command [list apply {
{key win} {
set dict [string map {; {}} [$win cget -text]]
clipboard clear
if {
[string is list $dict] &&
[llength $dict] % 2 == 0 &&
[dict exists $dict $key]
} then {
clipboard append [dict get $dict $key]
}
}
} $key $info.message]
}
}
© Wolf-Dieter Busch | Home | Sitemap | Urheber | A-Z