wndapifuncs.bas

几个不错的VB例子

Case WM_RENDERFORMAT  ' &H305
    sGetMessageName = "WM_RENDERFORMAT"
Case WM_SETCURSOR  ' &H20
    sGetMessageName = "WM_SETCURSOR"
Case WM_SETFOCUS  ' &H7
    sGetMessageName = "WM_SETFOCUS"
Case WM_SETFONT  ' &H30
    sGetMessageName = "WM_SETFONT"
Case WM_SETHOTKEY  ' &H32
    sGetMessageName = "WM_SETHOTKEY"
Case WM_SETREDRAW  ' &HB
    sGetMessageName = "WM_SETREDRAW"
Case WM_SETTEXT  ' &HC
    sGetMessageName = "WM_SETTEXT"
Case WM_SETTINGCHANGE  ' &H1A
    sGetMessageName = "WM_SETTINGCHANGE"
Case WM_SHOWWINDOW  ' &H18
    sGetMessageName = "WM_SHOWWINDOW"
Case WM_SIZE  ' &H5
    sGetMessageName = "WM_SIZE"
Case WM_SIZECLIPBOARD  ' &H30B
    sGetMessageName = "WM_SIZECLIPBOARD"
Case WM_SPOOLERSTATUS  ' &H2A
    sGetMessageName = "WM_SPOOLERSTATUS"
Case WM_SYSCHAR  ' &H106
    sGetMessageName = "WM_SYSCHAR"
Case WM_SYSCOLORCHANGE  ' &H15
    sGetMessageName = "WM_SYSCOLORCHANGE"
Case WM_SYSCOMMAND  ' &H112
    sGetMessageName = "WM_SYSCOMMAND"
Case WM_SYSDEADCHAR  ' &H107
    sGetMessageName = "WM_SYSDEADCHAR"
Case WM_SYSKEYDOWN  ' &H104
    sGetMessageName = "WM_SYSKEYDOWN"
Case WM_SYSKEYUP  ' &H105
    sGetMessageName = "WM_SYSKEYUP"
Case WM_TIMECHANGE  ' &H1E
    sGetMessageName = "WM_TIMECHANGE"
Case WM_TIMER  ' &H113
    sGetMessageName = "WM_TIMER"
Case WM_UNDO  ' &H304
    sGetMessageName = "WM_UNDO"
Case WM_USER  ' &H400
    sGetMessageName = "WM_USER"
Case WM_VKEYTOITEM  ' &H2E
    sGetMessageName = "WM_VKEYTOITEM"
Case WM_VSCROLL  ' &H115
    sGetMessageName = "WM_VSCROLL"
Case WM_VSCROLLCLIPBOARD  ' &H30A
    sGetMessageName = "WM_VSCROLLCLIPBOARD"
Case WM_WINDOWPOSCHANGED  ' &H47
    sGetMessageName = "WM_WINDOWPOSCHANGED"
Case WM_WINDOWPOSCHANGING  ' &H46
    sGetMessageName = "WM_WINDOWPOSCHANGING"
Case WM_WININICHANGE  ' &H1A
    sGetMessageName = "WM_WININICHANGE"
Case Else
    sGetMessageName = "UNKNOWN MESSAGE : " & Hex(nMsg)
End Select

End Function

'\\ --[sGetShowWindowName]---------------------------------------------------------------------
'\\ Returns the text name of a show windpow constant from its long number...
'\\ ----------------------------------------------------------------------------------------
'\\ You have a royalty free right to use, reproduce, modify, publish and mess with this code
'\\ I'd like you to visit http://www.merrioncomputing.com for updates, but won't force you
'\\ ----------------------------------------------------------------------------------------
Public Function sGetShowWindowName(nSWNum As Long) As String

Select Case nSWNum
Case SW_ERASE
    sGetShowWindowName = "SW_ERASE"
Case SW_HIDE
    sGetShowWindowName = "SW_HIDE"
Case SW_INVALIDATE
    sGetShowWindowName = "SW_INVALIDATE"
Case SW_MAX
    sGetShowWindowName = "SW_MAX"
Case SW_MAXIMIZE
    sGetShowWindowName = "SW_MAXIMIZE"
Case SW_MINIMIZE
    sGetShowWindowName = "SW_MINIMIZE"
