apiwindow.cls

几个不错的VB例子

'\\ ----------------------------------------------------------------------------------------
Public Function IsWindowStyleSet(ByVal TheStyle As enWindowStyles, ByVal Extended As Boolean) As Boolean

Dim lStyle As Long
Dim lWSIndex 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)
IsWindowStyleSet = (lStyle And TheStyle)

End Function





Public Property Let MaxButton(ByVal newSetting As Boolean)

If newSetting Then
    SetWindowStyle WS_MAXIMIZEBOX, False
Else
    UnSetWindowStyle WS_MAXIMIZEBOX, False
End If

End Property

Public Property Get MaxButton() As Boolean

MaxButton = IsWindowStyleSet(WS_MAXIMIZEBOX, False)

End Property

Public Property Get MaximiseBoxRectangle() As APIRect

Dim rcThis As New APIRect

With rcThis
    .Right = (Width - BorderWidth)
    .Top = BorderHeight
    If IsWindowStyleSet(WS_EX_TOOLWINDOW, True) Then
        .Right = .Right - APIDispenser.System.Metrics(SM_CXSMSIZE)
        .Bottom = .Top + APIDispenser.System.Metrics(SM_CYSMSIZE)
        .Left = .Right - APIDispenser.System.Metrics(SM_CXSMSIZE)
    Else
        .Right = .Right - APIDispenser.System.Metrics(SM_CXSIZE)
        .Bottom = .Top + APIDispenser.System.Metrics(SM_CYSIZE)
        .Left = .Right - APIDispenser.System.Metrics(SM_CXSIZE)
    End If
End With

Set MaximiseBoxRectangle = rcThis

End Property

Public Property Get Menu() As ApiMenu

Dim lret As Long

lret = GetMenuApi(m_hwnd)
If Err.LastDllError = 0 And lret > 0 Then
    If mMenu Is Nothing Then
        Set mMenu = New ApiMenu
    End If
    mMenu.hMenu = lret
    Set Menu = mMenu
End If

End Property





Public Property Let MinButton(ByVal newSetting As Boolean)

If newSetting Then
    SetWindowStyle WS_MINIMIZEBOX, False
Else
    UnSetWindowStyle WS_MINIMIZEBOX, False
End If

End Property

Public Property Get MinButton() As Boolean

MinButton = IsWindowStyleSet(WS_MINIMIZEBOX, False)

End Property

Public Property Get MinimiseBoxRectangle() As APIRect

Dim rcThis As New APIRect

With rcThis
    .Right = (Width - BorderWidth)
    .Top = BorderHeight
    If IsWindowStyleSet(WS_EX_TOOLWINDOW, True) Then
        .Right = .Right - (APIDispenser.System.Metrics(SM_CXSMSIZE) * 2)
        .Bottom = .Top + APIDispenser.System.Metrics(SM_CYSMSIZE)
        .Left = .Right - APIDispenser.System.Metrics(SM_CXSMSIZE)
    Else
        .Right = .Right - (APIDispenser.System.Metrics(SM_CXSIZE) * 2)
        .Bottom = .Top + APIDispenser.System.Metrics(SM_CYSIZE)
        .Left = .Right - APIDispenser.System.Metrics(SM_CXSIZE)
    End If
End With

Set MinimiseBoxRectangle = rcThis

End Property

Public Property Let MouseCapture(ByVal CaptureMouse As Boolean)

Dim lret As Long

If CaptureMouse Then
    mPrevCapture = SetCaptureApi(m_hwnd)
Else
    lret = SetCaptureApi(mPrevCapture)
End If

End Property

Public Property Get MouseCapture() As Boolean

MouseCapture = (GetCaptureApi() = m_hwnd)

End Property

Public Property Let MouseHoverTimeout(ByVal newTimeout As Long)

Dim lret As Long
Dim mheThis As TRACKMOUSESTRUCT

With mheThis
    .cbSize = Len(mheThis)
    .dwFlags = TME_HOVER Or TME_LEAVE
    .hwndTrack = m_hwnd
    .dwHoverTime = newTimeout
End With

If APIDispenser.System.IsRequiredSystem("TrackMouse", ver_Win_98) Then
    lret = TrackMouseEvent(mheThis)
    If Err.LastDllError Then
        ReportError Err.LastDllError, "ApiWindow:MouseHoverTimeout (Let)", GetLastSystemError
    End If
End If

End Property

Public Property Get MouseHoverTimeout() As Long

Dim lret As Long
Dim mheThis As TRACKMOUSESTRUCT

With mheThis
    .cbSize = Len(mheThis)
    .dwFlags = TME_QUERY
    .hwndTrack = m_hwnd
End With

If APIDispenser.System.IsRequiredSystem("TrackMouse", ver_Win_98) Then
    lret = TrackMouseEvent(mheThis)
    If Err.LastDllError Then
        ReportError Err.LastDllError, "ApiWindow:MouseHoverTimeout (get)", GetLastSystemError
    End If
