在仅知hwnd的情况下设定鼠标光标

Question

编写了一个组件，想处理其他窗体传过来的消息，参数中有窗体或窗体中某控件的hwnd，如何通过仅知其hwnd的情况下设定其鼠标光标为vbHourglass？谢谢大侠！

Answer 1

用CreateCursor试试：
【VB声明】
  Private Declare Function CreateCursor Lib "user32" Alias "CreateCursor" (ByVal hInstance As Long, ByVal nXhotspot As Long, ByVal nYhotspot As Long, ByVal nWidth As Long, ByVal nHeight As Long, lpANDbitPlane As Any, lpXORbitPlane As Any) As Long
【说明】
  创建一个鼠标指针 
【返回值】
  Long，执行成功返回指针的句柄，零表示失败。会设置GetLastError 
【备注】
  一旦不再需要，注意用DestroyCursor函数释放鼠标指针占用的内存及资源
【参数表】
  hInstance ------  Long，准备拥有指针的应用程序的实例的句柄。可用GetWindowWord函数获得拥有一个窗体或控件的一个实例的句柄
  nXhotspot,nYhotspot -  Long，鼠标指针图象中代表准确指针位置的X，Y坐标
  nWidth ---------  Long，指针图象的宽度。可用GetSystemMetrics函数判断一个特定设备的正确编号。VGA的编号是32
  nHeight --------  Long，指针图象的高度。可用GetSystemMetrics函数判断一个特定设备的正确编号。VGA的编号是32
  lpANDbitPlane --  Any，指向AND位图数据的指针
  lpXORbitPlane --  Any，指向XOR位图数据的指针例子：
Private Declare Function CreateCursor Lib "user32" (ByVal hInstance As Long, ByVal nXhotspot As Long, ByVal nYhotspot As Long, ByVal nWidth As Long, ByVal nHeight As Long, lpANDbitPlane As Any, lpXORbitPlane As Any) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()    
    ' Create a 32x32 color cursor shaped somewhat like a yin-yang symbol.
    ' (The bit masks come from Microsoft's documentation on the API cursors function, just to
    ' give them their due credit.)  Note how the masks are loaded into the arrays.  The new
    ' cursor is then set to be the cursor for 10 seconds.
    Dim hnewcursor As Long  ' newly created cursor
    Dim holdcursor As Long  ' receives handle of default cursor
    Dim andbuffer As String, xorbuffer As String  ' buffers for masks
    Dim andbits(0 To 127) As Byte  ' stores the AND mask
    Dim xorbits(0 To 127) As Byte  ' stores the XOR mask
    Dim c As Integer, retval As Long  ' counter and return value    ' Unfortunately, VB does not provide a nice way to load lots of information into an array.
    ' To load the AND and XOR masks, we put the raw hex values into the string buffers
    ' and use a loop to convert the hex values into numeric values and load them into
    ' the elements of the array.  Yes, it's ugly, but there's no better way.  Note the
    ' use of the line-continuation character here.  Each sequence of eight hex
    ' characters represents one line in the 32x32 cursor.
    Andbuffer = "FFFC3FFF" & "FFC01FFF" & "FF003FFF" & "FE00FFFF" & _
            "F701FFFF" & "F003FFFF" & "F003FFFF" & "E007FFFF" & _
            "C007FFFF" & "C00FFFFF" & "800FFFFF" & "800FFFFF" & _
            "8007FFFF" & "8007FFFF" & "0003FFFF" & "0000FFFF" & _
            "00007FFF" & "00001FFF" & "00000FFF" & "80000FFF" & _
            "800007FF" & "800007FF" & "C00007FF" & "C0000FFF" & _
            "E0000FFF" & "F0001FFF" & "F0001FFF" & "F8003FFF" & _
            "FE007FFF" & "FF00FFFF" & "FFC3FFFF" & "FFFFFFFF"
    xorbuffer = "00000000" & "0003C000" & "003F0000" & "00FE0000" & _
            "0EFC0000" & "07F80000" & "07F80000" & "0FF00000" & _
            "1FF00000" & "1FE00000" & "3FE00000" & "3FE00000" & _
            "3FF00000" & "7FF00000" & "7FF80000" & "7FFC0000" & _
            "7FFF0000" & "7FFF8000" & "7FFFE000" & "3FFFE000" & _
            "3FC7F000" & "3F83F000" & "1F83F000" & "1F83E000" & _
            "0FC7E000" & "07FFC000" & "07FFC000" & "01FF8000" & _
            "00FF0000" & "003C0000" & "00000000" & "00000000"
    ' Now load these hex values into the proper arrays.
    For c = 0 To 127
        andbits(c) = Val("&H" & Mid(andbuffer, 2 * c + 1, 2))
        xorbits(c) = Val("&H" & Mid(xorbuffer, 2 * c + 1, 2))
    Next c
    ' Finally, create this cursor!  The hotspot is at (19,2) on the cursor.
    Hnewcursor = CreateCursor(App.hInstance, 19, 2, 32, 32, andbits(0), xorbits(0))
    ' Set the new cursor as the current cursor for 10 seconds and then switch back.
    Holdcursor = SetCursor(hnewcursor)  ' change cursor
    Sleep 10000  'Wait 10 seconds
    retval = SetCursor(holdcursor)  ' change cursor back
    ' Destroy the new cursor.
    Retval = DestroyCursor(hnewcursor)
