createRectangle

$canvaseditor createRectangle
interactively draws a rectangle

obj method canvaseditor createRectangle {} {
  set canvas [my canvas]
  lassign [pointerXY] x y
  #
  set x [$self canvasx $x]
  set y [$self canvasy $y]
  #
  set a [new dot -x $x -y $y]
  set b [new dot -x $x -y $y]
  set c [new dot -x $x -y $y]
  set d [new dot -x $x -y $y]
  $self pointerToDot $a
  set topLine [new line $a $b]
  set rightLine [new line $b $c]
  set bottomLine [new line $c $d]
  set leftLine [new line $d $a]
  set rect [new fill $topLine $rightLine $bottomLine $leftLine]
  $self select $rect
  $self initUndoRedo "
    $self select
    $rect draw no
    " "
    $self select
    $rect draw
    "
  $self basicBindings off
  $self statusLine Draw rectangle
  bind $canvas <Motion> [subst -nocommand {
      $b configure -x [$self canvasx %x]
      $c configure -x [$self canvasx %x] -y [$self canvasy %y]
      $d configure -y [$self canvasy %y]
      $rect draw
    }]
  $rect draw
  $canvas configure -cursor sizing
  bind $canvas <<Click>> "
    $self basicBindings
    $self select
    $self select $rect
    $self snapMode off
    "
  $self snapMode on
}

© Wolf-Dieter Busch | Home | Sitemap | Urheber | A-Z