snowwhite.cls

用VB开发的一个很方便的模拟雪花的程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SnowWhite"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'保持属性值的局部变量
Private Type POINT
 x As Integer
 y As Integer
 Begin As Boolean
End Type
Private Type TriAngle
 Point1 As POINT
 point2 As POINT
 TopPoint As POINT
End Type
Private mvarColor As Long '局部复制
Private mvarRadius As Single '局部复制
Private mvarCentreX As Integer '局部复制
Private mvarCentreY As Integer '局部复制
'保持属性值的局部变量
Private mvarCount As Integer '局部复制
Private mvarPointX As Integer '局部复制
Private mvarPointY As Integer '局部复制
Private Points(20000) As POINT
Private tmpTri(1000) As TriAngle
Private Tri(1000) As TriAngle
Private TriCount As Integer
'保持属性值的局部变量
Private mvarStartAngle As Integer '局部复制
Public Property Let StartAngle(ByVal vData As Integer)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.StartAngle = 5
    mvarStartAngle = vData
End Property


Public Property Get StartAngle() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.StartAngle
    StartAngle = mvarStartAngle
End Property
Public Sub CalSnow()
mvarCount = 0
Snow
End Sub
Public Sub CalSnowTri()
CalTri
Tritoline
End Sub

Public Property Get PointY(ByVal Index As Integer) As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.PointY
  If Index >= mvarCount Then
   Exit Property
  End If
   PointY = Points(Index).y
End Property
Public Property Get IsLineBegin(ByVal Index As Integer) As Boolean
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.PointY
  If Index >= mvarCount Then
   Exit Property
  End If
   IsLineBegin = Points(Index).Begin
End Property

Public Property Get PointX(ByVal Index As Integer) As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.PointX
 If Index >= mvarCount Then
   Exit Property
  End If
   PointX = Points(Index).x
End Property

Public Property Get Count() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Count
     Count = mvarCount
End Property


Public Property Let CentreY(ByVal vData As Integer)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.CentreY = 5
    mvarCentreY = vData
End Property
Public Property Get CentreY() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.CentreY
     CentreY = mvarCentreY
End Property
Public Property Let CentreX(ByVal vData As Integer)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.CentreX = 5
    mvarCentreX = vData
End Property
Public Property Get CentreX() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.CentreX
    CentreX = mvarCentreX
End Property
Public Property Let Radius(ByVal vData As Single)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.Radius = 5
    mvarRadius = vData
End Property
Public Property Get Radius() As Single
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Radius
    Radius = mvarRadius
