Ter que escrever código para voltar o cursor para o normal após tê-lo mudado para ampulheta é uma preocupação comum no trabalho de programação que pode ser eliminada com o uso de uma classe muito simples: a classe CHourGlass, que tem seu código exposto logo abaixo. Sobre a transformação do cursor para o modo ampulheta, é sempre bom lembrar que isto não desabilita o mouse, ou seja, o usuário pode continuar a clicar e produzir eventos de mouse mesmo com o cursor estando no modo de ampulheta. Estes eventos serão disparados assim que o processamento atual chegar ao seu final. A classe CHourGlass resolve este problema eliminando todas as mensagens de mouse e teclado que estejam na fila da sua aplicação antes de voltar o cursor para o normal.
Para usar a classe CHourGlass, crie um módulo de classe e adicione a ele o código abaixo:
'*********************************************
' Classe CHourGlass
' Autor : Danilo A. Mendes
' Visite o site : http://www.codelines.com
' Uso: automatiza a restauração do ponteiro
' do mouse ao normal após tê-lo mudado
' para ampulheta e elimina todas as
' mensagens de mouse e teclado que
' tenham sido geradas por ação do usuário
' enquanto o processamento demorado
' estava sendo feito.
'*********************************************
' Como usar:
'
' Basta declarar uma variável do tipo
' CHourGlass e instanciar nela um objeto
' desta classe para que o cursor da tela
' seja mudado para ampulheta.
'
' Exemplo:
'
' Dim HourGlass as CHourGlass
' Set HourGlass = New CHourGlass
' E é só o que você precisa fazer
'
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Const PM_REMOVE = &H1
Private Const WM_MOUSELAST = &H209
Private Const WM_MOUSEFIRST = &H200
Private Const WM_KEYFIRST = &H100
Private Const WM_KEYLAST = &H108
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" ( _
lpMsg As msg, _
ByVal hwnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
Private Sub Class_Initialize()
Screen.MousePointer = vbHourglass
End Sub
Private Sub Class_Terminate()
'remove todas as mensagens de mouse
'e teclado que tenham sido produzidas
'durante o processamento e estejam
'enfileiradas
Dim pMSG As MSG
Do While PeekMessage(pMSG, 0&, WM_KEYFIRST, _
WM_KEYLAST, _
PM_REMOVE)
Loop
Do While PeekMessage(pMSG, 0&, _
WM_MOUSEFIRST, _
WM_MOUSELAST, _
PM_REMOVE)
Loop
Screen.MousePointer = vbDefault
End Sub
Observe que a idéia de usar o evento Terminate de uma classe, conforme fizemos aqui, pode ser aplicada a uma variedade de outras situações em que você precisa ter a certeza de que algo será feito na saída de um procedimento. Por exemplo, a volta de uma variável a um estado alterado provisoriamente.