Hourglass pointer

hi,

I have a routine that makes a wblock. It takes a while for the whole process to finish so for the user it looks like nothing is happening. I would like to change the mousepointer into an hourglass. I have tried using a form but the wblock command will not continue until the form is closed. So no help there.

Is there any other advice on this?

thanks in advance,

Emmanuel

 

I'm not too sure about vba, but in vb there is a variable for forms called mousepointer and you would call it like this

Form1.MousePointer = 11
Where Form1 is the name of your form and 11 = The Hourglass pointer
Just right click on your form and scroll down until you see mouse pointer, and it lists all the pointers you can change your mouse to

 

thanks for the reply.

and indeed, the same is true for vba, but as i wrote, the wblock command will not continue until i have closed the form, so i can't use that option.

 

If it's available in vba try reading up on the DOEVENTS() command. This might help

 

switch your form so it is modeless...

will not continue until i have closed the form, so i can't use that option.

 

Create a class module and throw in this code:

Option Explicit
'+--Note: This is a class module that can be used inside a Sub,
'Function or a Property. It's instance will be terminated upon
'exiting the routine that it was delared in.
Private Declare Function CopyIcon Lib "user32" (ByVal hIcon As Long) As
Long
Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long,
_
ByVal id As Long) As Long
Private Declare Function GetCursor Lib "user32" () As Long
'
Private Const OCR_NORMAL As Long = 32512
Private currenthcurs As Long
Private tempcurs As Long
Private newhcurs As Long

Private Declare Function GetWindowsDirectory Lib "kernel32" _
Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
Private Declare Function LoadCursorFromFile Lib "user32" _
Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As
Long

Private Sub Class_Initialize()
'## Show the Hourglass
Dim sDir As String
Dim lDir As Long
sDir = Space(255)
currenthcurs = GetCursor()
tempcurs = CopyIcon(currenthcurs)
lDir = GetWindowsDirectory(sDir, 255)
sDir = Left$(sDir, lDir) & "\cursors\hourglas.ani"
newhcurs = LoadCursorFromFile(sDir)
Call SetSystemCursor(newhcurs, OCR_NORMAL)
Debug.Print "MousePointer::Hourglass"
End Sub

Private Sub Class_Terminate()
'## Show previous pointer
Call SetSystemCursor(tempcurs, OCR_NORMAL)
Debug.Print "MousePointer::Reset"
End Sub


-- Mike
___________________________
Mike Tuersley
CADalyst's CAD Clinic
Rand IMAGINiT Technologies
___________________________
the trick is to realize that there is no spoon...