apiwindow.cls

几个不错的VB例子

End Property

Public Property Get SystemMenu() As ApiMenu

Dim lret As Long

lret = GetSystemMenuApi(m_hwnd, False)
If Err.LastDllError = 0 And lret > 0 Then
    If mSystemMenu Is Nothing Then
        Set mSystemMenu = New ApiMenu
    End If
    mSystemMenu.hMenu = lret
    Set SystemMenu = mSystemMenu
End If

End Property

Public Property Get Thread() As ApiThread

Dim lret As Long
Dim lProcess As Long

Dim threadThis As ApiThread

Set threadThis = New ApiThread
lret = GetWindowThreadProcessId(Me.hwnd, lProcess)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiWindow:Thread", GetLastSystemError
Else
    threadThis.ThreadId = lret
End If

Set Thread = threadThis

End Property

Friend Property Get ThreadParent() As Long

If mThreadParent <> 0 Then
    ThreadParent = mThreadParent
Else
    mThreadParent = Me.Thread.ThreadId
    ThreadParent = mThreadParent
End If

End Property

Public Property Get TitleBarRectangle() As APIRect

Dim lret As Long
Dim tiThis As TITLEBARINFO
Dim rcRet As New APIRect

tiThis.cbSize = Len(tiThis)
If APIDispenser.System.IsRequiredSystem("GetTitlebarInfo", ver_Win_Win2000) Then
    lret = GetTitleBarInfo(m_hwnd, tiThis)
    If Err.LastDllError Then
        ReportError Err.LastDllError, "ApiWindow:TitleBarRect", GetLastSystemError
    End If
    rcRet.CreateFromPointer (VarPtr(tiThis.rcTitleBar))
End If
Set TitleBarRectangle = rcRet

End Property

Friend Sub TriggerEvent(wMsg As WindowMessages, wParam As Long, lParam As Long, bDiscardMsg As Boolean, lWndProcRet As Long)

Dim Cancel As Boolean

Dim lret As Long

'\\ Used in wm_vscroll and wm_hscroll processing
Dim ScrollMessage As enScrollMessages
Dim ScrollPosition As Long
Static LastHScroll As Long
Static LastVScroll As Long

