obj method canvaseditor select args { if {$args eq ""} then { # Außerhalb Element geklickt -- Selektion aufheben foreach element [my selection] { $element blink off } my selection {} $self blinking off } else { # Selektion mit Mausklick foreach object $args { if {$object ni [my selection]} then { # Element war noch nicht selektiert foreach dot [$object dots] { $dot storeXY } my selection [list {*}[my selection] $object] $object blink on $self blinking on } else { # Element war schon selektiert set index [lsearch [my selection] $object] my selection [lreplace [my selection] $index $index] $object blink off if {[my selection] eq {}} then { $self blinking off } } } } switch -exact -- [llength [my selection]] { 0 { $self statusLine [my defaultmessage] } 1 { lappend message\ "Class [$self selected info class]"\ "Id [namespace tail {*}[my selection]]" switch -exact -- [$self selected info class] { line { lappend message\ "coords [$self selected xy yes]"\ "linewidth [$object cget -width]"\ [list linecolor [$object cget -outline]] } fill { lappend message [list color {*}[$self selected cget -fill]] set colList [lunique [$object lines cget -outline]] if {[llength $colList] == 1} then { lappend message [list linecolor {*}$colList] } set widthList [lunique [$object lines cget -width]] if {[llength $widthList] == 1} then { lappend message "linewidth $widthList" } } group { set group [$self selected] lappend message "elements [llength [$group elements]]" set class [lunique [$group elements info class]] if {[llength $class] == 1} then { lappend message "classes $class" switch -exact -- $class { line { set lineWidth [lunique [$group elements cget -width]] if {[llength $lineWidth] == 1} then { lappend message "linewidth $lineWidth" } set lineColor [lunique [$group elements cget -outline]] if {[llength $lineColor] == 1} then { lappend message "linecolor $lineColor" } } fill { set fillColor [lunique [$group elements cget -fill]] if {[llength $fillColor] == 1} then { lappend message "fillcolor $fillColor" } } } } } } lassign [$object bbox] x0 y0 x1 y1 lappend message\ "width [- $x1 $x0]" "height [- $y1 $y0]"\ "diagonale [hypot [- $x1 $x0] [- $y1 $y0]]"\ "phi [* 180 [/ [atan2 [- $y1 $y0] [- $x1 $x0]] [acos -1]]]" $self statusLine [join $message "; "] } default { lassign [$self bbox] x0 y0 x1 y1 lappend message\ "[llength [my selection]] objects" set classes [lunique [$self selected info class]] if {[llength $classes] == 1} then { lappend message "Class $classes" switch -exact -- $classes { fill { set fills [lunique [$self selected cget -fill]] if {[llength $fills] == 1} then { lappend message [list color {*}$fills] } } line { set outlines [lunique [$self selected cget -outline]] if {[llength $outlines] == 1} then { lappend message [list linecolor {*}$outlines] } set widths [lunique [$self selected cget -width]] if {[llength $widths] == 1} then { lappend message [list linewidth {*}$widths] } } } } lappend message "width [- $x1 $x0]"\ "height [- $y1 $y0]"\ "diagonale [hypot [- $x1 $x0] [- $y1 $y0]]" $self statusLine [join $message "; "] } } }
© Wolf-Dieter Busch | Home | Sitemap | Urheber | A-Z