End Property
Public Property Let Color(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.Color = 5
    mvarColor = vData
End Property

Public Property Get Color() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Color
    Color = mvarColor
End Property

Private Sub Snow()
Dim i As Integer, x As Integer, y As Integer, r As Single
r = mvarRadius / 2
Dim linebegin As Boolean
linebegin = False
For i = 0 To 5
 x = r * Cos(DTOR(i * 60 + mvarStartAngle)) + mvarCentreX
 y = mvarCentreY - r * Sin(DTOR(i * 60 + mvarStartAngle))
 If Not linebegin Then
  Points(mvarCount).Begin = True
  linebegin = True
 Else
 Points(mvarCount).Begin = False
 End If
 Points(mvarCount).x = x
 Points(mvarCount).y = y
 mvarCount = mvarCount + 1
Next i
Points(mvarCount).x = Points(0).x
Points(mvarCount).y = Points(0).y
mvarCount = mvarCount + 1
Dim j As Integer, a As Double
For i = 0 To 3
 r = mvarRadius / 2 + i * mvarRadius / 2 / 3
 a = CalAngle(i)
 For j = 0 To 5
  x = r * Cos(DTOR(j * 60 + mvarStartAngle) + a) + mvarCentreX
  y = mvarCentreY - r * Sin(DTOR(j * 60 + mvarStartAngle) + a)
  Points(mvarCount).x = x
  Points(mvarCount).y = y
  Points(mvarCount).Begin = True
  mvarCount = mvarCount + 1
  x = r * Cos(DTOR(j * 60 + mvarStartAngle) - a) + mvarCentreX
  y = mvarCentreY - r * Sin(DTOR(j * 60 + mvarStartAngle) - a)
  Points(mvarCount).x = x
  Points(mvarCount).y = y
  Points(mvarCount).Begin = False
  mvarCount = mvarCount + 1
 Next j
Next i
''
 For j = 0 To 5
  r = mvarRadius / 2
  x = r * Cos(DTOR(j * 60 + mvarStartAngle)) + mvarCentreX
  y = mvarCentreY - r * Sin(DTOR(j * 60 + mvarStartAngle))
  Points(mvarCount).x = x
  Points(mvarCount).y = y
  Points(mvarCount).Begin = True
  mvarCount = mvarCount + 1
  r = mvarRadius
  x = r * Cos(DTOR(j * 60 + mvarStartAngle)) + mvarCentreX
  y = mvarCentreY - r * Sin(DTOR(j * 60 + mvarStartAngle))
  Points(mvarCount).x = x
  Points(mvarCount).y = y
  Points(mvarCount).Begin = False
  mvarCount = mvarCount + 1
 Next j

End Sub
Private Function DTOR(Degree As Integer) As Double
Dim pi As Double
 pi = 3.14159262
 DTOR = Degree * pi / 180
End Function
Private Function RTOD(r As Double) As Double
Dim pi As Double
 pi = 3.14159262
 RTOD = r * 180 / pi
End Function
Private Function CalAngle(ByVal Index As Integer) As Double
 Dim r As Single, x As Integer, y As Integer
 r = mvarRadius + Index * mvarRadius / 8
 CalAngle = Atn(mvarRadius / 3 / r)
End Function
Private Sub CalTri()
 calFisrt
End Sub
Private Sub calFisrt()
Dim i As Integer, x As Integer, y As Integer, r As Double, a As Double
r = mvarRadius / 3#
linebegin = False
Tri(0).Point1.x = r * Cos(DTOR(mvarStartAngle)) + mvarCentreX
Tri(0).Point1.y = mvarCentreY - r * Sin(DTOR(mvarStartAngle))
Tri(0).TopPoint.x = mvarCentreX
Tri(0).TopPoint.y = mvarCentreY
Tri(0).point2.x = r * Cos(DTOR(60 + mvarStartAngle)) + mvarCentreX
Tri(0).point2.y = mvarCentreY - r * Sin(DTOR(60 + mvarStartAngle))
'TriCount = TriCount + 1
r = 2# * mvarRadius / 3#
Tri(1).Point1.x = r * Cos(DTOR(mvarStartAngle + 60)) + mvarCentreX
Tri(1).Point1.y = mvarCentreY - r * Sin(DTOR(60 + mvarStartAngle))
Tri(1).point2.x = Tri(0).point2.x
Tri(1).point2.y = Tri(0).point2.y
r = mvarRadius * Sqr(1 / 4# + Cos(DTOR(30)) * Cos(DTOR(30)) / 9#)
a = Atn(2# / 3# * Sin(DTOR(30)))
Tri(1).TopPoint.x = r * Cos(DTOR(mvarStartAngle + 60) + a) + mvarCentreX
Tri(1).TopPoint.y = mvarCentreY - r * Sin(DTOR(mvarStartAngle + 60) + a)

'TriCount = TriCount + 1
r = mvarRadius * 2# / 3#
Tri(2).Point1.x = r * Cos(DTOR(mvarStartAngle)) + mvarCentreX
Tri(2).Point1.y = mvarCentreY - r * Sin(DTOR(mvarStartAngle))
Tri(2).point2.x = Tri(0).Point1.x
Tri(2).point2.y = Tri(0).Point1.y
r = mvarRadius * Sqr(1 / 4# + Cos(DTOR(30)) * Cos(DTOR(30)) / 9#)
Tri(2).TopPoint.x = r * Cos(DTOR(mvarStartAngle - 30)) + mvarCentreX
Tri(2).TopPoint.y = mvarCentreY - r * Sin(DTOR(mvarStartAngle - 30))
''
r = Cos(DTOR(30)) * mvarRadius * 4# / 3#
Tri(3).TopPoint.x = r * Cos(DTOR(mvarStartAngle + 30)) + mvarCentreX
Tri(3).TopPoint.y = mvarCentreY - r * Sin(DTOR(mvarStartAngle + 30))
r = mvarRadius * Sqr(Cos(DTOR(30)) * Cos(DTOR(30)) / 9# + (1 - 1# * Sin(DTOR(30)) / 3) * (1 - 1# * Sin(DTOR(30)) / 3))
a = Atn(Tan(DTOR(30)) / 3#)
Tri(3).Point1.x = r * Cos(DTOR(mvarStartAngle + 30) + a) + mvarCentreX
Tri(3).Point1.y = mvarCentreY - r * Sin(DTOR(mvarStartAngle + 30) + a)
Tri(3).point2.x = r * Cos(DTOR(mvarStartAngle + 30) - a) + mvarCentreX
Tri(3).point2.y = mvarCentreY - r * Sin(DTOR(mvarStartAngle + 30) - a)
'4
Tri(4).Point1.x = Tri(1).Point1.x
Tri(4).Point1.y = Tri(1).Point1.y
Tri(4).point2.x = Tri(3).Point1.x
Tri(4).point2.y = Tri(3).Point1.y
Tri(4).TopPoint.x = r * Cos(DTOR(mvarStartAngle + 60)) + mvarCentreX
Tri(4).TopPoint.y = mvarCentreY - r * Sin(DTOR(mvarStartAngle + 60))
'5
Tri(5).Point1.x = Tri(3).point2.x
Tri(5).Point1.y = Tri(3).point2.y
Tri(5).point2.x = Tri(2).Point1.x
Tri(5).point2.y = Tri(2).Point1.y
Tri(5).TopPoint.x = r * Cos(DTOR(mvarStartAngle)) + mvarCentreX
Tri(5).TopPoint.y = mvarCentreY - r * Sin(DTOR(mvarStartAngle))
TriCount = 6
 
End Sub
Private Sub Tritoline()
Dim i As Integer
mvarCount = 0
For i = 0 To TriCount - 1
 'line1
 Points(mvarCount).Begin = True
 Points(mvarCount).x = Tri(i).TopPoint.x
 Points(mvarCount).y = Tri(i).TopPoint.y
 mvarCount = mvarCount + 1
 Points(mvarCount).Begin = False
 Points(mvarCount).x = Tri(i).Point1.x
 Points(mvarCount).y = Tri(i).Point1.y
 mvarCount = mvarCount + 1
 'line2
 Points(mvarCount).Begin = True
 Points(mvarCount).x = Tri(i).TopPoint.x
 Points(mvarCount).y = Tri(i).TopPoint.y
 mvarCount = mvarCount + 1
 Points(mvarCount).Begin = False
 Points(mvarCount).x = Tri(i).point2.x
 Points(mvarCount).y = Tri(i).point2.y
 mvarCount = mvarCount + 1
Next i
End Sub