-
Notifications
You must be signed in to change notification settings - Fork 40
/
clsVbeMenu.bas
223 lines (185 loc) · 7.31 KB
/
clsVbeMenu.bas
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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Option Compare Database
Private Const cstrCmdBarName As String = "Version Control"
' Model object used for menu commands (supports multiple versioning systems)
Private m_Model As IVersionControl
' Menu command bar
Private m_CommandBar As Office.CommandBar
' Menu button events
Private WithEvents m_evtSaveAll As VBIDE.CommandBarEvents
Attribute m_evtSaveAll.VB_VarHelpID = -1
Private WithEvents m_evtSave As VBIDE.CommandBarEvents
Attribute m_evtSave.VB_VarHelpID = -1
Private WithEvents m_evtCommit As VBIDE.CommandBarEvents
Attribute m_evtCommit.VB_VarHelpID = -1
Private WithEvents m_evtDiff As VBIDE.CommandBarEvents
Attribute m_evtDiff.VB_VarHelpID = -1
'---------------------------------------------------------------------------------------
' Procedure : Construct
' Author : Adam Waller
' Date : 5/15/2015
' Purpose : Construct an instance of this class using a specific model
'---------------------------------------------------------------------------------------
'
Public Sub Construct(cModel As IVersionControl)
' Save reference to model
If Not m_Model Is Nothing Then m_Model.Terminate
Set m_Model = cModel
' Verify that the required software is installed
If m_Model.HasRequiredSoftware(True) Then
' Set up toolbar
If CommandBarExists(cstrCmdBarName) Then
Set m_CommandBar = Application.VBE.CommandBars(cstrCmdBarName)
' Reassign buttons so we can capture events
RemoveAllButtons
Else
' Add toolbar
Set m_CommandBar = Application.VBE.CommandBars.Add
With m_CommandBar
.Name = cstrCmdBarName
.Position = msoBarTop
.Visible = True
End With
End If
' Assign/reassign buttons so we can capture events
AddAllButtons
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : CommandBarExists
' Author : Adam Waller
' Date : 5/15/2015
' Purpose : Returns true if the command bar exists. (Is visible)
'---------------------------------------------------------------------------------------
'
Private Function CommandBarExists(strName As String) As Boolean
Dim cmdBar As CommandBar
For Each cmdBar In Application.VBE.CommandBars
If cmdBar.Name = strName Then
CommandBarExists = True
Exit For
End If
Next cmdBar
End Function
'---------------------------------------------------------------------------------------
' Procedure : AddAllButtons
' Author : Adam Waller
' Date : 5/15/2015
' Purpose : Add the buttons to the command bar
'---------------------------------------------------------------------------------------
'
Private Sub AddAllButtons()
If m_CommandBar Is Nothing Then Exit Sub
' Add buttons with event handlers
With Application.VBE.Events
Set m_evtCommit = .CommandBarEvents(AddButton("Commit Module/Project", 270))
Set m_evtDiff = .CommandBarEvents(AddButton("Diff Module/Project", 2042, , True))
Set m_evtSave = .CommandBarEvents(AddButton("Export Selected", 3))
Set m_evtSaveAll = .CommandBarEvents(AddButton("Export All", 749, , , msoButtonIconAndCaption))
End With
End Sub
'---------------------------------------------------------------------------------------
' Procedure : AddButton
' Author : Adam Waller
' Date : 5/15/2015
' Purpose : Add a button to the command bar, and connects to event handler
'---------------------------------------------------------------------------------------
'
Private Function AddButton(strCaption As String, intFaceID As Integer, _
Optional intPositionBefore As Integer = 1, Optional blnBeginGroup As Boolean = False, Optional intStyle As MsoButtonStyle) As CommandBarButton
Dim btn As CommandBarButton
Set btn = m_CommandBar.Controls.Add(msoControlButton, , , intPositionBefore)
btn.Caption = strCaption
btn.FaceId = intFaceID
btn.Style = intStyle
If blnBeginGroup Then btn.BeginGroup = True
Set AddButton = btn
End Function
'---------------------------------------------------------------------------------------
' Procedure : RemoveAllButtons
' Author : Adam Waller
' Date : 5/15/2015
' Purpose : Removes all the buttons from the command bar
'---------------------------------------------------------------------------------------
'
Private Sub RemoveAllButtons()
Dim btn As CommandBarButton
If Not m_CommandBar Is Nothing Then
For Each btn In m_CommandBar.Controls
btn.Delete
Next btn
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Class_Terminate
' Author : Adam Waller
' Date : 5/15/2015
' Purpose : Release all references
'---------------------------------------------------------------------------------------
'
Private Sub Class_Terminate()
' Clear event handlers
Set m_evtCommit = Nothing
Set m_evtDiff = Nothing
Set m_evtSave = Nothing
' Finish cleaning up
RemoveAllButtons
If Not m_CommandBar Is Nothing Then
m_CommandBar.Delete
Set m_CommandBar = Nothing
End If
' Don't terminate a circular reference
' since menu is a child of the model
Set m_Model = Nothing
End Sub
'---------------------------------------------------------------------------------------
' Procedure : (multiple)
' Author : Adam Waller
' Date : 5/15/2015
' Purpose : Event handlers for button clicks
'---------------------------------------------------------------------------------------
'
Private Sub m_evtCommit_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
m_Model.Commit
handled = True
End Sub
Private Sub m_evtDiff_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
m_Model.Diff
handled = True
End Sub
Private Sub m_evtSave_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
If CloseAllFormsReports Then ExportSelected
handled = True
End Sub
Private Sub m_evtSaveAll_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
If CloseAllFormsReports Then m_Model.ExportAll
handled = True
End Sub
'---------------------------------------------------------------------------------------
' Procedure : ExportSelected
' Author : Adam Waller
' Date : 5/15/2015
' Purpose : Export the selected component or project
'---------------------------------------------------------------------------------------
'
Private Sub ExportSelected()
If SelectionInActiveProject Then
m_Model.Export
Else
MsgBox "Please select a component in " & CurrentProject.Name & " and try again.", vbExclamation, CodeProject.Name
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Terminate
' Author : Adam Waller
' Date : 6/2/2015
' Purpose : Manually fire the terminate event
'---------------------------------------------------------------------------------------
'
Public Sub Terminate()
Call Class_Terminate
End Sub