Форумы HiProg.com - MS ACCESS, VBA, VB

ник: Дядя Федор

'MdlCursor 'Применение 'MouseCursor (IDC_HAND) 'или 'ChangeCursor "C:\windows\cursors\harrow.cur" Option Compare Database Option Explicit Public Const IDC_ARROW = 32512& Public Const IDC_IBEAM = 32513& Public Const IDC_WAIT = 32514& Public Const IDC_CROSS = 32515& Public Const IDC_UPARROW = 32516& Public Const IDC_SIZE = 32640& Public Const IDC_ICON = 32641& Public Const IDC_SIZENWSE = 32642& Public Const IDC_SIZENESW = 32643& Public Const IDC_SIZEWE = 32644& Public Const IDC_SIZENS = 32645& Public Const IDC_SIZEALL = 32646& Public Const IDC_NO = 32648& Public Const IDC_HAND = 32649& Public Const IDC_APPSTARTING = 32650& Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" _   (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long Declare Function LoadCursorFromFile Lib "user32" Alias _   "LoadCursorFromFileA" (ByVal lpFileName As String) As Long Declare Function SetCursor Lib "user32" _   (ByVal hCursor As Long) As Long Function MouseCursor(CursorType As Long) ' Example:  =MouseCursor(32512)     ' using Public Constants from above   Dim lngRet As Long   lngRet = LoadCursorBynum(0&, CursorType)   lngRet = SetCursor(lngRet) End Function Public Function Default_Pointer()     Screen.MousePointer = 0 End Function Public Function Arrow_Pointer()     Screen.MousePointer = 1 End Function Public Function IBeam_Pointer()     Screen.MousePointer = 3 End Function Function ChangeCursor(strPathToCursor As String)      On Error GoTo Error_On_ChangeCursor     Dim retvar As Variant ' Example : '           ChangeCursor ("C:\Program Files\MicrosoftOffice\Office\Hand.cur")     retvar = Dir(strPathToCursor)   If retvar <> "" Then       Dim lngRet As Long       lngRet = LoadCursorFromFile(strPathToCursor)       lngRet = SetCursor(lngRet)   End If Exit_ChangeCursor:          Exit Function Error_On_ChangeCursor:          Resume Exit_ChangeCursor End Function