Trouble drawing lines

[domt]

Can anyone help with this?

I have a form with a small picture (Picture2) on a large picture (Picture1). I want to manually draw a series of red lines on Picture2. The lines are rubber lines and may be drawn across one another. They should also be permanent as long as the program runs,

The following program works but the lines are not red (?)

If I change Picture 2.DrawMode to 13 then the line is red, but the blanking line doesn’t work and I get a red arc segment as the line sweeps across the picture (?)

With Picture2.DrawMode = 13 and Lincol of the blanking line changed to vbWhite, I get red lines but sweeping a line across another line erases that portion of the original line (?)

Option Explicit
Dim XOffset As Single, YOffset As Single, StLx As Single, StLy As Single
Dim OldX As Single, OldY As Single, LinCol As String, X As Single, Y As Single

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
LinCol = vbRed
Picture2.AutoRedraw = True
Picture2.Refresh
Picture2.DrawMode = 7
OldX = X
OldY = Y
StLx = X
StLy = Y
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.Line (StLx, StLy)-(OldX, OldY), LinCol ‘ blanking line
Picture2.Line (StLx, StLy)-(X, Y), LinCol
OldX = X
OldY = Y
End Sub

 

[ClickHere]

This may not be the best way to handle it, but you can try this. Use another picturebox to hold the original picture as you draw your line.

picOriginal.Visible = False

Then apply these changes to your code.

Option Explicit
Dim LinCol as Long 'Not String
Private Declare Function BitBlt Lib &quot;gdi32&quot; (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 Const SRCCOPY = &HCC0020

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
LinCol = vbRed
Picture2.AutoRedraw = True
Picture2.Refresh
'----------------------------------
Picture2.DrawMode = 13
'Make picOriginal exactly like Picture2
With picOriginal
.AutoRedraw = True
.DrawMode = 13
.Width = Picture2.Width
.Height = Picture2.Height
'And copy Picture2 to picOriginal
BitBlt .hdc, 0, 0, .Width, .Height, Picture2.hdc, 0, 0, SRCCOPY
End With
'----------------------------------
OldX = X
OldY = Y
StLx = X
StLy = Y
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim newX As Long, newY As Long
Dim newWidth as Long, newHeight As Long

If Button <> 1 Then Exit Sub
'------------------------
'Replace this line
'Picture2.Line (StLx, StLy)-(OldX, OldY), LinCol ‘ blanking line
'------------------------
'With this
'Define a rectangle around your line
If X < StLx Then
newX = X
newWidth = (StLx - X) + 1
Else
newX = StLx
newWidth = (X - StLx) + 1
End If

If Y < StLy Then
newY = Y
newHeight = (StLy - Y) + 1
Else
newY = StLy
newHeight = (Y - StLy) + 1
End If

'And copy that part of the original pic to erase your line
BitBlt Picture2.hdc, newX, newY, newWidth, newHeight, picOriginal.hdc, newX, newY, SRCCOPY
'------------------------
'Then draw your new line
Picture2.Line (StLx, StLy)-(X, Y), LinCol
OldX = X
OldY = Y
End Sub

This is untested so you may need to tweek it a little. I'm just recalling from memory (what little I have left) how I've handled drawing lines with the mouse.

Hope this helps.