'\\ Usid in WM_MOVE processing
Dim x As Long
Dim y As Long

    If wMsg = WM_ACTIVATEAPP Then
        '\\ This app is being activetd or deactivated...
        RaiseEvent ActiveApplicationChanged(CBool(wParam), lParam, Cancel)
    
    ElseIf wMsg = WM_CAPTURECHANGED Then
        '\\This window lost mouse capture
        RaiseEvent LostCapture(lParam, Cancel)
    
    ElseIf wMsg = WM_CHAR Then
        '\\ Keypress was intercepted by this window...
        Dim lRepetition As Long
        Dim lScanCode As Long
        Dim bExtendedKey As Boolean
        Dim bAltDown As Boolean
        Dim bAlreadyPressed As Boolean
        Dim bBeingPressed As Boolean
        With APIDispenser
            lRepetition = .GetBits(lParam, 0, 15)
            lScanCode = .GetBits(lParam, 16, 23)
            bExtendedKey = .GetBits(lParam, 24, 24)
            bAltDown = .GetBits(lParam, 29, 22)
            bAlreadyPressed = .GetBits(lParam, 30, 30)
            bBeingPressed = .GetBits(lParam, 31, 31)
        End With
        RaiseEvent KeyPressed(wParam, lRepetition, lScanCode, bExtendedKey, bAltDown, bAlreadyPressed, bBeingPressed, Cancel)
    
    ElseIf wMsg = WM_COMPACTING Then
        '\\ Windows is low on memory and is compacting memory...
        RaiseEvent LowMemory(wParam)
        '\\ It is not sensible to have a cancel option on this
    
    ElseIf wMsg = WM_MOVE Then
        x = APIDispenser.LoWord(lParam)
        y = APIDispenser.HiWord(lParam)
        RaiseEvent Move(x, y, Cancel)
    
    ElseIf wMsg = WM_HSCROLL Then
        '\\ Horizontal scrollbar event has occured
        ScrollMessage = APIDispenser.LoWord(wParam)
        ScrollPosition = APIDispenser.HiWord(wParam)
        RaiseEvent HorizontalScroll(ScrollMessage, ScrollPosition, Cancel)
        Call Me.ScrollWindow(ScrollPosition - LastHScroll, 0, SW_SCROLLCHILDREN)
        LastHScroll = ScrollPosition
        
    ElseIf wMsg = WM_VSCROLL Then
        '\\ Vertical scrollbar event has occured
        ScrollMessage = APIDispenser.LoWord(wParam)
        ScrollPosition = APIDispenser.HiWord(wParam)
        RaiseEvent VerticalScroll(ScrollMessage, ScrollPosition, Cancel)
        Call Me.ScrollWindow(0, ScrollPosition - LastVScroll, SW_SCROLLCHILDREN)
        LastVScroll = ScrollPosition
        
    ElseIf wMsg = WM_HOTKEY Then
        Dim hkThis As ApiHotkey
        Set hkThis = New ApiHotkey
        hkThis.VKey = APIDispenser.HiWord(lParam)
        hkThis.Modifier = APIDispenser.LoWord(lParam)
        RaiseEvent Hotkey(hkThis)
        Set hkThis = Nothing
        
    ElseIf wMsg = WM_SETTINGCHANGE Then
        RaiseEvent WindowsSettingsChanged(wParam)
    
    ElseIf wMsg = WM_WININICHANGE Then
        Dim sSection As String
        sSection = StringFromPointer(lParam, 1024)
        RaiseEvent WindowsINIChanged(sSection)
        
    '\\ Mouse button down
    ElseIf wMsg = WM_NCLBUTTONDOWN Then
        x = APIDispenser.LoWord(lParam)
        y = APIDispenser.HiWord(lParam)
        RaiseEvent NonClientMouseDown(wParam, vbLeftButton, x, y)
        
    ElseIf wMsg = WM_NCMBUTTONDOWN Then
        x = APIDispenser.LoWord(lParam)
        y = APIDispenser.HiWord(lParam)
        RaiseEvent NonClientMouseDown(wParam, vbMiddleButton, x, y)
        
    ElseIf wMsg = WM_NCRBUTTONDOWN Then
        x = APIDispenser.LoWord(lParam)
        y = APIDispenser.HiWord(lParam)
        RaiseEvent NonClientMouseDown(wParam, vbRightButton, x, y)
        
    '\\ Mouse button up
    ElseIf wMsg = WM_NCLBUTTONUP Then
        x = APIDispenser.LoWord(lParam)
        y = APIDispenser.HiWord(lParam)
        RaiseEvent NonClientMouseUp(wParam, vbLeftButton, x, y)
        
    ElseIf wMsg = WM_NCMBUTTONUP Then
        x = APIDispenser.LoWord(lParam)
        y = APIDispenser.HiWord(lParam)
        RaiseEvent NonClientMouseUp(wParam, vbMiddleButton, x, y)
        
    ElseIf wMsg = WM_NCRBUTTONUP Then
        x = APIDispenser.LoWord(lParam)
        y = APIDispenser.HiWord(lParam)
        RaiseEvent NonClientMouseUp(wParam, vbRightButton, x, y)

    '\\ Mouse move
    ElseIf wMsg = WM_NCMOUSEMOVE Then
        x = APIDispenser.LoWord(lParam)
        y = APIDispenser.HiWord(lParam)
        RaiseEvent NonClientMouseMove(wParam, x, y)
        '\\ If the mouse moved over a menu...
        If wParam = HTMENU Then
            Dim sCaption As String
            Dim ptThis As APIPoint
            Set ptThis = New APIPoint
            With ptThis
                .x = x
                .y = y
            End With
            sCaption = Me.Menu.CaptionFromPoint(Me, ptThis)
            If sCaption <> "" Then
                RaiseEvent MouseOverMenu(sCaption)
            End If
        End If

    '\\ Minimum and maximum info.....
    ElseIf wMsg = WM_GETMINMAXINFO Then
        Dim myMinMaxInfo As MINMAXINFO
        Dim lMaxHeight As Long, lMaxWidth As Long
        Dim lMaxPositionTop As Long
        Dim lMaxPositionLeft As Long
        Dim lMinTrackWidth As Long, lMinTrackheight As Long
        Dim lMaxTrackWidth As Long, lMaxTrackHeight As Long
        Call CopyMemoryMinMaxInfo(myMinMaxInfo, lParam, LenB(myMinMaxInfo))
        If Err.LastDllError <> 0 Then
            ReportError Err.LastDllError, "ApiWindow:WM_GETMINMAXINFO", GetLastSystemError
        Else
            With myMinMaxInfo
                '\\ Maximum height and width
                lMaxWidth = .ptMaxSize.x
                lMaxHeight = .ptMaxSize.y
                '\\ Maximum left and top
                lMaxPositionLeft = .ptMaxPosition.x
                lMaxPositionTop = .ptMaxPosition.y
                '\\ Maxiumum track size
                lMaxTrackWidth = .ptMaxTrackSize.x
                lMaxTrackHeight = .ptMaxTrackSize.y
                '\\ Minimum track size
                lMinTrackWidth = .ptMinTrackSize.x
                lMinTrackheight = .ptMinTrackSize.y
            End With
            RaiseEvent MinMaxSize(lMaxHeight, lMaxWidth, lMaxPositionTop, lMaxPositionLeft, lMinTrackWidth, lMinTrackheight, lMaxTrackWidth, lMaxTrackHeight)
            With myMinMaxInfo
                '\\ Maximum height and width
                 .ptMaxSize.x = lMaxWidth
                 .ptMaxSize.y = lMaxHeight
                '\\ Maximum left and top
                 .ptMaxPosition.x = lMaxPositionLeft
                 .ptMaxPosition.y = lMaxPositionTop
                '\\ Maxiumum track size
                 .ptMaxTrackSize.x = lMaxTrackWidth
                 .ptMaxTrackSize.y = lMaxTrackHeight
                '\\ Minimum track size
                 .ptMinTrackSize.x = lMinTrackWidth
                 .ptMinTrackSize.y = lMinTrackheight
            End With
            Call CopyMinMaxToMemoryInfo(lParam, myMinMaxInfo, LenB(myMinMaxInfo))
        End If
    '\\ Paint event
    ElseIf wMsg = WM_PAINT Then
        '\\ lParam and wParam are not used
        Dim mUpdateRect As New EventVB.APIRect
        Dim rcThis As RECT
        Call GetUpdateRect(m_hwnd, rcThis, False)
        mUpdateRect.CreateFromPointer (VarPtr(rcThis))
        RaiseEvent Paint(mUpdateRect)

        
    ElseIf wMsg = WM_NCPAINT Then
        '\\ wParam is the handle to the update region or 1 if the whole non client
        '\\ area needs to be updated
        Dim dcThis As New ApiDeviceContext
        If wParam = 1 Then
            dcThis.hdc = Me.DeviceContextNC.hdc
        Else
            dcThis.hdc = GetDCEx(m_hwnd, wParam, (DCX_WINDOW Or DCX_INTERSECTRGN))
        End If
        RaiseEvent NonClientPaint(dcThis)

    '\\ Non client hit test
    ElseIf wMsg = WM_NCHITTEST Then
        Dim RetVal As enHitTestResult
        Dim Override As Boolean
                
        '\\ Adjust x and y to map to the non client rectangle
        x = APIDispenser.LoWord(lParam)
        y = APIDispenser.HiWord(lParam)
        With Me.RECT
            x = x - .Left
            y = y - .Top
        End With
        
        RaiseEvent HitTest(x, y, RetVal, Override)
        
        If Override Then
            Cancel = RetVal
            bDiscardMsg = True
        End If

    Else
        '\\ For all other events
        RaiseEvent WindowMessageFired(wMsg, wParam, lParam, bDiscardMsg, lWndProcRet)
    End If
    
    lWndProcRet = Cancel
    
