refreshing / redrawing /updating the screen

I am trying to write a macro that will draw a green circle at the mouse position, then follow the mouse as it moves. The macro stops when the ESC button is pressed and the circle is dropped on the page wherever the mouse ended up. I have it working except for I can't see the green circle until I hit ESC, only the selection box . I want to be able to see the circle the entire time. Redraw or refresh doesn't seem to fix this. Any suggestions?

Public Type lpPoint
    x As Long
    y As Long
End Type

Public BC As Double, AC As Double, AB As Double

Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public Declare Function GetCursorPos Lib "user32" (ByRef pos As lpPoint) As Boolean

Public Sub boostStart(Optional ByVal unDo$ = "")
   'Optimization = True
   EventsEnabled = False
   ActiveDocument.SaveSettings
   'ActiveDocument.PreserveSelection = False
   End Sub

Public Sub boostFinish()
   'ActiveDocument.PreserveSelection = True
   ActiveDocument.RestoreSettings
   EventsEnabled = True
   'Optimization = False
   Application.CorelScript.RedrawScreen
   End Sub

Sub DrawGuideHorizontal()
    
Dim p As lpPoint, x As Double, y As Double, l As Layer, sh As Shape, curX As Double, curY As Double, start

   boostStart
   
    GetCursorPos p
    ActiveDocument.ActiveWindow.ScreenToDocument p.x, p.y, x, y
    Set sh = ActiveLayer.CreateEllipse2(x, y, 0.2)

    
    sh.Fill.UniformColor.RGBAssign 0, 255, 0
     Application.CorelScript.RedrawScreen
     
        Do While GetAsyncKeyState(vbKeyEscape) = 0
     
            GetCursorPos p
            ActiveDocument.ActiveWindow.ScreenToDocument p.x, p.y, x, y
            sh.GetPosition curX, curY
        
                If curX <> x Or curY <> y Then
            
                    sh.SetPosition x - 0.2, y + 0.2
                    Application.CorelScript.RedrawScreen
                    Application.Windows.Refresh
                End If
  
        Loop
    
boostFinish
        
    End Sub

[wOxxOm]

:-) your macro is fun! but you need to add DoEvents in the loop

        Do While GetAsyncKeyState(vbKeyEscape) = 0
     
            DoEvents

            GetCursorPos p
            ActiveDocument.ActiveWindow.ScreenToDocument p.x, p.y, x, y
            sh.GetPosition curX, curY

I appreciate you help. Its funny how one can miss such a simple but vital "doEvents" function. Duh!!!!!

Originally Posted by Rick Randall

I am trying to write a macro that will draw a green circle at the mouse position, then follow the mouse as it moves.

one built-in way without macro... make circle, press and hold space bar and drag circle around screen. ;-)

[runflacruiser]

Really Cool!

Won't it work better if you take out both:

Application.CorelScript.RedrawScreen

What is the

Start

for?

-John

[wOxxOm]

Originally Posted by Jeff Harrison

one built-in way without macro... make circle, press and hold space bar and drag circle around screen. ;-)

that would make multiple copies of the circle. But if one wants to just move the circle WHILE still drawing it then just hold right mouse button (and move the circle) without releasing left mouse button. Yet it will have default graphic style (empty + black outline e.g.)

Originally Posted by wOxxOm

that would make multiple copies of the circle. But if one wants to just move the circle WHILE still drawing it then just hold right mouse button (and move the circle) without releasing left mouse button. Yet it will have default graphic style (empty + black outline e.g.)

thanks Os,

I'd thought this guy wanted multi-circles... but maybe not.