PDA

View Full Version : تغییر کرسر موس؟



majid325
جمعه 26 مرداد 1386, 10:39 صبح
با سلام :
دوستان میخواستم کرسر موس رو در مثلا رویداد MouseMove یه Abject ( حالا هر چی ) تغییر بدم ! اما هیچ Properti برای این کار ندیدم . از طریق کد یا هر جوری دیگه که میشه .(همین...)
با تشکر

مهدی قربانی
جمعه 26 مرداد 1386, 15:08 عصر
سلام
آقا مجید با این روش فکر کنم جواب بگیرید :

در رویداد Mouse Move شیئ مورد نظر اینطوری بنویسید :


Private Sub Text0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Screen.MousePointer = 9
End Sub

و برای اینکه وقتی ponter رو از روی شیئ به سطح فرم برمیگردونید به حالت اول برگرده :


Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Screen.MousePointer = 1
End Sub

ضمناً مقادیر قابل استفاده برای MousePointer
0 ---> (Default) The shape is determined by Microsoft Access
1 ----> Normal Select (Arrow)
3 ----> Text Select (I-Beam)
7 ----> Vertical Resize (Size N, S)
9 ----> Horizontal Resize (Size E, W)
11 ----> Busy (Hourglass

majid325
شنبه 27 مرداد 1386, 01:34 صبح
آقا مهدی با تشکر از وقتی که گزاشتید، یه چیزای خودم پیدا کردم که میزارم اینجا شاید به درد بعضی از دوستان بخوره!
این کد رو تو یه ماژول کپی کنید.

'---------------------------------------------------------
' fMousePointer
'
' C?digo escrito originalmente por Juan M Af?n de Ribera.
' Est?s autorizado a utilizarlo dentro de una aplicaci?n
' siempre que esta nota de autor permanezca inalterada.
' En el caso de querer publicarlo en una p?gina Web,
' por favor, contactar con el autor en
'
' accessvba@ya.com
'
' Este c?digo se brinda por cortes?a de
' Juan M. Af?n de Ribera
'
'---------------------------------------------------------

' funci?n que devuelve el n?mero de milisegundos desde
' que se inici? el sistema
Private Declare Function GetTickCount Lib "kernel32" () As Long

' funci?n que crea un Timer de sistema
Private Declare Function SetTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

' funci?n que destruye un timer de sistema
Private Declare Function KillTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long

' funci?n que captura el rat?n y teclado para una ventana
Private Declare Function SetCapture Lib "user32" _
(ByVal hWnd As Long) As Long

' funci?n que libera el rat?n de la captura de una ventana
Private Declare Function ReleaseCapture Lib "user32" () As Long

' funci?n que carga un cursor o icono desde un archivo
Private Declare Function LoadCursorFromFile Lib "user32" _
Alias "LoadCursorFromFileA" _
(ByVal lpFileName As String) As Long

' funci?n que devuelve el handle del cursor actual
Private Declare Function GetCursor Lib "user32" () As Long

' funci?n que establece un cursor
Private Declare Function SetCursor Lib "user32" _
(ByVal hCursor As Long) As Long

' funci?n que destruye un cursor
Private Declare Function DestroyCursor Lib "user32" _
(ByVal hCursor As Long) As Long

' la funci?n GetTickCount nunca devolver? una
' cifra mayor que ésta (49.7 d?as)
Private Const TIMELIMIT = 4294080000#
' variables privadas
Private hOldCursor As Long
Private hCursor As Long
' variable que guardar? el tiempo de espera
Private Pause As Double
' variable que guarda el handle de la ventana
' asociada al cursor
Private hWnd As Long

' funci?n que carga un cursor personalizado en el puntero
' del rat?n
Function fMousePointer(FileName As String, Optional Wait As Long)
Static OldFileName As String

' si el nombre de archivo ya existe
If FileName = OldFileName Then
' y existe un cursor personalizado
If hCursor Then
' el puntero ya est? en uso,
' as? que no hacemos nada
Exit Function
End If
' si el tiempo de espera no es v?lido
ElseIf Wait < -1 Then
Exit Function
End If

' si wait vale algo, se ha solicitado un puntero
' con un tiempo de espera
If Wait <> 0 Then
' obtenemos el handle de la ventana de Access
hWnd = Access.hWndAccessApp
' si hay un tiempo de espera determinado
If Wait > 0 Then
' establecemos el tiempo de espera
Pause = GetTickCount + (Wait * 1000)
Else
' si no, querr? decir que Wait = -1 (True)
' que significa tiempo de espera indefinido
Pause = TIMELIMIT
End If
Else ' si no se ha solicitado un puntero de espera
' hacemos que el temporizador no pueda resetear
' el puntero por cuesti?n de tiempo
Pause = TIMELIMIT
' obtenemos el handle del formulario activo
hWnd = Screen.ActiveForm.hWnd
End If

' cargamos el puntero del archivo solicitado
hCursor = LoadCursorFromFile(FileName)
' si hemos tenido éxito
If hCursor Then
' colocamos la captura del rat?n en la
' ventana del formulario o de Access,
' seg?n se necesite
Call SetCapture(hWnd)
' cambiamos el cursor del rat?n
hOldCursor = SetCursor(hCursor)
' lanzamos un timer que controlar? el cursor
Call SetTimer(hWnd, 0&, 100, AddressOf TimerProc)
End If
' guardamos el nombre del archivo
OldFileName = FileName

End Function

' funci?n que destruye un cursor personalizado
' y carga el cursor por defecto
Function RestorePointer()

' si el cursor por defecto no est? en uso
If hOldCursor Then
' liberamos el rat?n
Call ReleaseCapture
' y volvemos a poner el cursor por defecto
Call SetCursor(0&)
' liberamos el cursor personalizado
Call DestroyCursor(hCursor)
' reinicializamos variables
hCursor = 0
hOldCursor = 0
Pause = 0
End If

End Function

' temporizador que controla el tiempo de
' espera de un cursor o bien el que alg?n
' evento provocado por el usuario haya
' restaurado el cursor por defecto. En ambos
' casos, se llamar? a la funci?n RestorePointer
' para liberar memoria
Private Sub TimerProc(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)

' si el cursor personalizado ya no es el
' cursor activo, o el tiempo de espera
' ha finalizado
If hCursor <> GetCursor Or _
GetTickCount >= Pause Then
' destruimos el cursor
Call RestorePointer
' y paramos el timer
Call KillTimer(hWnd, 0&)
End If

End Sub


حالا با کدهای زیر مقادیر رو میتونید بهش پاس بدید.


' cargamos el puntero representado por "icono.ico"
' durante un tiempo indefinido
Call fMousePointer("c:\icono.ico", True)

' ...
' aquí se ejecuta algún proceso que pueda llevar
' un cierto tiempo
' ....

' restauramos el puntero predeterminado
Call RestorePointer
یا :

' cargamos el puntero representado por "icono.ico"
' durante un tiempo de 5 segundos
Call fMousePointer("c:\icono.ico", 5)

' no necesitamos llamar a RestorePointer pues
' el temporizador TimerProc se encargará de
' restaurar el puntero predeterminado cuando se
' cumpla el tiempo de espera
یا :


' cargamos el puntero representado por "icono.ico"
' durante un tiempo indefinido, mientras el
' usuario haga click o presione el espaciador
Call fMousePointer("c:\icono.ico")

' no necesitamos llamar a RestorePointer pues
' el usuario o el temporizador TimerProc se encargarán
' de restaurar el puntero predeterminado

اینم مرجعم :
http://accessvbafaq.mvps.org/item.asp?pagina=94

صبا9841
یک شنبه 21 مهر 1387, 12:32 عصر
با تشکر از دوستان فکر کنم اینجا (http://barnamenevis.org/forum/showthread.php?p=612502#post612502) بهتر باشه.