Advertisement
2002VB Miscellaneous #20108

Display Current Mouse Pointer Image

This code displays a picture of the current mouse pointer in a PictureBox control. This could be useful for doing screen captures that include the mouse pointer.

AI

AI 요약: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

소스 코드
original-source
' The is the function to set a form always on top
Private Sub OnTop(frm As Form, OnTop As Boolean)
  If OnTop = True Then
   SetWindowPos frm.hWnd, SWP_TOPMOST, 0, 0, 0, 0, &H1
  Else
   SetWindowPos frm.hWnd, SWP_NOTOPMOST, 0, 0, 0, 0, &H1
  End If
End Sub
' Paints the cursor image to the picturebox
Private Sub PaintCursor()
 Dim pt As POINTAPI
 Dim hWnd As Long
 Dim dwThreadID, dwCurrentThreadID As Long
 Dim hCursor
 
 ' Get the position of the cursor
 GetCursorPos pt
 ' Then get the handle of the window the cursor is over
 hWnd = WindowFromPoint(pt.x, pt.y)
 
 ' Get the PID of the thread
 ThreadID = GetWindowThreadProcessId(hWnd, vbNull)
 
 ' Get the thread of our program
 CurrentThreadID = App.ThreadID
 
 ' If the cursor is "owned" by a thread other than ours, attach to that thread and get the cursor
 If CurrentThreadID <> ThreadID Then
  AttachThreadInput CurrentThreadID, ThreadID, True
  hCursor = GetCursor()
  AttachThreadInput CurrentThreadID, ThreadID, False
 
 ' If the cursor is owned by our thread, use GetCursor() normally
 Else
  hCursor = GetCursor()
 End If
 
 ' Use DrawIcon to draw the cursor to picCursor
 DrawIcon picCursor.hdc, 0, 0, hCursor
End Sub
Private Sub cmdExit_Click()
 ' Cleanup
 tmrCursor.Enabled = False
 OnTop frmMain, False
 
 ' Exit
 End
End Sub
Private Sub Form_Load()
 ' Make the form always on top
 OnTop frmMain, True
 
 ' Move frmMain to the upper-left corner of the screen
 frmMain.Move 0, 0
End Sub
Private Sub tmrCursor_Timer()
 ' Clear the picturebox before drawing another cursor image
 picCursor.Cls
 
 ' Draw the cursor
 PaintCursor
End Sub
원본 댓글 (3)
Wayback Machine에서 복구됨