End Sub

'\\ --[UnSetWindowStyle]----------------------------------------------------------------------
'\\ Unets the style bit specified to the window specified.  Note that many window style
'\\ bits cannot be used at run time :. use this with caution
'\\ Returns true if it succeeded
'\\ ----------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------
Public Function UnSetWindowStyle(ByVal newStyle As enWindowStyles, ByVal Extended As Boolean) As Boolean

Dim lStyle As Long
Dim lWSIndex As Long
Dim lret As Long

If Extended Then
    lWSIndex = GWL_EXSTYLE
Else
    lWSIndex = GWL_STYLE
End If

'\\ Get the current setting of that style bit
lStyle = GetWindowLongApi(m_hwnd, lWSIndex)

'\\ Add the new style bit to it
If IsWindowStyleSet(newStyle, Extended) Then
    lStyle = lStyle Xor newStyle
End If

'\\ Set it to the window
lret = SetWindowLongApi(m_hwnd, lWSIndex, lStyle)

'\\ Refresh the window
lret = UpdateWindow(m_hwnd)

UnSetWindowStyle = Not (IsWindowStyleSet(lStyle, Extended))

End Function
Public Property Get Enabled() As Boolean

    Enabled = IsWindowEnabledApi(m_hwnd)
    
End Property

Public Property Get Unicode() As Boolean

    Unicode = IsWindowUnicodeApi(m_hwnd)
    
End Property

Public Property Get Visible() As Boolean

    Visible = IsWindowVisibleApi(m_hwnd)
    
End Property



Public Property Get IsZoomed() As Boolean

    IsZoomed = IsZoomedApi(m_hwnd)
    
End Property

Public Property Get Key() As String

    Key = "HWND:" & m_hwnd

End Property

Public Function SetWindowLong(ByVal index As enGetWindowLon