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