-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathsplaSh.frm
281 lines (220 loc) · 8.26 KB
/
splaSh.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
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
VERSION 5.00
Begin VB.Form splaSh
BorderStyle = 0 'None
Caption = "My Movie Manager Initializing"
ClientHeight = 5895
ClientLeft = 7755
ClientTop = 2745
ClientWidth = 6000
ClipControls = 0 'False
ControlBox = 0 'False
Icon = "splaSh.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "splaSh.frx":C84A
ScaleHeight = 5895
ScaleWidth = 6000
StartUpPosition = 2 'CenterScreen
Begin VB.Timer Timer1
Interval = 1000
Left = 2760
Top = 3480
End
Begin VB.PictureBox picBox
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 6030
Left = 5880
Picture = "splaSh.frx":81B8E
ScaleHeight = 6000
ScaleWidth = 6000
TabIndex = 3
Top = 2040
Visible = 0 'False
Width = 6030
End
Begin VB.Label vInfo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "version"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 4440
TabIndex = 4
Top = 5040
Width = 600
End
Begin VB.Label ProgressL
BackStyle = 0 'Transparent
Caption = "Loading Movies... 35%"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 2
Top = 4200
Width = 2895
End
Begin VB.Image Image1
Height = 750
Left = 120
Picture = "splaSh.frx":F6ED2
Top = 4680
Width = 4500
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Initializing..."
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 1
Top = 3720
Width = 2895
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "Sarath KCM"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 0
Top = 5400
Width = 2895
End
End
Attribute VB_Name = "splaSh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Const RGN_OR = 2
Dim lngRegion As Long
Dim isFirstStart As Boolean
Private Sub Form_DblClick()
On Error GoTo Form_DblClick_Error
Unload Me
On Error GoTo 0
Exit Sub
Form_DblClick_Error:
writeError "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_DblClick of Form splaSh" & vbCrLf & "HelpContext = " & Err.HelpContext & " Source = " & Err.Source
End Sub
Private Sub Form_Load()
On Error GoTo Form_Load_Error
Me.Caption = "My Movie Manager v" & App.Major & "." & App.Minor & "." & App.Revision
Dim lngRetr As Long
lngRegion& = RegionFromBitmap(picBox)
lngRetr& = SetWindowRgn(Me.hWnd, lngRegion&, True)
On Error GoTo 0
Exit Sub
Form_Load_Error:
writeError "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_Load of Form splaSh" & vbCrLf & "HelpContext = " & Err.HelpContext & " Source = " & Err.Source
End Sub
Private Sub Form_initialize()
Dim flDr As New FileSystemObject
On Error GoTo Form_initialize_Error
isFirstStart = flDr.FileExists(App.path & "\Data\FirstRun - Copy.xml")
ProgressL.Caption = ""
vInfo = " version " & App.Major & "." & App.Minor & "." & App.Revision
On Error GoTo 0
Exit Sub
Form_initialize_Error:
writeError "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_initialize of Form splaSh" & vbCrLf & "HelpContext = " & Err.HelpContext & " Source = " & Err.Source
End Sub
Private Sub Timer1_Timer()
On Error GoTo Timer1_Timer_Error
ReportF "*****************************************************************************" & vbCrLf & "Started Program..."
Timer1.Interval = 0
If Not isFirstStart Then
'If normal start
'Timer1.Interval = 1000
mainF.init ProgressL
mainF.Show
Else
'If first start
Fwizard.Show
End If
Unload Me
On Error GoTo 0
Exit Sub
Timer1_Timer_Error:
writeError "Error " & Err.Number & " (" & Err.Description & ") in procedure Timer1_Timer of Form splaSh" & vbCrLf & "HelpContext = " & Err.HelpContext & " Source = " & Err.Source
End Sub
Private Function RegionFromBitmap(picSource As PictureBox, Optional lngTransColor As Long) As Long
Dim lngRetr As Long, lngHeight As Long, lngWidth As Long
Dim lngRgnFinal As Long, lngRgnTmp As Long
Dim lngStart As Long, lngRow As Long
Dim lngCol As Long
On Error GoTo RegionFromBitmap_Error
If lngTransColor& < 1 Then
lngTransColor& = GetPixel(picSource.hdc, 0, 0)
End If
lngHeight& = picSource.Height / Screen.TwipsPerPixelY
lngWidth& = picSource.Width / Screen.TwipsPerPixelX
lngRgnFinal& = CreateRectRgn(0, 0, 0, 0)
For lngRow& = 0 To lngHeight& - 1
lngCol& = 0
Do While lngCol& < lngWidth&
Do While lngCol& < lngWidth& And GetPixel(picSource.hdc, lngCol&, lngRow&) = lngTransColor&
lngCol& = lngCol& + 1
Loop
If lngCol& < lngWidth& Then
lngStart& = lngCol&
Do While lngCol& < lngWidth& And GetPixel(picSource.hdc, lngCol&, lngRow&) <> lngTransColor&
lngCol& = lngCol& + 1
Loop
If lngCol& > lngWidth& Then lngCol& = lngWidth&
lngRgnTmp& = CreateRectRgn(lngStart&, lngRow&, lngCol&, lngRow& + 1)
lngRetr& = CombineRgn(lngRgnFinal&, lngRgnFinal&, lngRgnTmp&, RGN_OR)
DeleteObject (lngRgnTmp&)
End If
Loop
Next
RegionFromBitmap& = lngRgnFinal&
On Error GoTo 0
Exit Function
RegionFromBitmap_Error:
writeError "Error " & Err.Number & " (" & Err.Description & ") in procedure RegionFromBitmap of Form splaSh" & vbCrLf & "HelpContext = " & Err.HelpContext & " Source = " & Err.Source
End Function