-
Notifications
You must be signed in to change notification settings - Fork 1
/
cfMain.cls
214 lines (167 loc) · 7.75 KB
/
cfMain.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
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
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "cfMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------
' Module : cfMain
' Author : beededea
' Date : 28/05/2023
' Purpose :
'---------------------------------------------------------------------------------------
Option Explicit
Public WithEvents aboutForm As cWidgetForm
Attribute aboutForm.VB_VarHelpID = -1
Public WithEvents stampForm As cWidgetForm
Attribute stampForm.VB_VarHelpID = -1
'---------------------------------------------------------------------------------------
' Procedure : InitAndShowAsFreeForm
' Author :
' Date : 27/04/2023
' Purpose :
'---------------------------------------------------------------------------------------
'
Public Sub InitAndShowAsFreeForm(ByVal X As Long, ByVal Y As Long, Optional ByVal dx As Long, Optional ByVal dy As Long, Optional ByVal Caption As String)
Const WFFStyleTool As Integer = 7 ' additional styles above the normal five WFFStyleTool = 7 makes the taskbar button go away
On Error GoTo InitAndShowAsFreeForm_Error
' create an invisible form using a Cairo Widget Form with the predefined caption and location
Set stampForm = Cairo.WidgetForms.Create(WFFStyleTool, Caption, , 1200, 1200)
' make the form transparent
stampForm.WidgetRoot.BackColor = -1
' create a new stamp widget with a name, location and width, runs Class_Initialize
Set stampWidget = stampForm.Widgets.Add(New cwStamp, "stamp", 0, 0, 1000, 1000)
' I do not 'get' the size/position relationship between the form and the widget on the form. Seems peculiar to me.
'NOTE that when you move a widget by dragging, you are moving the invisible form it is drawn upon.
stampForm.Move X, Y ' position the form & display it
stampForm.Load
' set the z-ordering of the main form
Call setWindowZordering
' create a second invisible form using a Cairo Widget Form with the predefined caption and sizing
Set aboutForm = Cairo.WidgetForms.Create(WFFStyleTool, Caption, , 350, 675)
' make the about form transparent
aboutForm.WidgetRoot.BackColor = -1
' create a new stamp widget with a name and location, first step of that is to run Class_Initialize
Set aboutWidget = aboutForm.Widgets.Add(New cwAbout, "about", 0, 0, 470, 670)
On Error GoTo 0
Exit Sub
InitAndShowAsFreeForm_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure InitAndShowAsFreeForm of Class Module cfMain"
End Sub
'---------------------------------------------------------------------------------------
' Procedure : stampForm_DblClick
' Author : beededea
' Date : 05/05/2023
' Purpose :
'---------------------------------------------------------------------------------------
'
Public Sub stampForm_DblClick()
Dim userprof As String: userprof = vbNullString
Dim thisCommand As String: thisCommand = vbNullString
On Error GoTo stampForm_DblClick_Error
If LTrim$(PrDblClickCommand) = vbNullString Then Exit Sub
thisCommand = PrDblClickCommand
If InStr(thisCommand, "%userprofile%") Then
userprof = Environ$("USERPROFILE")
thisCommand = Replace(thisCommand, "%userprofile%", userprof)
End If
' .91 DAEB 08/12/2022 frmMain.frm SteamyDock responds to %systemroot% environment variables during runCommand
If InStr(thisCommand, "%systemroot%") Then
userprof = Environ$("SYSTEMROOT")
thisCommand = Replace(thisCommand, "%systemroot%", userprof)
End If
If SHIFT_1 = True Then
SHIFT_1 = False
Call ShellExecute(fMain.stampForm.hwnd, "Open", PrOpenFile, vbNullString, App.Path, 1)
Else
Call ShellExecute(fMain.stampForm.hwnd, "runas", thisCommand, vbNullString, App.Path, 1)
End If
On Error GoTo 0
Exit Sub
stampForm_DblClick_Error:
With Err
If .Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure stampForm_DblClick of Class Module cfMain"
Resume Next
End If
End With
End Sub
'Private Sub stampForm_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
' 'If pinClicked = True Then MsgBox "X = " & x & " Y = " & y & " pinClicked = " & pinClicked
'
'End Sub
'---------------------------------------------------------------------------------------
' Procedure : stampForm_MouseMove
' Author : beededea
' Date : 05/05/2023
' Purpose :
'---------------------------------------------------------------------------------------
'
Private Sub stampForm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo stampForm_MouseMove_Error
If stampWidget.Locked = True Then Exit Sub
If PrIgnoreMouse = "1" Then Exit Sub
Static x0 As Single
Static y0 As Single
If Button Then stampForm.Move stampForm.Left + X - x0, stampForm.Top + Y - y0 Else x0 = X: y0 = Y
On Error GoTo 0
Exit Sub
stampForm_MouseMove_Error:
With Err
If .Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure stampForm_MouseMove of Class Module cfMain"
Resume Next
End If
End With
End Sub
'---------------------------------------------------------------------------------------
' Procedure : stampForm_KeyDown
' Author : beededea
' Date : 01/06/2019
' Purpose : get F5 and SHIFT keypresses
'---------------------------------------------------------------------------------------
'
Private Sub stampForm_KeyDown(ByRef KeyCode As Integer, ByRef Shift As Integer)
On Error GoTo stampForm_KeyDown_Error
Call getKeyPress(KeyCode, Shift)
On Error GoTo 0
Exit Sub
stampForm_KeyDown_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure stampForm_KeyDown of Class Module cfMain"
End Sub
'
'---------------------------------------------------------------------------------------
' Procedure : stampForm_MouseUp
' Author : beededea
' Date : 05/05/2023
' Purpose : save the form x,y position when ever the stamp/form is dragged
'---------------------------------------------------------------------------------------
'
Private Sub stampForm_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo stampForm_MouseUp_Error
If stampWidget.Locked = True Then Exit Sub
' no point in saving when prefs are visible.
If pennyRedPrefs.IsVisible = False Then ' checks without activating the form - important!.
PrMaximiseFormX = Str$(stampForm.Left) ' saving in pixels
PrMaximiseFormY = Str$(stampForm.Top)
sPutINISetting "Software\PennyRed", "maximiseFormX", PrMaximiseFormX, PrSettingsFile
sPutINISetting "Software\PennyRed", "maximiseFormY", PrMaximiseFormY, PrSettingsFile
End If
'Static x0, y0: If Button Then stampForm.Move stampForm.Left + X - x0, stampForm.Top + Y - y0 Else x0 = X: y0 = Y
On Error GoTo 0
Exit Sub
stampForm_MouseUp_Error:
With Err
If .Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure stampForm_MouseUp of Class Module cfMain"
Resume Next
End If
End With
End Sub