End If

MouseHoverTimeout = mheThis.dwHoverTime

End Property

Friend Property Get OldProcAddress() As Long

    OldProcAddress = mOldProcAddress
    
End Property

Public Property Get RECT() As APIRect

Dim mRect As APIRect
Dim lpRect As RECT
Dim lret As Long

Set mRect = New APIRect
lret = GetWindowRectApi(m_hwnd, lpRect)
If Err.LastDllError = 0 Then
    Call mRect.CreateFromPointer(VarPtr(lpRect))
End If
Set RECT = mRect

End Property

Public Sub Refresh()

Dim lret As Long

lret = InvalidateRectByPointerApi(m_hwnd, 0, True)

End Sub


Public Property Set Region(ByVal newRegion As ApiRegion)

Dim lret As Long

If newRegion Is Nothing Then
    Set mRegion = Nothing
Else
    If newRegion.hRgn <> Region.hRgn Then
        Set mRegion = newRegion
        lret = SetWindowRgn(m_hwnd, mRegion.hRgn, True)
    End If
End If

End Property

Public Property Get Region() As ApiRegion

Dim lret As Long

If mRegion Is Nothing Then
    Set mRegion = New ApiRegion
End If
lret = GetWindowRgn(m_hwnd, mRegion.hRgn)
If Err.LastDllError = 0 And lret > 0 Then
    mRegion.hRgn = lret
End If
Set Region = mRegion

End Property

Public Sub ScrollWindow(ByVal dX As Long, ByVal dY As Long, ScrollMethod As enScrollWindow)

Dim lret As Long
Dim lpUpdate As RECT

lret = ScrollWindowExAPI(m_hwnd, dX, dY, vbNull, vbNull, vbNull, lpUpdate, ScrollMethod)
If Err.LastDllError = 0 Then

Else
    Call ReportError(Err.LastDllError, "ApiWindow:ScrollWindow", GetLastSystemError)
End If

End Sub

'\\ --[SelectedText]----------------------------------------------------------------------------
'\\ Returns the text that is in the currently selected part of this window
'\\ (Allows the imlementation of .SelText on controls that don't have that member)
'\\ ----------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------
Public Property Get SelectedText() As String

Dim sSelectedText As String
Dim lSelStart As Integer
Dim lSelEnd As Integer
Dim lret As Long

Dim lSelMsg As Long

'\\ Select the appropriate message to query the selection according to the window type
If Me.WindowBaseClass = "EDIT" Then
    lSelMsg = EM_GETSEL
ElseIf Me.WindowBaseClass = "COMBOBOX" Then
    lSelMsg = CB_GETEDITSEL
Else
    '\\ If a control supports selected items, it should use the same message
    lSelMsg = EM_GETSEL
End If

lret = SendMessageByLong(Me.hwnd, lSelMsg, 0, 0)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiWindow:SelectedText", GetLastSystemError
Else
    lSelEnd = APIDispenser.HiWord(lret)
    lSelStart = APIDispenser.LoWord(lret)
    sSelectedText = Me.WindowText
    If lSelEnd > 0 Then
        sSelectedText = Left$(sSelectedText, lSelEnd)
    End If
    If lSelStart > 0 And lSelStart < lSelEnd Then
        sSelectedText = Mid$(sSelectedText, lSelStart)
    End If
End If

SelectedText = sSelectedText

End Property

Public Function SendMessage(ByVal wMsg As WindowMessages, ByVal wParam As Long, lParam As Long) As Long

Dim lret As Long
Dim lThis As Long
Dim sThis As String

lret = SendMessageLong(m_hwnd, wMsg, wParam, lParam)

If Err.LastDllError = 0 Then
    SendMessage = lret
End If

End Function

'\\ --[SetWindowStyle]----------------------------------------------------------------------
'\\ Sets 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 SetWindowStyle(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
lStyle = lStyle Or newStyle

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

'\\ For some styles to take effect, the window must be redrawn...
lret = UpdateWindow(m_hwnd)

SetWindowStyle = Me.IsWindowStyleSet(lStyle, Extended)

End Function

Public Property Get SysmenuBoxRectangle() As APIRect

Dim rcThis As New APIRect

With rcThis
    .Left = BorderWidth
    .Top = BorderHeight
    If IsWindowStyleSet(WS_EX_TOOLWINDOW, True) Then
        .Bottom = .Top + APIDispenser.System.Metrics(SM_CYSMSIZE)
        .Right = .Left + APIDispenser.System.Metrics(SM_CXSMSIZE)
    Else
        .Bottom = .Top + APIDispenser.System.Metrics(SM_CYSIZE)
        .Right = .Left + APIDispenser.System.Metrics(SM_CXSIZE)
    End If
End With

Set SysmenuBoxRectangle = rcThis