Case SW_NORMAL
    sGetShowWindowName = "SW_NORMAL"
Case SW_OTHERUNZOOM
    sGetShowWindowName = "SW_OTHERUNZOOM"
Case SW_OTHERZOOM
    sGetShowWindowName = "SW_OTHERZOOM"
Case SW_PARENTCLOSING
    sGetShowWindowName = "SW_PARENTCLOSING"
Case SW_PARENTOPENING
    sGetShowWindowName = "SW_PARENTOPENING"
Case SW_RESTORE
    sGetShowWindowName = "SW_RESTORE"
Case SW_SCROLLCHILDREN
    sGetShowWindowName = "SW_SCROLLCHILDREN"
Case SW_SHOW
    sGetShowWindowName = "SW_SHOW"
Case SW_SHOWDEFAULT
    sGetShowWindowName = "SW_SHOWDEFAULT"
Case SW_SHOWMAXIMIZED
    sGetShowWindowName = "SW_SHOWMAXIMIZED"
Case SW_SHOWMINIMIZED
    sGetShowWindowName = "SW_SHOWMINIMIZED"
Case SW_SHOWMINNOACTIVE
    sGetShowWindowName = "SW_SHOWMINNOACTIVE"
Case SW_SHOWNA
    sGetShowWindowName = "SW_SHOWNA"
Case SW_SHOWNOACTIVATE
    sGetShowWindowName = "SW_SHOWNOACTIVATE"
Case SW_SHOWNORMAL
    sGetShowWindowName = "SW_SHOWNORMAL"
Case Else
    sGetShowWindowName = "UNKNOWN SW_ CONSTANT: " & Hex(nSWNum)
End Select

End Function

'\\ --[sGetSystemCommandName]---------------------------------------------------------------------
'\\ Returns the text name of a system command message from its long number...
'\\ ----------------------------------------------------------------------------------------
'\\ You have a royalty free right to use, reproduce, modify, publish and mess with this code
'\\ I'd like you to visit http://www.merrioncomputing.com for updates, but won't force you
'\\ ----------------------------------------------------------------------------------------
Public Function sGetSystemCommandName(ByVal nCmd As Long) As String

nCmd = LoWord(nCmd)

Select Case True
Case nCmd = LoWord(SC_ARRANGE)
    sGetSystemCommandName = "SC_ARRANGE"
Case nCmd = LoWord(SC_CLOSE)
    sGetSystemCommandName = "SC_CLOSE"
Case nCmd = LoWord(SC_HOTKEY)
    sGetSystemCommandName = "SC_HOTKEY"
Case nCmd = LoWord(SC_HSCROLL)
    sGetSystemCommandName = "SC_HSCROLL"
Case nCmd = LoWord(SC_KEYMENU)
    sGetSystemCommandName = "SC_KEYMENU"
Case nCmd = LoWord(SC_MAXIMIZE)
    sGetSystemCommandName = "SC_MAXIMIZE"
Case nCmd = LoWord(SC_MINIMIZE)
    sGetSystemCommandName = "SC_MINIMIZE"
Case nCmd = LoWord(SC_MOUSEMENU)
    sGetSystemCommandName = "SC_MOUSEMENU"
Case nCmd = LoWord(SC_MOVE)
    sGetSystemCommandName = "SC_MOVE"
Case nCmd = LoWord(SC_NEXTWINDOW)
    sGetSystemCommandName = "SC_NEXTWINDOW"
Case nCmd = LoWord(SC_PREVWINDOW)
    sGetSystemCommandName = "SC_PREVWINDOW"
Case nCmd = LoWord(SC_RESTORE)
    sGetSystemCommandName = "SC_RESTORE"
Case nCmd = LoWord(SC_SCREENSAVE)
    sGetSystemCommandName = "SC_SCREENSAVE"
Case nCmd = LoWord(SC_SIZE)
    sGetSystemCommandName = "SC_SIZE"
Case nCmd = LoWord(SC_TASKLIST)
    sGetSystemCommandName = "SC_TASKLIST"
Case nCmd = LoWord(SC_VSCROLL)
    sGetSystemCommandName = "SC_VSCROLL"
Case Else
     sGetSystemCommandName = "UNKNOWN SYSTEM COMMAND : " & Hex(LoWord(nCmd))
End Select

