www.pudn.com > WormsOfLife.zip > frmLife.frm
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 1500
ClientLeft = 0
ClientTop = 0
ClientWidth = 1500
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 100
ScaleMode = 3 'Pixel
ScaleWidth = 100
StartUpPosition = 2 'CenterScreen
Begin VB.PictureBox BallSprite
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 150
Index = 4
Left = 525
Picture = "frmLife.frx":0000
ScaleHeight = 10
ScaleMode = 3 'Pixel
ScaleWidth = 10
TabIndex = 8
Top = 1050
Visible = 0 'False
Width = 150
End
Begin VB.PictureBox BallSprite
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 150
Index = 3
Left = 375
Picture = "frmLife.frx":04BA
ScaleHeight = 10
ScaleMode = 3 'Pixel
ScaleWidth = 10
TabIndex = 7
Top = 1050
Visible = 0 'False
Width = 150
End
Begin VB.PictureBox BallSprite
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 150
Index = 1
Left = 75
Picture = "frmLife.frx":063C
ScaleHeight = 10
ScaleMode = 3 'Pixel
ScaleWidth = 10
TabIndex = 6
Top = 1050
Visible = 0 'False
Width = 150
End
Begin VB.PictureBox BallSprite
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 150
Index = 2
Left = 225
Picture = "frmLife.frx":07BE
ScaleHeight = 10
ScaleMode = 3 'Pixel
ScaleWidth = 10
TabIndex = 5
Top = 1050
Visible = 0 'False
Width = 150
End
Begin VB.PictureBox BallMask
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 150
Left = 675
Picture = "frmLife.frx":0940
ScaleHeight = 10
ScaleMode = 3 'Pixel
ScaleWidth = 10
TabIndex = 4
Top = 1050
Visible = 0 'False
Width = 150
End
Begin VB.CommandButton cmdStop
Caption = "Stop"
Height = 315
Left = 0
TabIndex = 3
Top = 375
Width = 690
End
Begin VB.TextBox txtFPS
Alignment = 2 'Center
Enabled = 0 'False
Height = 315
Left = 0
TabIndex = 2
TabStop = 0 'False
Top = 0
Width = 690
End
Begin VB.PictureBox Buffer
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
Height = 300
Left = 750
ScaleHeight = 20
ScaleMode = 3 'Pixel
ScaleWidth = 20
TabIndex = 0
Top = 0
Visible = 0 'False
Width = 300
End
Begin VB.PictureBox CBuffer
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
Height = 300
Left = 750
ScaleHeight = 20
ScaleMode = 3 'Pixel
ScaleWidth = 20
TabIndex = 1
Top = 375
Visible = 0 'False
Width = 300
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetTickCount Lib "Kernel32" () As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Const maxLife As Integer = 100
Const size As Integer = 10
Const maxSpeed As Integer = 5
Const Radians As Double = 0.017453292519943
Private Type lifeForm
A As Integer
X As Integer
Y As Integer
C As Integer
End Type
Dim sprite(1 To maxLife) As lifeForm
Dim lifeSpeed As Integer
Dim fps As Long
Dim fpsTick As Long
Dim done As Boolean
Dim FW As Long
Dim FH As Long
Private Sub cmdStop_Click()
done = True
End Sub
Private Sub Form_Load()
Me.Width = Screen.Width
Me.Height = Screen.Height
FW = Me.Width / Screen.TwipsPerPixelX
FH = Me.Height / Screen.TwipsPerPixelY
Buffer.Width = FW
Buffer.Height = FH
CBuffer.Width = FW
CBuffer.Height = FH
Buffer.FillColor = RGB(0, 255, 0)
Buffer.FillStyle = 0
For i = 1 To maxLife
sprite(i).A = Random(0, 359)
sprite(i).X = Random(FW / 2 - 50, FW / 2 + 50)
sprite(i).Y = Random(FH / 2 - 50, FH / 2 + 50)
sprite(i).C = Random(1, 4)
Next i
End Sub
Private Sub Form_Activate()
Do While Not done
'If Random(1, 100) = 50 Then
' BitBlt Buffer.hdc, 0, 0, CBuffer.Width, CBuffer.Height, CBuffer.hdc, 0, 0, vbSrcCopy
'End If
For i = 1 To maxLife
If Random(1, 2) = 1 Then
sprite(i).A = sprite(i).A + Random(5, 10)
Else
sprite(i).A = sprite(i).A - Random(5, 10)
End If
If sprite(i).A < 0 Then sprite(i).A = sprite(i).A + 360 'Make sure angle is between 0 & 359
If sprite(i).A > 359 Then sprite(i).A = sprite(i).A - 360 'Make sure angle is between 0 & 359
lifeSpeed = Random(1, maxSpeed)
sprite(i).X = Int(Cos(sprite(i).A * Radians) * lifeSpeed) + sprite(i).X 'Calculate new X coordinates based on new angle
sprite(i).Y = Int(Sin(sprite(i).A * Radians) * lifeSpeed) + sprite(i).Y 'Calculate new Y coordinates based on new angle
If sprite(i).X < 0 Then sprite(i).X = FW
If sprite(i).X > FW Then sprite(i).X = 0
If sprite(i).Y < 0 Then sprite(i).Y = FH
If sprite(i).Y > FH Then sprite(i).Y = 0
'Buffer.PSet (sprite(i).x, sprite(i).y), RGB(0, 255, 0)
'SetPixelV Buffer.hdc, sprite(i).x, sprite(i).y, RGB(0, 255, 0)
'Buffer.Line (sprite(i).X, sprite(i).Y)-(sprite(i).X - Int(Cos((sprite(i).A + 15) * Radians) * size), sprite(i).Y - Int(Sin((sprite(i).A + 15) * Radians) * size)), RGB(0, 255, 0)
'Buffer.Line (sprite(i).X, sprite(i).Y)-(sprite(i).X - Int(Cos((sprite(i).A - 15) * Radians) * size), sprite(i).Y - Int(Sin((sprite(i).A - 15) * Radians) * size)), RGB(0, 255, 0)
'Buffer.Line (sprite(i).x, sprite(i).y)-(sprite(i).x - Int(Cos(sprite(i).A * Radians) * size), sprite(i).y - Int(Sin(sprite(i).A * Radians) * size)), RGB(0, 255, 0)
'Buffer.Circle (sprite(i).X, sprite(i).Y), 2, RGB(0, 255, 0)
BitBlt Buffer.hdc, sprite(i).X - 5, sprite(i).Y - 5, 10, 10, BallMask.hdc, 0, 0, vbSrcAnd
BitBlt Buffer.hdc, sprite(i).X - 5, sprite(i).Y - 5, 10, 10, BallSprite(sprite(i).C).hdc, 0, 0, vbSrcPaint
Next i
BitBlt Me.hdc, 0, 0, Buffer.Width, Buffer.Height, Buffer.hdc, 0, 0, vbSrcCopy
DoEvents
fps = fps + 1
If GetTickCount - fpsTick >= 1000 Then
txtFPS.Text = Str(fps)
fps = 0
fpsTick = GetTickCount
End If
Loop
Unload Me
End
End Sub
Private Function Random(Min As Long, Max As Long) As Long
Randomize Timer
Random = Int(Rnd * ((Max + 1) - Min)) + Min
End Function