Рисовать на PictureBox
Код:
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
Dim xt As Long, yt As Long
Private Sub Form_Load()
Picture1.AutoRedraw = False
Timer1.Interval = 1
Timer1.Enabled = False
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Timer1.Enabled = True
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
xt = x
yt = y
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
SetPixel Picture1.hdc, xt, yt, vbRed
' Picture1.PSet (xt, yt), vbRed
End Sub
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Dim xt As Long, yt As Long
Private Sub Form_Load()
Picture1.AutoRedraw = False
Timer1.Interval = 1
Timer1.Enabled = False
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Timer1.Enabled = True
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
xt = x
yt = y
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
SetPixel Picture1.hdc, xt, yt, vbRed
' Picture1.PSet (xt, yt), vbRed
End Sub
Но сплошная линия получается, только если тянуть курсор очень медленно. Есть ли какой-нибудь другой способ? Заранее благодарен.
Разумеется, простой заменой Вам не обойтись, например, для того, чтобы получить красный цвет линии, необходимо предварительно : Me.ForeColor = vbRed, возможно также придётся "конвертировать" координаты (см. API функцию ScreenToClient)