End Function


'\\ --[SubclassDialog]---------------------------------------------------------------
'\\ Subclasses the dialog proc. whose hwnd is given with the proc at address
'\\ lpfnDlgRox
'\\ ---------------------------------------------------------------------------------
Public Sub SubclassDialog(hwndDlg As Long, lpfnDlgProc As Long)

Dim lRet As Long

lRet = SetWindowLong(hwndDlg, DWL_DLGPROC, lpfnDlgProc)
If lRet > 0 Then
    Eventhandler.hOldDlgProc = lRet
End If

End Sub


'\\ --[VB_GetClassname]---------------------------------------------------------------------
'\\ Returns the class name of the given window
'\\ Parameters:
'\\    hwndTest - The window handle of the window for which you require the class name.
'\\ ----------------------------------------------------------------------------------------
'\\ You have a royalty free right to use, reproduce, modify, publish and mess with this code
'\\ I'd like you to visit http://www.merrioncomputing.com for updates, but won't force you
'\\ ----------------------------------------------------------------------------------------
Public Function VB_GetClassname(ByVal hwndTest As Long) As String

Dim lRet As Long
Dim sClassname As String

'\\ Get the window class name....
sClassname = String$(256, 0)
lRet = GetClassName(hwndTest, sClassname, 255)
If lRet > 0 Then
    sClassname = Left$(sClassname, lRet)
End If

VB_GetClassname = sClassname

End Function

Public Function sGetWindowInformation(hwndTest As Long) As String

Dim sRet As String
Dim sClassname As String
Dim sWindowText As String

Dim sNL As String
sNL = Chr$(13) & Chr$(10)

sClassname = VB_GetClassname(hwndTest)
sWindowText = VB_GetWindowText(hwndTest)

'\\ Compose the information together...
sRet = "Classname : " & sClassname & sNL
sRet = sRet & "WindowText : " & sWindowText & sNL
If VB_IsWindowClassSet(hwndTest, CS_BYTEALIGNCLIENT) Then sRet = sRet & " + BYTEALIGNCLIENT " & sNL
If VB_IsWindowClassSet(hwndTest, CS_BYTEALIGNWINDOW) Then sRet = sRet & " + BYTEALIGNWINDOW " & sNL
If VB_IsWindowClassSet(hwndTest, CS_CLASSDC) Then sRet = sRet & " + CLASSDC " & sNL
If VB_IsWindowClassSet(hwndTest, CS_OWNDC) Then sRet = sRet & " + OWNDC " & sNL
If VB_IsWindowClassSet(hwndTest, CS_PARENTDC) Then sRet = sRet & " + PARENTDC " & sNL
If VB_IsWindowClassSet(hwndTest, CS_DBLCLKS) Then sRet = sRet & " + DBLCLKS " & sNL
If VB_IsWindowClassSet(hwndTest, CS_HREDRAW) Then sRet = sRet & " + HREDRAW " & sNL
If VB_IsWindowClassSet(hwndTest, CS_VREDRAW) Then sRet = sRet & " + VREDRAW " & sNL
If VB_IsWindowClassSet(hwndTest, CS_INSERTCHAR) Then sRet = sRet & " + INSERTCHAR " & sNL
If VB_IsWindowClassSet(hwndTest, CS_KEYCVTWINDOW) Then sRet = sRet & " + KEYCVTWINDOW " & sNL
If VB_IsWindowClassSet(hwndTest, CS_NOCLOSE) Then sRet = sRet & " + NOCLOSE " & sNL
If VB_IsWindowClassSet(hwndTest, CS_NOKEYCVT) Then sRet = sRet & " + NOKEYCVT " & sNL
If VB_IsWindowClassSet(hwndTest, CS_NOMOVECARET) Then sRet = sRet & " + NOMOVECARET " & sNL
If VB_IsWindowClassSet(hwndTest, CS_PUBLICCLASS) Then sRet = sRet & " + PUBLICCLASS " & sNL
If VB_IsWindowClassSet(hwndTest, CS_SAVEBITS) Then sRet = sRet & " + SAVEBITS " & sNL

sGetWindowInformation = sRet

End Function

