vb运行内存占用不断增加怎么办？？

[hippo_liu]

我有个时钟，但运行时内占用不断增加。一个time,30个Shape1源码：
Dim MyRgn As Long, i As Integer, Angle
Const HWND_TOPMOST = -1
Const SWP_RGN_OR = &H40
Private Const RGN_OR = 2
Private Const SWP_SHOWWINDOW = &H40
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const HTCAPTION = 2
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndlnsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgnl As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode 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 Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub Form_DblClick()
Dim yn As Integer
yn = MsgBox("要退出吗？", 1, "透明时钟")
If yn = 1 Then
DeleteObject MyRgn
End
End If
End Sub

Private Sub Form_Load()
Width = 2000
Height = 2000
Me.ScaleMode = vbPixels
Timer1.Enabled = True
Timer1.Interval = 1000
Dim X1, X, Y
'产生表盘12个刻度点
For i = 0 To 29
If i > 0 Then Shape1(i).Shape = 3
Shape1(i).Visible = True
Shape1(i).FillStyle = 0
Select Case i
'定义刻度颜色，大小
Case 0 To 11
Shape1(i).FillStyle = 0
Shape1(i).BorderColor = RGB(3, 3, 250)
Shape1(i).FillColor = RGB(3, 3, 250)
If i Mod 3 = 0 Then
Shape1(i).Width = 7
Shape1(i).Height = 7
Else
Shape1(i).Width = 5
Shape1(i).Height = 5
End If
'时针颜色，大小
Case 12 To 18
Shape1(i).FillStyle = 0
Shape1(i).BorderColor = RGB(3, 3, 250)
Shape1(i).FillColor = RGB(3, 3, 250)
Shape1(i).Width = 5
Shape1(i).Height = 5
'分针
Case 19 To 28
Shape1(i).FillStyle = 0
Shape1(i).BorderColor = RGB(3, 3, 250)
Shape1(i).FillColor = RGB(3, 3, 250)
Shape1(i).Width = 4
Shape1(i).Height = 4
'秒针
Case Else
Shape1(i).FillStyle = 0
Shape1(i).BorderColor = RGB(3, 3, 250)
Shape1(i).FillColor = RGB(3, 3, 250)
Shape1(i).Width = 4
Shape1(i).Height = 4
End Select
Next i
'画12个表盘刻度
For i = 0 To 11
Scale (-1, 1)-(1, -1)
Angle = i * 2 * Atn(1) / 3
Shape1(i).Top = 0.9 * Cos(Angle)
Shape1(i).Left = 0.9 * Sin(Angle)
Next i
'窗口定位，窗口在顶层
X1 = Screen.Width / Screen.TwipsPerPixelX - Me.Width / Screen.TwipsPerPixelX
X = Me.Width / Screen.TwipsPerPixelX
Y = Me.Height / Screen.TwipsPerPixelY
SetWindowPos Me.hWnd, HWND_TOPMOST, X1 - 8, 0, X, Y, SWP_SHOWWINDOW
Me.ScaleMode = vbPixels
toggleFrame
End Sub

Private Sub Timer1_Timer()
Scale (-1, 1)-(1, -1)
Angle = 0.5236 * (15 - (Hour(Now) + Minute(Now) / 60))
For i = 12 To 18
Shape1(i).Move (i - 12) * 0.08 * Cos(Angle), (i - 12) * 0.08 * Sin(Angle)
Next i
Angle = 0.1047 * (75 - (Minute(Now) + Second(Now) / 60))
For i = 19 To 28
Shape1(i).Move (i - 19) * 0.08 * Cos(Angle), (i - 19) * 0.08 * Sin(Angle)
Next i
Angle = 0.1047 * (75 - Second(Now))
Shape1(29).Move 0.9 * Cos(Angle), 0.9 * Sin(Angle)
Me.ScaleMode = vbPixels
toggleFrame
End Sub
Private Sub toggleFrame()
Dim mLeft, mTop
Dim r As Long
MyRgn = CreateRectRgn(0, 0, 0, 0)
For i = 0 To 29
mLeft = ScaleX(Shape1(i).Left, Me.ScaleMode, vbPixels)
mTop = ScaleX(Shape1(i).Top, Me.ScaleMode, vbPixels)
r = CreateRectRgn(mLeft, mTop, -ScaleX((Shape1(i).Width), Me.ScaleMode, vbPixels) + mLeft, ScaleY((Shape1(i).Height), Me.ScaleMode, vbPixels) + mTop)
CombineRgn MyRgn, r, MyRgn, RGN_OR
Next
SetWindowRgn hWnd, MyRgn, True
End Sub
'无标题窗口移动
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If Button = 1 Then
'如果按下鼠标左键
Dim ReturnVal As Long
X = ReleaseCapture()
ReturnVal = SendMessage(Form1.hWnd, WM_SYSCOMMAND, _
SC_MOVE + HTCAPTION, 0)
End If
End Sub