vbAccelerator - Contents of code file: cWorkAreas.cls
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "cWorkAreas"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private m_hWnd As Long
Private m_lIndex As Long
Friend Function fInit(ByVal hWnd As Long)
m_hWnd = hWnd
End Function
Private Function pbVerify(ByRef ctlThis As vbalListViewCtl) As Boolean
Dim lPtr As Long
If IsWindow(m_hWnd) Then
lPtr = GetProp(m_hWnd, gcObjectProp)
If Not (lPtr = 0) Then
Set ctlThis = ObjectFromPtr(lPtr)
pbVerify = True
Else
gErr 1, "cWorkAreas"
End If
Else
gErr 1, "cWorkAreas"
End If
End Function
Public Property Get Count() As Long
Dim ctl As vbalListViewCtl
If (pbVerify(ctl)) Then
Count = ctl.fWorkAreaCount()
End If
End Property
Public Function Add( _
Optional Index As Variant, _
Optional Key As Variant, _
Optional left As Variant, _
Optional top As Variant, _
Optional Width As Variant, _
Optional Height As Variant _
) As cWorkArea
Dim ctl As vbalListViewCtl
Dim i As Long
Dim lIndex As Long
Dim lId As Long
If (pbVerify(ctl)) Then
' Check key ok
If Not IsMissing(Key) Then
If IsNumeric(Key) Then
gErr 4, "cWorkAreas"
Exit Function
Else
For i = 1 To ctl.fWorkAreaCount
If (ctl.fWorkAreaKey(i) = Key) Then
gErr 5, "cWorkAreas"
Exit Function
End If
Next i
End If
Else
Key = ""
End If
' Key is ok, is the Index in range?
lIndex = 0
If Not IsMissing(Index) Then
If (Index < 0) Or (Index > ctl.fWorkAreaCount) Then
gErr 6, "cWorkAreas"
Exit Function
Else
lIndex = Index
End If
End If
' ok
lId = ctl.fAddWorkArea(lIndex, Key, left, top, Width, Height)
If (lId > 0) Then
Dim cWA As New cWorkArea
cWA.fInit m_hWnd, lId
Set Add = cWA
End If
End If
End Function
Public Sub Clear()
Dim ctl As vbalListViewCtl
If (pbVerify(ctl)) Then
ctl.fWorkAreasClear
End If
End Sub
Public Property Get Exists(Index As Variant) As Boolean
Dim ctl As vbalListViewCtl
If (pbVerify(ctl)) Then
If IsNumeric(Index) Then
If (Index > 0) And (Index <= ctl.fWorkAreaCount()) Then
m_lIndex = Index
Exists = True
End If
Else
Dim i As Long
For i = 1 To ctl.fWorkAreaCount
If (ctl.fWorkAreaKey(i) = Index) Then
m_lIndex = i
Exists = True
End If
Next i
End If
End If
End Property
Public Property Get Item(Index As Variant) As cWorkArea
Attribute Item.VB_UserMemId = 0
Dim ctl As vbalListViewCtl
If (pbVerify(ctl)) Then
If Exists(Index) Then
Dim cWA As New cWorkArea
cWA.fInit m_hWnd, ctl.fWorkAreaIdForIndex(m_lIndex)
Set Item = cWA
End If
End If
End Property
Public Sub Remove(Index As Variant)
Dim ctl As vbalListViewCtl
If (pbVerify(ctl)) Then
ctl.fRemoveWorkArea m_lIndex
End If
End Sub
|
|