-
Notifications
You must be signed in to change notification settings - Fork 8
/
Copy pathViStatic.cls
122 lines (90 loc) · 3.46 KB
/
ViStatic.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
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "ViWindow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Declare Function CreateWindowExW Lib "user32.dll" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleW" (ByVal lpModuleName As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_SETFONT As Long = &H30
Private Const WM_SETTEXT = &HC
Private hfFont As Long
'local variable(s) to hold property value(s)
Private mvarParentHwnd As Long 'local copy
Private mvarName As String 'local copy
Private mvarHwnd As Long 'local copy
Private mvarCaption As String 'local copy
Private mvarFont As GDIFont 'local copy
Private mvarListCount As Long
Public Property Get ListCount()
ListCount = mvarListCount
End Property
Public Property Get listIndex() As Long
Dim lngIndex As Long
lngIndex = SendMessage(mvarHwnd, CB_GETCURSEL, 0&, 0&)
listIndex = lngIndex
End Property
Public Property Let listIndex(ByVal lngIndex As Long)
SendMessage mvarHwnd, CB_SETCURSEL, lngIndex, 0&
End Property
Public Function AddString(strData As String)
SendMessage mvarHwnd, CB_ADDSTRING, 0, StrPtr(strData)
mvarListCount = mvarListCount + 1
End Function
Public Function Move(X As Long, Y As Long, Width As Long, Height As Long)
MoveWindow mvarHwnd, X, Y, Width, Height, False
End Function
Public Property Set Font(ByRef vData As GDIFont)
'used when assigning an Object to the property, on the left side of a Set statement.
'Syntax: Set x.Font = Form1
Set mvarFont = vData
SelectFont
End Property
Public Property Get Font() As GDIFont
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Font
Set Font = mvarFont
End Property
Public Property Let Text(newText As String)
Dim bString() As Byte
bString = newText
SendMessage mvarHwnd, WM_SETTEXT, 0&, StrPtr(bString)
End Property
Public Property Get hWnd() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Hwnd
hWnd = mvarHwnd
End Property
Private Function SelectFont()
On Error GoTo Handler
SelectFont = True
SendMessage mvarHwnd, WM_SETFONT, mvarFont.Handle, 0
Exit Function
Handler:
SelectFont = False
End Function
Public Sub Constructor(WindowClass As String, hWnd As Long, Optional AdditionalStyle As Long)
Class_Terminate
mvarHwnd = CreateWindowExW(0, StrPtr(WindowClass), StrPtr("Generic_ViEdit"), _
WS_VISIBLE Or WS_CHILD Or AdditionalStyle, _
10, 10, 500, 100, hWnd, 0, GetModuleHandle(0), 0)
If Not g_DefaultFont Is Nothing Then
Set mvarFont = g_DefaultFont
SelectFont
End If
End Sub
Private Sub Class_Terminate()
If mvarHwnd <> 0 Then
DestroyWindow mvarHwnd
End If
End Sub