AnnMouseDown example for Visual Basic

Note: This topic is for Document/Medical only.

Private Sub LEAD1_AnnMouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
   x0 = x
   y0 = y
   Select Case LEAD1.AnnTool
   Case ANNTOOL_USER_FIRST
      ' create the objects
      LEAD1.AnnSetSelected LEAD1.AnnContainer, False, True
      'Add an undo node to undo the creation of these objects.
      LEAD1.AnnAddUndoNode
      hRectObject = LEAD1.AnnCreate(ANNOBJECT_RECT, True, True)
      hEllipseObject = LEAD1.AnnCreate(ANNOBJECT_ELLIPSE, True, True)
      ' set the automation defaults to the objects newly created
      LEAD1.AnnSetAutoDefaults hRectObject, 0
      LEAD1.AnnSetAutoDefaults hEllipseObject, 0
      ' start defining them from the x, y coordinate
      LEAD1.AnnDefine hRectObject, x, y, ANNDEFINE_BEGINSET
      LEAD1.AnnDefine hEllipseObject, x, y, ANNDEFINE_BEGINSET
   End Select
End Sub

Private Sub LEAD1_AnnMouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
   If Button = 1 Then
      Select Case LEAD1.AnnTool
      Case ANNTOOL_USER_FIRST
         ' update the objects from the x, y coordinate
         LEAD1.AnnDefine hRectObject, x, y, ANNDEFINE_UPDATE
         LEAD1.AnnDefine hEllipseObject, x, y, ANNDEFINE_UPDATE
      Case ANNTOOL_RECT
         AdjustMousePos Shift, x, y
      End Select
   End If
End Sub

Private Sub LEAD1_AnnMouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
   Select Case LEAD1.AnnTool
   Case ANNTOOL_USER_FIRST
      LEAD1.AnnDefine hRectObject, x, y, ANNDEFINE_END
      LEAD1.AnnDefine hEllipseObject, x, y, ANNDEFINE_END
      LEAD1.AnnSetSelected hRectObject, True, False
      LEAD1.AnnSetSelected hEllipseObject, True, False
      LEAD1.AnnGroup LEAD1.AnnContainer, ANNFLAG_RECURSE + ANNFLAG_SELECTED, ""
      hEllipseObject = 0
      hRectObject = 0
   Case ANNTOOL_RECT
      AdjustMousePos Shift, x, y
   End Select
End Sub

Private Sub AdjustMousePos(ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
   If Shift = 1 Then
      ' if shift key is down, force the creation of squares
      dx = Abs(x - x0)
      dy = Abs(y - y0)
      If (dx > dy) Then
         ' adjust y to be as far from y0 as x is from x0
         If y > y0 Then y = y0 + dx Else y = y0 - dx
      Else
         ' adjust x to be as far from x0 as y is from y0
         If x > x0 Then x = x0 + dy Else x = x0 - dy
      End If
      ' set the mouse cursor and update its position
      LEAD1.SetMousePos x, y, False
   End If
End Sub