-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathsplashForm.frm
231 lines (194 loc) · 7.56 KB
/
splashForm.frm
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
224
225
226
227
228
229
230
231
VERSION 5.00
Begin VB.Form splashForm
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 8535
ClientLeft = 0
ClientTop = 0
ClientWidth = 6075
LinkTopic = "Form1"
ScaleHeight = 8535
ScaleWidth = 6075
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.Timer splashShrinkerTimer
Enabled = 0 'False
Interval = 1
Left = 720
Top = 4680
End
Begin VB.CheckBox chkSplashDisable
BackColor = &H00FFFFFF&
Caption = "Suppress this splash pop-up"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 1470
TabIndex = 0
ToolTipText = "Click here and the splash screen will never show again"
Top = 8220
Width = 3120
End
Begin VB.Timer splashTimer
Enabled = 0 'False
Interval = 2500
Left = 705
Top = 5250
End
Begin VB.PictureBox picSplash
BorderStyle = 0 'None
Height = 8550
Left = 0
Picture = "splashForm.frx":0000
ScaleHeight = 8550
ScaleWidth = 6060
TabIndex = 1
ToolTipText = "Click anywhere to hide the splash screen"
Top = 0
Width = 6060
End
End
Attribute VB_Name = "splashForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' .01 DAEB splashForm new splashShrinkerTimer_Timer
' .02 DAEB splashForm new form load subroutine
' .03 DAEB splashForm.frm 09/02/2021 handling any potential divide by zero
Public splashTimerCount As Integer
Public splashWidth As Integer
Public splashHeight As Integer
Public splashFormWidth As Integer
Public pic As Picture
'---------------------------------------------------------------------------------------
' Procedure : chkSplashDisable_Click
' Author : beededea
' Date : 02/09/2020
' Purpose :
'---------------------------------------------------------------------------------------
'
Private Sub chkSplashDisable_Click()
On Error GoTo chkSplashDisable_Click_Error
splashForm.Hide
If chkSplashDisable.Value = 1 Then
sDSplashStatus = "0"
Else
sDSplashStatus = "1"
End If
PutINISetting "Software\SteamyDock\DockSettings", "SplashStatus", sDSplashStatus, dockSettingsFile
PutINISetting "Software\SteamyDock\DockSettings", "lastChangedByWhom", "steamyDock", dockSettingsFile
PutINISetting "Software\SteamyDock\DockSettings", "lastIconChanged", "9999", dockSettingsFile
On Error GoTo 0
Exit Sub
chkSplashDisable_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure chkSplashDisable_Click of Form splashForm"
End Sub
' .02 DAEB splashForm new form load subroutine
'---------------------------------------------------------------------------------------
' Procedure : Form_Load
' Author : beededea
' Date : 23/01/2021
' Purpose : sets some resizing variables and loads the splash image into a picture object
'---------------------------------------------------------------------------------------
'
Private Sub Form_Load()
On Error GoTo Form_Load_Error
splashTimerCount = 0
splashFormWidth = splashForm.Width
If fFExists(App.Path & "\steamydock-splash.jpg") Then
Set pic = LoadPicture(App.Path & "\steamydock-splash.jpg")
End If
splashWidth = ScaleX(pic.Width, vbHimetric, vbTwips)
splashHeight = ScaleY(pic.Height, vbHimetric, vbTwips)
On Error GoTo 0
Exit Sub
Form_Load_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_Load of Form splashForm"
End Sub
'---------------------------------------------------------------------------------------
' Procedure : picSplash_Click
' Author : beededea
' Date : 23/01/2021
' Purpose :
'---------------------------------------------------------------------------------------
'
Private Sub picSplash_Click()
On Error GoTo picSplash_Click_Error
splashForm.Hide
splashShrinkerTimer.Enabled = False
On Error GoTo 0
Exit Sub
picSplash_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure picSplash_Click of Form splashForm"
End Sub
' .01 DAEB splashForm new splashShrinkerTimer_Timer STARTS
'---------------------------------------------------------------------------------------
' Procedure : splashShrinkerTimer_Timer
' Author : beededea
' Date : 23/01/2021
' Purpose : resizes the splash picture box x & y as a ratio but resizes the underlying form
' as a simple decrement, leaving an interesting effect as it does so.
'---------------------------------------------------------------------------------------
'
Private Sub splashShrinkerTimer_Timer()
On Error GoTo splashShrinkerTimer_Timer_Error
If splashForm.Height > 51 Then splashForm.Height = splashForm.Height - 50
If splashForm.Width > 51 Then
splashForm.Width = splashForm.Width - 50
picSplash.Width = picSplash.Width - 50
If splashWidth = 0 Then splashWidth = 1 ' .03 DAEB splashForm.frm 09/02/2021 handling any potential divide by zero
sngRatio = picSplash.Width / splashWidth
If splashHeight * sngRatio > picSplash.Height Then
If splashHeight = 0 Then splashHeight = 1 ' .03 DAEB splashForm.frm 09/02/2021 handling any potential divide by zero
sngRatio = picSplash.Height / splashHeight
End If
picSplash.AutoRedraw = True
picSplash.PaintPicture pic, 0, 0, splashWidth * sngRatio, splashHeight * sngRatio
Else
splashShrinkerTimer.Enabled = False
splashForm.Hide
splashForm.Width = 6075
splashForm.Height = 8535
picSplash.Width = 6060
picSplash.Height = 8550
picSplash.Cls
picSplash.AutoRedraw = True
picSplash.PaintPicture pic, 0, 0, 6060, 8550
End If
If splashForm.Width <= 1 Or splashForm.Height <= 1 Then
splashShrinkerTimer.Enabled = False
End If
On Error GoTo 0
Exit Sub
splashShrinkerTimer_Timer_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure splashShrinkerTimer_Timer of Form splashForm"
End Sub
' .01 DAEB splashForm ENDS
'---------------------------------------------------------------------------------------
' Procedure : splashTimer_Timer
' Author : beededea
' Date : 23/01/2021
' Purpose : does nothing first iteration, then triggers the resizing animation timer
'---------------------------------------------------------------------------------------
'
Private Sub splashTimer_Timer()
On Error GoTo splashTimer_Timer_Error
If splashTimerCount = 0 Then ' this prevents the 3.25 second timer doing anything on its first iteration
splashTimerCount = splashTimerCount + 1
Else
splashShrinkerTimer.Enabled = True
splashTimer.Enabled = False
End If
On Error GoTo 0
Exit Sub
splashTimer_Timer_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure splashTimer_Timer of Form splashForm"
End Sub