End Sub

Answer 2

由hwnd获得hInstance的例子：
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowWord Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Integer
Const GWW_HINSTANCE = (-6)
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    Dim ModuleName As String, FileName As String, hInst As Long
    'create a buffer
    ModuleName = String$(128, Chr$(0))
    'get the hInstance application:
    hInst = GetWindowWord(Me.hwnd, GWW_HINSTANCE)
    'get the ModuleFileName:
    'enter the following two lines as one, single line:
    ModuleName = Left$(ModuleName, GetModuleFileName(hInst, ModuleName, Len(ModuleName)))
    'set graphics mode to persistent
    Me.AutoRedraw = True
    'show the module filename
    Me.Print "Module Filename: " + ModuleName
End Sub

Answer 3

鼠标光标是属于线程级
不是窗口级当需要改变鼠标光标时
Windows会向鼠标所指窗口发送WM_SETCURSOR消息
请求应用程序用SetCursor设置该线程的鼠标光标
解决方案：
1.设置窗口的默认光标
Call SetClassLong(hWnd,GCL_HCURSOR,光标句柄)
(若应用程序是用子类自己处理WM_SETCURSOR消息，则该方法会失效)
2.使用跨进程钩子，拦截处理WM_SETCURSOR消息
存在实现难度：
   A.跨进程钩子需要普通dll，而VB只能编译ActiveX DLL
   B.可以用http://www.applevb.com/art/vb_dll.html的方法解决问题A，但我没有测试过

Answer 4

Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Const GCL_HCURSOR = (-12)Dim CurSor As Long
Dim OldCur As LongPublic Sub SetAni(ByVal hWnd As Long, ByVal PathAni As String)
    Dim ret As Long
    OldCur = GetClassLong(hWnd, GCL_HCURSOR)
    CurSor = LoadCursorFromFile(PathAni)
    ret = SetClassLong(hWnd, GCL_HCURSOR, CurSor)
        
End SubPublic Sub UnSetAni(ByVal hWnd As Long)
    Dim ret As Long
    ret = SetClassLong(hWnd, GCL_HCURSOR, OldCur)
End Sub

Answer 5

这个有几个过程 对你有帮助的 可以解决你的问题Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, lpCursorName As Any) As Long
Public Const IDC_WAIT = 32514&   ' 沙漏
Public Const IDC_ARROW = 32512&Public Sub Hourglass(hWnd As Long, fOn As Boolean) '显示沙漏
  If fOn = True Then
    ' 显示沙漏!
    Call SetCapture(hWnd)                          '当前鼠标所在的句柄
    Call SetCursor(LoadCursor(0, ByVal IDC_WAIT))  '鼠标为等待
  Else
    ' 关闭沙漏!
    Call ReleaseCapture                            '释放鼠标所在的句柄
    Call SetCursor(LoadCursor(0, IDC_ARROW))       '鼠标为正常的
  End If
End Sub
'hwnd为你的句柄
Call Hourglass(hWnd, True)     '设定为沙漏
Call Hourglass(hWnd, False)    '取消沙漏