-
Notifications
You must be signed in to change notification settings - Fork 1
/
modAniForm.bas
216 lines (203 loc) · 7.3 KB
/
modAniForm.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
Attribute VB_Name = "modAniForm"
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hDC As Long, ByVal nDrawMode As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
'Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
'Private Declare Function ShowWindowAsync Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Const R2_NOTXORPEN = 10
Private Const SW_SHOW = 5
Private Const SW_HIDE = 0
'Public Sub AniShowFrm(ByVal Frm As Long, Optional ByVal Speed As Long = 20)
' Dim hDC As Long
' Dim rcCurrent As RECT
' Dim rcNew As RECT
' Dim Step1 As Long
' Dim Step2 As Long
' Dim i As Long
'
' On Error Resume Next
'
' hDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
' Call SetROP2(hDC, R2_NOTXORPEN)
' Call GetWindowRect(Frm, rcCurrent)
' Step1 = (rcCurrent.Right - rcCurrent.Left) / Speed / 2
' Step2 = (rcCurrent.Bottom - rcCurrent.Top) / Speed / 2
' With rcCurrent
' .Left = (.Right - .Left) \ 2 + .Left
' .Right = .Left
' .Top = (.Bottom - .Top) \ 2 + .Top
' .Bottom = .Top
' End With
' For i = 1 To Speed
' Call Rectangle(hDC, rcCurrent.Left, rcCurrent.Top, rcCurrent.Right, rcCurrent.Bottom)
' Call Sleep(30)
' Call Rectangle(hDC, rcCurrent.Left, rcCurrent.Top, rcCurrent.Right, rcCurrent.Bottom)
' With rcCurrent
' .Left = .Left - Step1
' .Top = .Top - Step2
' .Bottom = .Bottom + Step2
' .Right = .Right + Step1
' End With
' 'DoEvents
' Next i
' Call DeleteDC(hDC)
'End Sub
'
'Public Sub AniUnloadFrm(ByRef objFrm As Form, Optional ByVal Speed As Long = 20)
' Dim hDC As Long
' Dim rcCurrent As RECT
' Dim rcNew As RECT
' Dim Step1 As Long
' Dim Step2 As Long
' Dim i As Long
' Dim OldCapture As Long
'
' On Error Resume Next
'
' 'Call ShowWindowAsync(Frm, SW_HIDE)
' 'Call ShowWindow(Frm, SW_HIDE)
' OldCapture = GetCapture()
' Call SetCapture(objFrm.hWnd)
' Call objFrm.Hide
' DoEvents
'
' hDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
' Call SetROP2(hDC, R2_NOTXORPEN)
' Call GetWindowRect(objFrm.hWnd, rcCurrent)
' Step1 = (rcCurrent.Right - rcCurrent.Left) / Speed / 2
' Step2 = (rcCurrent.Bottom - rcCurrent.Top) / Speed / 2
' For i = 1 To Speed
' Call Rectangle(hDC, rcCurrent.Left, rcCurrent.Top, rcCurrent.Right, rcCurrent.Bottom)
' Call Sleep(30)
' Call Rectangle(hDC, rcCurrent.Left, rcCurrent.Top, rcCurrent.Right, rcCurrent.Bottom)
' With rcCurrent
' .Left = rcCurrent.Left + Step1
' .Top = rcCurrent.Top + Step2
' .Bottom = rcCurrent.Bottom - Step2
' .Right = rcCurrent.Right - Step1
' End With
' 'DoEvents
' Next i
' Call DeleteDC(hDC)
'
' Call SetCapture(OldCapture)
'End Sub
Public Sub AniRotateShowFrm(ByVal Frm As Long, Optional ByVal Speed As Long = 20)
Dim PPP1(3) As POINTAPI
Dim PPP2(3) As POINTAPI
Dim cx As Long
Dim cy As Long
Dim hDC As Long
Dim rcCurrent As RECT
Dim rcNew As RECT
Dim Step1 As Long
Dim Step2 As Long
Dim ii As Long
Dim Radian As Single
On Error Resume Next
hDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
Call SetROP2(hDC, R2_NOTXORPEN)
Call GetWindowRect(Frm, rcCurrent)
cx = (rcCurrent.Right - rcCurrent.Left) \ 2 + rcCurrent.Left
cy = (rcCurrent.Bottom - rcCurrent.Top) \ 2 + rcCurrent.Top
PPP1(0).X = cx - 1
PPP1(0).Y = cy - 1
PPP1(1).X = PPP1(0).X + 1
PPP1(1).Y = PPP1(0).Y - 1
PPP1(2).X = PPP1(0).X + 1
PPP1(2).Y = PPP1(0).Y + 1
PPP1(3).X = PPP1(0).X - 1
PPP1(3).Y = PPP1(0).Y - 1
Step1 = (rcCurrent.Right - rcCurrent.Left) / Speed / 2
Step2 = (rcCurrent.Bottom - rcCurrent.Top) / Speed / 2
For Radian = 0 To 3.14159 Step 3.13159 / Speed
PPP1(0).X = PPP1(0).X - Step1
PPP1(0).Y = PPP1(0).Y - Step2
PPP1(1).X = PPP1(1).X + Step1
PPP1(1).Y = PPP1(1).Y - Step2
PPP1(2).X = PPP1(2).X + Step1
PPP1(2).Y = PPP1(2).Y + Step2
PPP1(3).X = PPP1(3).X - Step1
PPP1(3).Y = PPP1(3).Y + Step2
For ii = 0 To 3
PPP2(ii).X = (PPP1(ii).X - cx) * Cos(Radian) + (PPP1(ii).Y - cx) * Sin(Radian) + cx
PPP2(ii).Y = (PPP1(ii).Y - cy) * Cos(Radian) - (PPP1(ii).X - cy) * Sin(Radian) + cy
Next ii
Call Polygon(hDC, PPP2(0), 4)
Call Sleep(30)
Call Polygon(hDC, PPP2(0), 4)
'DoEvents
Next Radian
Call DeleteDC(hDC)
End Sub
Public Sub AniRotateUnloadFrm(ByRef objFrm As Form, Optional ByVal Speed As Long = 20)
Dim PPP1(3) As POINTAPI
Dim PPP2(3) As POINTAPI
Dim cx As Long
Dim cy As Long
Dim hDC As Long
Dim rcCurrent As RECT
Dim rcNew As RECT
Dim Step1 As Long
Dim Step2 As Long
Dim ii As Long
Dim Radian As Single
Dim OldCapture As Long
On Error Resume Next
'Call ShowWindowAsync(Frm, SW_HIDE)
'Call ShowWindow(Frm, SW_HIDE)
OldCapture = GetCapture()
Call SetCapture(objFrm.hWnd)
Call objFrm.Hide
DoEvents
hDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
Call SetROP2(hDC, R2_NOTXORPEN)
Call GetWindowRect(objFrm.hWnd, rcCurrent)
cx = (rcCurrent.Right - rcCurrent.Left) \ 2 + rcCurrent.Left
cy = (rcCurrent.Bottom - rcCurrent.Top) \ 2 + rcCurrent.Top
PPP1(0).X = rcCurrent.Left
PPP1(0).Y = rcCurrent.Top
PPP1(1).X = rcCurrent.Right
PPP1(1).Y = rcCurrent.Top
PPP1(2).X = rcCurrent.Right
PPP1(2).Y = rcCurrent.Bottom
PPP1(3).X = rcCurrent.Left
PPP1(3).Y = rcCurrent.Bottom
Step1 = (rcCurrent.Right - rcCurrent.Left) / Speed / 2
Step2 = (rcCurrent.Bottom - rcCurrent.Top) / Speed / 2
For Radian = 0 To -3.14159 Step -3.14159 / Speed
PPP1(0).X = PPP1(0).X + Step1
PPP1(0).Y = PPP1(0).Y + Step2
PPP1(1).X = PPP1(1).X - Step1
PPP1(1).Y = PPP1(1).Y + Step2
PPP1(2).X = PPP1(2).X - Step1
PPP1(2).Y = PPP1(2).Y - Step2
PPP1(3).X = PPP1(3).X + Step1
PPP1(3).Y = PPP1(3).Y - Step2
For ii = 0 To 3
PPP2(ii).X = (PPP1(ii).X - cx) * Cos(Radian) + (PPP1(ii).Y - cx) * Sin(Radian) + cx
PPP2(ii).Y = (PPP1(ii).Y - cy) * Cos(Radian) - (PPP1(ii).X - cy) * Sin(Radian) + cy
Next ii
Call Polygon(hDC, PPP2(0), 4)
Call Sleep(30)
Call Polygon(hDC, PPP2(0), 4)
'DoEvents
Next Radian
Call DeleteDC(hDC)
Call SetCapture(OldCapture)
End Sub