Информация об окнах - VB

Узнай цену своей работы

Формулировка задачи:

Простенькая утилита, которая выдает информацию по окну, которое находится под курсором. Может пригодится кому
Проект тут

Решение задачи: «Информация об окнах»

textual
Листинг программы
Option Explicit
 
Private Declare Function GetCursor Lib "user32.dll" () As Long
Private Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorW" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function CopyCursor Lib "user32" Alias "CopyIcon" (ByVal hCur As Long) As Long
Private Declare Function SetSystemCursor Lib "user32.dll" (ByVal hCur As Long, ByVal id As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleW" (ByVal lpModuleName As Long) As Long
 
Private Const IDC_CROSS         As Long = 32515&
 
Private Const OCR_APPSTARTING = 32650
Private Const OCR_NORMAL = 32512&
Private Const OCR_CROSS = 32515
Private Const OCR_HAND = 32649
Private Const OCR_HELP = 32651
Private Const OCR_IBEAM = 32513
Private Const OCR_NO = 32648
Private Const OCR_SIZEALL = 32646
Private Const OCR_SIZENESW = 32643
Private Const OCR_SIZENS = 32645
Private Const OCR_SIZENWSE = 32642
Private Const OCR_SIZEWE = 32644
Private Const OCR_UP = 32516
Private Const OCR_WAIT = 32514
 
 
Dim hOldCursor(13) As Long
Dim IDCursor(13) As Long
 
 
Public Sub SetNewCursor()
    Dim hInstance As Long
    Dim hCur As Long
    Dim hCurCopy As Long
    Dim i As Long
    
    Static isInit As Boolean
    
    If Not isInit Then
        isInit = True
        IDCursor(0) = OCR_APPSTARTING
        IDCursor(1) = OCR_NORMAL
        IDCursor(2) = OCR_CROSS
        IDCursor(3) = OCR_HAND
        IDCursor(4) = OCR_HELP
        IDCursor(5) = OCR_IBEAM
        IDCursor(6) = OCR_NO
        IDCursor(7) = OCR_SIZEALL
        IDCursor(8) = OCR_SIZENESW
        IDCursor(9) = OCR_SIZENS
        IDCursor(10) = OCR_SIZENWSE
        IDCursor(11) = OCR_SIZEWE
        IDCursor(12) = OCR_UP
        IDCursor(13) = OCR_WAIT
    End If
    
    'We don't really sure if current cursor is IDC_NORMAL
    'hOldCursor = CopyCursor(GetCursor())
 
    'hInstance = GetModuleHandle(0&)
    
    'Save Old cursors
    For i = 0 To UBound(IDCursor)
        hCur = LoadCursor(0&, IDCursor(i))
        If 0 <> hCur Then
            hOldCursor(i) = CopyCursor(hCur)
        End If
    Next
    
    hCur = LoadCursor(0&, IDC_CROSS)
    
    If 0 <> hCur Then
        For i = 0 To UBound(IDCursor)
        
            'duplicate handle
            hCurCopy = CopyCursor(hCur)
            If 0 <> hCurCopy Then
                'Warning: this function destroys cursor directed by hCur. Be aware. Must copy handle of cursor first.
                'Replacing all system cursors which is available for saving
            
                SetSystemCursor hCurCopy, IDCursor(i)
                hCurCopy = 0
            End If
        Next
    End If
End Sub
 
Public Sub SetOldCursor()
    Dim i As Long
    For i = 0 To UBound(IDCursor)
        If hOldCursor(i) <> 0 Then
            SetSystemCursor hOldCursor(i), IDCursor(i)
            hOldCursor(i) = 0
        End If
    Next
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

15   голосов , оценка 4.067 из 5
Похожие ответы