buildInfoWindow

$canvaseditor buildInfoWindow
builds info window with status line

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