apicommctlpager.cls

几个不错的VB例子

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ApiCommCtlPager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' ##MODULE_DESCRIPTION This class provides methods and properties for manipulating _
instances of the "Pager" windows custom control

Private m_hwnd As Long
Private mChildWnd As Long


Private Const PGN_FIRST = -900
Public Enum enPagerNotificationMessages
    PGN_SCROLL = (PGN_FIRST - 1)
    PGN_CALCSIZE = (PGN_FIRST - 2)
End Enum


Private Const PGM_FIRST = &H1400
Public Enum enPagerMessages
    PGM_SETCHILD = (PGM_FIRST + 1)      '\\ lParam == hwnd
    PGM_RECALCSIZE = (PGM_FIRST + 2)
    PGM_FORWARDMOUSE = (PGM_FIRST + 3)  '\\ wParam = bForward
    PGM_SETBKCOLOR = (PGM_FIRST + 4)    '\\ lParam = clr
    PGM_GETBKCOLOR = (PGM_FIRST + 5)
    PGM_SETBORDER = (PGM_FIRST + 6)     '\\ lParam = iBorder
    PGM_GETBORDER = (PGM_FIRST + 7)
    PGM_SETPOS = (PGM_FIRST + 8)        '\\ lParam = iPos
    PGM_GETPOS = (PGM_FIRST + 9)
    PGM_SETBUTTONSIZE = (PGM_FIRST + 10) '\\lParam = Size
    PGM_GETBUTTONSIZE = (PGM_FIRST + 11)
    PGM_GETBUTTONSTATE = (PGM_FIRST + 12)     '\\ lParam = iButton
    PGM_GETDROPTARGET = &H2004
End Enum

Public Enum enPagerScrollDirections
    PGF_SCROLLUP = 1
    PGF_SCROLLDOWN = 2
    PGF_SCROLLLEFT = 4
    PGF_SCROLLRIGHT = 8
End Enum

Public Enum enPagerScrollKeys
    PGK_SHIFT = 1
    PGK_CONTROL = 2
    PGK_MENU = 4
End Enum

Public Enum enPagerCalcSizeDirection
    PGF_CALCWIDTH = 1
    PGF_CALCHEIGHT = 2
End Enum

Public Enum enPagerControlStyles
    PGS_VERT = &H0
    PGS_HORZ = &H1
    PGS_AUTOSCROLL = &H2
    PGS_DRAGNDROP = &H4
End Enum

Public Enum enPagerButtonStates
    PGF_INVISIBLE = 0     ' ##  Scroll button is not visible
    PGF_NORMAL = 1        ' ##  Scroll button is in normal state
    PGF_GRAYED = 2        ' ##  Scroll button is in grayed state
    PGF_DEPRESSED = 4     ' ##  Scroll button is in depressed state
    PGF_HOT = 8           ' ##  Scroll button is in hot state
End Enum

Public Enum enPagerButtonid
    PGB_TOPORLEFT = 0
    PGB_BOTTOMORRIGHT = 1
End Enum

Private Type NMPGSCROLL
    NMHDR_hwndFrom As Long
    NMHDR_idfrom As Long
    NMHDR_code As Long
    fwKeys As Integer             ' ##  Specifies which keys are down when this notification is send
    rcParent_Left As Long ' ##  Contains Parent Window Rect
    rcParent_Top As Long
    rcParent_Right As Long
    rcParent_Bottom As Long
    iDir As Long              ' ##  Scrolling Direction
    iXpos As Long            ' ##  Horizontal scroll position
    iYpos As Long             ' ##  Vertical scroll position
    iScroll As Long           ' ##  [in/out] Amount to scroll
End Type

Private Type NMPGCALCSIZE
    NMHDR_hwndFrom As Long
    NMHDR_idfrom As Long
    NMHDR_code As Long
    dwFlag As Long
    iWidth As Long
    iHeight As Long
End Type

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Property Let BackgroundColour(ByVal newColour As Long)

Dim lret As Long

lret = SendMessage(m_hwnd, PGM_SETBKCOLOR, 0, ByVal newColour)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiCommCtlPager:BackgroundColour", GetLastSystemError
End If

End Property

Public Property Get BackgroundColour() As Long

Dim lret As Long

lret = SendMessage(m_hwnd, PGM_GETBKCOLOR, 0, ByVal 0&)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiCommCtlPager:BackgroundColour", GetLastSystemError
End If
BackgroundColour = lret

End Property

Public Property Let Border(ByVal newBorder As Long)

Dim lret As Long

lret = SendMessage(m_hwnd, PGM_SETBORDER, 0, ByVal newBorder)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiCommCtlPager:Border", GetLastSystemError
End If

End Property

Public Property Get Border() As Long

Dim lret As Long

lret = SendMessage(m_hwnd, PGM_GETBORDER, 0, ByVal 0&)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiCommCtlPager:Border", GetLastSystemError
End If
Border = lret

End Property


Public Property Let ButtonSize(ByVal newButtonSize As Long)

Dim lret As Long

lret = SendMessage(m_hwnd, PGM_SETBUTTONSIZE, 0, ByVal newButtonSize)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiCommCtlPager:ButtonSize", GetLastSystemError
End If

End Property

Public Property Get ButtonSize() As Long

Dim lret As Long

lret = SendMessage(m_hwnd, PGM_GETBUTTONSIZE, 0, ByVal 0&)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiCommCtlPager:ButtonSize", GetLastSystemError
End If
ButtonSize = lret

End Property

Public Property Get ChildWindow() As ApiWindow

Dim wndChild As ApiWindow

Set wndChild = New ApiWindow

wndChild.hwnd = mChildWnd
Set ChildWindow = wndChild

Set wndChild = Nothing

End Property

Public Property Let ChildWindow(ByVal hwndChild As ApiWindow)

Dim lret As Long

If hwndChild Is Nothing Then
    lret = SendMessage(m_hwnd, PGM_SETCHILD, 0, ByVal 0&)
    mChildWnd = 0
Else
    lret = SendMessage(m_hwnd, PGM_SETCHILD, 0, ByVal hwndChild.hwnd)
    mChildWnd = hwndChild.hwnd
End If
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiCommCtlPager:ChildWindow", GetLastSystemError
End If
BackgroundColour = lret

    
End Property

Public Property Get ClassName() As String

    ClassName = "SysPager"
    
End Property


Public Property Get hwnd() As Long

    hwnd = m_hwnd
    
End Property

Public Property Let hwnd(ByVal newHwnd As Long)

    If newHwnd <> m_hwnd Then
        m_hwnd = newHwnd
    End If
    
End Property
Public Property Let Position(ByVal newPosition As Long)


Dim lret As Long

lret = SendMessage(m_hwnd, PGM_SETPOS, 0, ByVal newPosition)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiCommCtlPager:Position", GetLastSystemError
End If

End Property


Public Property Get Position() As Long

Dim lret As Long

lret = SendMessage(m_hwnd, PGM_GETPOS, 0, ByVal 0&)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiCommCtlPager:Position", GetLastSystemError
End If
Position = lret

End Property


Public Sub RecalcSize()

Dim lret As Long

lret = SendMessage(m_hwnd, PGM_RECALCSIZE, 0, ByVal 0&)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiCommCtlPager:RecalcSize", GetLastSystemError
End If

End Sub


Private Sub Class_Initialize()

'\\ make sure the common controls class is initialised
Call APIDispenser.InitCommonControls(ICC_PAGESCROLLER_CLASS)

End Sub