VERSION 5.00 Begin VB.Form Flies BorderStyle = 5 'Sizable ToolWindow Caption = "." ClientHeight = 5535 ClientLeft = 60 ClientTop = 300 ClientWidth = 6990 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 369 ScaleMode = 3 'Pixel ScaleWidth = 466 ShowInTaskbar = 0 'False StartUpPosition = 3 'Windows Default Begin VB.PictureBox Picture1 AutoRedraw = -1 'True BackColor = &H00000000& Height = 5535 Left = 0 ScaleHeight = 365 ScaleMode = 3 'Pixel ScaleWidth = 461 TabIndex = 0 Top = 0 Width = 6975 Begin VB.Timer Timer1 Enabled = 0 'False Interval = 10 Left = 0 Top = 0 End End End Attribute VB_Name = "Flies" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal crColor As Long) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long Private doneInit As Boolean, pixels() As pixel Private pos As pointapi, n As Long Private Type pointapi x As Long: Y As Long End Type Private Type pixel pos As pointapi colour As Long r As Boolean: g As Boolean: b As Boolean End Type Private Type colTriplet r As Long g As Long b As Long End Type Private Function longToTriplet(ByVal colLong As Long) As colTriplet Dim retVal As colTriplet With retVal .r = (colLong And &HFF) .g = (colLong \ &H100&) And &HFF& .b = (colLong \ &H10000) And &HFF& End With longToTriplet = retVal End Function Private Sub Form_Load() ReDim pixels(0): Dim i As Long, j As Long For i = 0 To 299 addPixel Next Picture1.Refresh doneInit = True: Form_Resize: Show End Sub Private Sub Form_Resize() If doneInit Then Picture1.Width = ScaleWidth: Picture1.Height = ScaleHeight End Sub Private Sub Picture1_Click() Timer1.Enabled = Not Timer1.Enabled End Sub Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single) With pos: .x = x: .Y = Y: End With End Sub Private Sub Timer1_Timer() Dim i As Long, col As colTriplet: Picture1.Cls Dim r As Long, g As Long, b As Long, pos2 As pointapi For i = 0 To UBound(pixels) - 1 With pixels(i) .pos.x = .pos.x + ((5 * Rnd) * IIf(Rnd <= 0.499999999999999, 1, -1)) .pos.Y = .pos.Y + ((5 * Rnd) * IIf(Rnd <= 0.499999999999999, 1, -1)) If .pos.x > Picture1.ScaleWidth Then .pos.x = .pos.x - 10: If .pos.x < 0 Then .pos.x = 10 If .pos.Y > Picture1.ScaleHeight Then .pos.Y = .pos.Y - 10: If .pos.Y < 0 Then .pos.Y = 10 col = longToTriplet(.colour) If .r Then r = col.r + ((20 * Rnd) * IIf(Rnd <= 0.499999999999999, 1, -1)): g = 0: b = 0 If .g Then g = col.g + ((20 * Rnd) * IIf(Rnd <= 0.499999999999999, 1, -1)): r = 0: b = 0 If .b Then b = col.b + ((20 * Rnd) * IIf(Rnd <= 0.499999999999999, 1, -1)): r = 0: g = 0 Do Until r >= 0 And g >= 0 And b >= 0 If r < 0 Then r = r + 10 If g < 0 Then g = g + 10 If b < 0 Then b = b + 10 Loop .colour = RGB(r Mod 256, g Mod 256, b Mod 256) If distanceBetweenTwoPoints(pos, .pos) < 25 Then Do Until (distanceBetweenTwoPoints(pos, .pos) > 35) With .pos .x = .x + (2 * Rnd) .Y = .Y + (2 * Rnd) End With Loop End If Picture1.Circle (pos.x, pos.Y), 25, RGB(127, 127, 127 + (Rnd * 127)) SetPixel Picture1.hdc, .pos.x, .pos.Y, .colour SetPixel Picture1.hdc, .pos.x + 1, .pos.Y + 1, .colour SetPixel Picture1.hdc, .pos.x + 1, .pos.Y - 1, .colour SetPixel Picture1.hdc, .pos.x - 1, .pos.Y - 1, .colour SetPixel Picture1.hdc, .pos.x - 1, .pos.Y + 1, vbWhite End With Next End Sub Private Sub addPixel() With pixels(UBound(pixels)) .pos.x = (Picture1.ScaleWidth / 2) + ((20 * Rnd) * IIf(Rnd <= 0.4999, 1, -1)) .pos.Y = (Picture1.ScaleHeight / 2) + ((20 * Rnd) * IIf(Rnd <= 0.4999, 1, -1)) .colour = RGB(0, 0, 0) SetPixel Picture1.hdc, .pos.x, .pos.Y, .colour SetPixel Picture1.hdc, .pos.x, .pos.Y + 1, .colour SetPixel Picture1.hdc, .pos.x + 1, .pos.Y, .colour SetPixel Picture1.hdc, .pos.x + 1, .pos.Y + 1, .colour n = UBound(pixels) Mod 3 If n = 0 Then .r = True .g = False .b = False ElseIf n = 1 Then .r = False .g = True .b = False ElseIf n = 2 Then .r = False .g = False .b = True End If End With ReDim Preserve pixels(UBound(pixels) + 1) End Sub Private Function distanceBetweenTwoPoints(ByRef point1 As pointapi, ByRef point2 As pointapi) As Single distanceBetweenTwoPoints = (((point2.x - point1.x) ^ 2) + ((point2.Y - point1.Y) ^ 2)) ^ 0.5 End Function