Printable View
I am new in visual basic and I have one little problem.I want when the mouse is moving on the form to paint a red line.Every point of this line must start to fade out 1 second after being painted and to disappear after 3 seconds.I appreciate if anyone can help me.
Here is a little funtions that draw and fades circles on a picture box
Code:'Place this code in a Module
Type point
X As Integer
Y As Integer
life As Single
End Type
Public points() As point
Public point_count As Integer
'Place this in a Picture Box mousemove function
Dim i As Integer
If Button = 1 Then
i = 0
'find and use dead points
While i < point_count
If points(i).life <= 0.1 Then
points(i).X = X
points(i).Y = Y
points(i).life = 4
End If
i = i + 1
Wend
'Need a new point
If i = point_count Then
point_count = point_count + 1
ReDim Preserve points(point_count) As point
i = point_count
points(i).X = X
points(i).Y = Y
points(i).life = 4
End If
Picture1.Circle (points(i).X, points(i).Y), 2, RGB(255, 0, 0)
End If
End Sub
'place this in a Timer with interval = 100
Dim i As Integer
For i = 0 To point_count - 1
If points(i).life >= 0.1 Then
points(i).life = points(i).life - 0.1
Else
points(i).life = 0
End If
If points(i).life < 2 And points(i).life > 0 Then
Picture1.Circle (points(i).X, points(i).Y), 2, RGB(255 * points(i).life / 2, 0, 0)
End If
Next i
'Place this in form load
point_count = 0
ReDim points(point_count)
It doesn't draw lines beacause of replacement of dead points.
This does use minimal memory though because it does not waste space with points you cant see.
Well, here's another idea. You'll need a timer (don't forget to set its interval to something low like 10ms), and to set the form's ScaleMode to Pixels.
The only problem is that it's a bit slow with large pictures... :rolleyes:Code:
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) 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
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then Picture1.PSet (X, Y), 255
End Sub
Private Sub Timer1_Timer()
Dim X As Long, Y As Long, Temp As Long
For X = 0 To Picture1.Width
For Y = 0 To Picture1.Height
Temp = GetPixel(Picture1.hdc, X, Y)
Temp = Temp And 255
Temp = Temp - 32
If Temp < 0 Then Temp = 0
SetPixelV Picture1.hdc, X, Y, Temp
Next Y
Next X
End Sub