'\\ --[VB_GetWindowText]---------------------------------------------------------------------
'\\ Returns the window text of the given window
'\\ Parameters:
'\\    hwndTest - The window handle of the window for which you require the text.
'\\ ----------------------------------------------------------------------------------------
'\\ You have a royalty free right to use, reproduce, modify, publish and mess with this code
'\\ I'd like you to visit http://www.merrioncomputing.com for updates, but won't force you
'\\ ----------------------------------------------------------------------------------------
Public Function VB_GetWindowText(ByVal hwndTest As Long) As String

Dim lRet As Long
Dim sRet As String

lRet = GetWindowTextLength(hwndTest)
If lRet > 0 Then
    sRet = String$(lRet + 1, 0)
    lRet = GetWindowText(hwndTest, sRet, Len(sRet))
    '\\ Returns length up to NULL terminator
    If lRet > 0 Then
        sRet = Left$(sRet, lRet)
    End If
End If

VB_GetWindowText = sRet

End Function



'\\ --[VB_IsWindowClassSet]---------------------------------------------------------------------
'\\ Returns true if the given window has the given class style set
'\\ Parameters:
'\\    hwndTest - The window handle of the window for which you require the text.
'\\    ClassStyle - The class style you are testing for
'\\ ----------------------------------------------------------------------------------------
'\\ You have a royalty free right to use, reproduce, modify, publish and mess with this code
'\\ I'd like you to visit http://www.merrioncomputing.com for updates, but won't force you
'\\ ----------------------------------------------------------------------------------------
Public Function VB_IsWindowClassSet(ByVal hwndTest As Long, ClassStyle As ClassStyleConstants) As Boolean

Dim lRet As Long
lRet = GetClassLong(hwndTest, GCL_STYLE)

VB_IsWindowClassSet = (lRet And ClassStyle)

End Function


'\\ --[HiWord]-----------------------------------------------------------------------------
'\\ Returns the high word component of a long value
'\\ Parameters:
'\\   dw - The long of which we need the HiWord
'\\
'\\ ----------------------------------------------------------------------------------------
'\\ You have a royalty free right to use, reproduce, modify, publish and mess with this code
'\\ I'd like you to visit http://www.merrioncomputing.com for updates, but won't force you
'\\ ----------------------------------------------------------------------------------------
Public Function HiWord(dw As Long) As Integer
 If dw And &H80000000 Then
      HiWord = (dw \ 65535) - 1
 Else
    HiWord = dw \ 65535
 End If
End Function

'\\ --[LoByte]-----------------------------------------------------------------------------
'\\ Returns the low byte component of an integer value
'\\ Parameters:
'\\   w - The integer of which we need the loWord
'\\
'\\ ----------------------------------------------------------------------------------------
'\\ You have a royalty free right to use, reproduce, modify, publish and mess with this code
'\\ I'd like you to visit http://www.merrioncomputing.com for updates, but won't force you
'\\ ----------------------------------------------------------------------------------------
Public Function LoByte(w As Integer) As Byte
 LoByte = w And &HFF
End Function

'\\ --[LoWord]-----------------------------------------------------------------------------
'\\ Returns the low word component of a long value
'\\ Parameters:
'\\   dw - The long of which we need the LoWord
'\\
'\\ ----------------------------------------------------------------------------------------
'\\ You have a royalty free right to use, reproduce, modify, publish and mess with this code
'\\ I'd like you to visit http://www.merrioncomputing.com for updates, but won't force you
'\\ ----------------------------------------------------------------------------------------
Public Function LoWord(dw As Long) As Integer
  If dw And &H8000& Then
      LoWord = &H8000 Or (dw And &H7FFF&)
   Else
      LoWord = dw And &HFFFF&
   End If
End Function

'\\ --[HiByte]-----------------------------------------------------------------------------
'\\ Returns the high byte component of an integer
'\\ Parameters:
'\\   w - The integer of which we need the HiByte
'\\
'\\ ----------------------------------------------------------------------------------------
'\\ You have a royalty free right to use, reproduce, modify, publish and mess with this code
'\\ I'd like you to visit http://www.merrioncomputing.com for updates, but won't force you
'\\ ----------------------------------------------------------------------------------------
Public Function HiByte(ByVal w As Integer) As Byte
   If w And &H8000 Then
      HiByte = &H80 Or ((w And &H7FFF) \ &HFF)
   Else
      HiByte = w \ 256
    End If
End Function