Get User Click Coreldraw VBA

Guys Wondering if you can help

I use the following code so that when I click on the drawing screen it places a circle at that point

        Dim sr As ShapeRange, s As Shape
        Dim x#, y#, w#, h#, dOffset#
    Dim doc As Document, retval As Long
    Dim origx As Double, origy As Double, origw As Double, origh As Double
    Dim xxx As Double, yyy As Double, shift As Long
    Dim RH As Double
    Set doc = ActiveDocument
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.ReferencePoint = cdrCenter
    retval = doc.GetUserClick(xxx, yyy, shift, 10, False, cdrCursorWinCross)
    If OptionButton1.value = True Then RH = 2.4 / 2
    If OptionButton2.value = True Then RH = 3.4 / 2
    If OptionButton3.value = True Then RH = 5.4 / 2
    If OptionButton4.value = True Then RH = 4.4 / 2
    Set s = ActiveLayer.CreateEllipse2(xxx, yyy, RH, RH)
    s.Fill.UniformColor.RGBAssign 0, 0, 0
    s.Outline.SetNoOutline
    If OptionButton5.value = True Then MsgBox "single"
    If OptionButton6.value = True Then MsgBox "multiple"

This Works fine but I have to click the button each time I want to put a circle on the screen

Is there a way of having it so that the user click stays active until the user either presses esc or clicks another button?

I want to be able to put multiple circles down without have to click the button to activate.

Many Thanks

Mark

Parents
  • VBA example (from X5 help file)

    The following VBA example retrieves the coordinates of the point where the user clicks and draws a circle at that point. The circle fill depends on the modifier key state. If the Shift is pressed while the user clicked, red is applied. If Ctrl is pressed, green is added. If Alt is pressed, blue is applied. Therefore, pressing Ctrl + Shift + Alt produces a yellow circle. The macro loops until the user presses Esc to abort the procedure or time out interval of ten seconds elapses.

    Sub Test()

    Dim x As Double, y As Double

    Dim Shift As Long

    Dim b As Boolean

    Dim s As Shape

    Dim cr As Long, cg As Long, cb As Long

    b = False

    While Not b

    b = ActiveDocument.GetUserClick(x, y, Shift, 10, False, cdrCursorEyeDrop)

    If Not b Then

       Set s = ActiveLayer.CreateEllipse(x - 0.1, y - 0.1, x + 0.1, y + 0.1)

       cr = 0

       cg = 0

       cb = 0

       If (Shift And 1) <> 0 Then cr = 255 ' Shift depressed - Add Red

       If (Shift And 2) <> 0 Then cg = 255 ' Ctrl depressed - Add Green

       If (Shift And 4) <> 0 Then cb = 255 ' Alt depressed - Add Blue

       s.Fill.UniformColor.RGBAssign cr, cg, cb

    End If

    Wend

    End Sub

Reply Children