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