/
cwUpDown.cls
132 lines (114 loc) · 4.13 KB
/
cwUpDown.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "cwUpDown"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Event DataIndexChange()
'DataSource-Implementation-Vars
Private WithEvents mDS As cDataSource, mDataSourceKey As String, mDataField As String
Attribute mDS.VB_VarHelpID = -1
Public WithEvents VList As cwVList
Attribute VList.VB_VarHelpID = -1
Private WithEvents W As cWidgetBase, mShowHoverBar As Boolean
Attribute W.VB_VarHelpID = -1
Private Sub Class_Initialize()
Set VList = New cwVList
Set W = VList.Widget '<- this does not create a new WidgetBase-Instance, but "inherits" the Vlist-WidgetBase
W.FocusColor = -1
W.BorderColor = -1
W.BackColor = -1
ShowHoverBar = True
End Sub
Public Property Get Widget() As cWidgetBase
Set Widget = W
End Property
Public Property Get Widgets() As cWidgets
Set Widgets = W.Widgets
End Property
Public Property Get ShowHoverBar() As Boolean
ShowHoverBar = mShowHoverBar
End Property
Public Property Let ShowHoverBar(ByVal RHS As Boolean)
mShowHoverBar = RHS
VList.ShowHoverBar = RHS
End Property
'***************** Start of typical-DataSource-related Procedures ***************
Public Function SetDataSource(CollectionOrRecordset As Object, Key As String, Optional DataField As String) As cDataSource
If Len(DataField) Then mDataField = DataField
Set SetDataSource = New_c.DataSource
SetDataSource.Init CollectionOrRecordset, Key, Cairo.DataSourceDispatcher
Set DataSource = SetDataSource
End Function
Public Property Get DataSourceKey() As String
DataSourceKey = mDataSourceKey
End Property
Public Property Let DataSourceKey(ByVal NewValue As String)
mDataSourceKey = NewValue
On Error Resume Next
Set DataSource = Cairo.DataSources(mDataSourceKey)
On Error GoTo 0
End Property
Public Property Get DataSource() As cDataSource
Set DataSource = mDS
End Property
Public Property Set DataSource(DS As cDataSource)
VList.ListCount = 0
Set mDS = DS
If mDS Is Nothing Then Exit Property
mDataSourceKey = mDS.Key
VList.ListCount = mDS.RecordCount
If mDS.RecordCount Then mDS.MoveLast: mDS.MoveFirst
End Property
Public Property Get DataField() As String
DataField = mDataField
End Property
Public Property Let DataField(ByVal NewValue As String)
mDataField = NewValue
End Property
Private Property Get FieldIndex() As Long
Dim i As Long
If mDS Is Nothing Then Exit Property
For i = 0 To mDS.FieldCount - 1
If StrComp(mDS.FieldName(i), mDataField, vbTextCompare) = 0 Then FieldIndex = i: Exit For
Next i
End Property
Private Sub mDS_Move(ByVal NewRowIdxZeroBased As Long)
If VList.ListIndex <> NewRowIdxZeroBased Then VList.ListIndex = NewRowIdxZeroBased
End Sub
Private Sub mDS_NewDataContentArrived()
VList.ListCount = mDS.RecordCount
VList.ListIndex = IIf(VList.ListCount, 0, -1)
End Sub
'***************** End of typical-DataSource-related Procedures ***************
Public Property Get DataIndex() As Long
DataIndex = VList.ScrollIndex
End Property
Public Property Get DataValue()
DataValue = GetDataValue(DataIndex)
End Property
Private Function GetDataValue(Index As Long)
If mDS Is Nothing Then GetDataValue = "UpDown": Exit Function
If Index < 0 Or Index >= mDS.RecordCount Then Exit Function
GetDataValue = mDS.ValueMatrix(Index, FieldIndex)
End Function
Private Sub W_Resize()
VList.RowHeight = W.ScaleHeight - 1
End Sub
Private Sub VList_ScrollIndexChange()
VList.ListIndex = VList.ScrollIndex
If Not mDS Is Nothing Then mDS.AbsolutePosition = VList.ScrollIndex + 1
RaiseEvent DataIndexChange
End Sub
Private Sub VList_OwnerDrawItem(ByVal Index As Long, CC As cCairoContext, ByVal dx As Single, ByVal dy As Single, ByVal Alpha As Single)
W.SelectFontSettingsInto CC
CC.DrawText 1, 1, dx, dy, CStr(GetDataValue(Index)), True, vbCenter, 0, True
End Sub