very simple question i bet :)

[ef2k]

hi, i'm making a paint program, just for fun, and i'm working on the line tool component but the only way i can get it to work right is to use Cls (see code) but then every time the user goes to create a new line, the old one is erased, please help! well here's the code (ignore any unused variables :))

Dim point1x As Single
Dim point2x As Single
Dim point1y As Single
Dim point2y As Single
Dim pressed As Boolean
Private Type pointapi
X As Single
Y As Single
End Type
Dim point1 As pointapi
Dim point2 As pointapi

Private Sub Form_Load()
pressed = False
Picture1.AutoRedraw = True
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
point1x = X
point1y = Y
point1x = point2x
point1y = point2y
pressed = True
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
intcount = 0
point2x = X
point2y = Y
If pressed = True Then
Picture1.Cls
Picture1.Line (point1x, point1y)-(point2x, point2y), vbBlack
Else
pressed = False
End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
pressed = False
Picture1.Cls
Picture1.Line (point1x, point1y)-(point2x, point2y), vbBlack
End Sub

[DiGiTaIErRoR]

The .cls command clears all data from the picturebox and reloads from the saved file. Don't use .cls simple.

[ef2k]

i know, i was asking for an alternative, maybe i wasn't clear about that, but cls is the only way i can get it to behave like i want, but then when i go to draw a new line, it clears the old one, as it should, with cls, so if anyone can offer an alternative, a way to make it behave something like Paint's line tool (which is what i'm trying to recreate), please post a reply here, or e-mail me

[Reaper101]

Hi,

The best way to do this would be making to a new picture box. When you click on the drawing area and start drawing, you first do this (in the mouse_click event):

Bitblt picback.hdc, 0, 0, me.scalewidth, me.scaleheight, me.hdc, 0, 0, srccopy

This will print the forms contents into picback. Then whenever a mouse_move event happens you do this:

Bitblt me.hdc, 0, 0, me.scalewidth, me.scaleheight, picback.hdc, 0, 0, srccopy

me.line (iSourceX, iSourceY)-(x, y)

This will then put the contents of picback back onto me.hdc, while at the same time drawing the line.

Hope this solves your problem.

[ef2k]

ok i know i'm gonna come across as realy dumb, but i don't have that much experience with BitBlt. so where should i paste each snippet of code you pasted, in the picback events or the other picture box? or am i even supposed to have 2? thanks for any help!

[Reaper101]

Hi,

First, start a new project and then put a picture box onto the form. Then set picBack's "Appearance" property to "flat" (0), and its "BorderStyle" property to "none" (0). Then place the following code into the General Declarations of the form.

----------------------------------------------------

Option Explicit

' The main declaration of the BitBlt API
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

' This Const is given to BitBlt to mean that it should copy
Private Const SRCCOPY = &HCC0020

' Holds the mouse coordinates
Dim iSourceX As Integer
Dim iSourceY As Integer

' Says that the mouse is down
Dim bDown As Byte
Private Sub Form_Load()

' set the autoredraw to true, so that when the
' form is minimized the form will refresh
With Me
.AutoRedraw = True
.ScaleMode = vbPixels
.WindowState = vbMaximized
End With

Me.Show

' Do the same for picBack
With picBack
.Visible = False
.AutoRedraw = True
.ScaleMode = vbPixels
.Width = Me.ScaleWidth
.Height = Me.ScaleHeight
End With

Me.Show

End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
' Copy the contents of the form onto picBack
BitBlt picBack.hDC, 0, 0, picBack.ScaleWidth, picBack.ScaleHeight, Me.hDC, 0, 0, SRCCOPY

' Set the starting coordinates for the line
iSourceX = X
iSourceY = Y

' Record that the mouse button is down
bDown = 1
End If

End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If bDown = 1 Then
' Copy the contents of picBack, back onto the form
BitBlt Me.hDC, 0, 0, picBack.ScaleWidth, picBack.ScaleHeight, picBack.hDC, 0, 0, SRCCOPY

' Draw the line
Me.Line (iSourceX, iSourceY)-(X, Y)
End If

End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

' Reset all information
bDown = 0
iSourceX = 0
iSourceY = 0

End Sub

----------------------------------------------------

Hope this helps!

Reaper

[ef2k]

hi, thanks for the solution, it works, but when you try to drag the end of the line around, it takes a couple seconds to reach the new point, any way i can speed this up? i don't think it's my computer, because the disk activity light doesn't even come on, but there's still a delay...any help appreciated!

[Reaper101]

Today, after reading your letter, I have tried many other ideas to make drawing a line faster, and have come up with the following three:

For the first one, start a new project and put a picture box on it and name it "picBack." Then set picBack's "Appearance" property to "flat" (0), and its "BorderStyle" property to "none" (0). This one is basically the same as the last time, but the only difference is that last time it copied the whole thing back onto the form; whereas, this time it only puts on the necessary parts (making it MUCH faster than before). Anyway, place the following code into the General Declarations of the form:

--------------------------------

Option Explicit

' The main declaration of the BitBlt API
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

' This Const is given to BitBlt to mean that it should copy
Private Const SRCCOPY = &HCC0020

' Holds the mouse coordinates
Dim iSourceX As Integer
Dim iSourceY As Integer
Dim bDrawn As Byte

' Says that the mouse is down
Dim bDown As Byte
Private Sub Form_Load()

' set the autoredraw to true, so that when the
' form is minimized the form will refresh
With Me
.AutoRedraw = True
.ScaleMode = vbPixels
End With

Me.Show

' Do the same for picBack
With picBack
.Visible = False
.AutoRedraw = True
.ScaleMode = vbPixels
.Width = Me.ScaleWidth
.Height = Me.ScaleHeight
End With

Me.Show

End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
' Copy the contents of the form onto picBack
BitBlt picBack.hDC, 0, 0, picBack.ScaleWidth, picBack.ScaleHeight, Me.hDC, 0, 0, SRCCOPY

' Set the starting coordinates for the line
iSourceX = X
iSourceY = Y

' Record that the mouse button is down
bDown = 1
End If

End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Static iPositionX As Integer
Static iPositionY As Integer
Static iHeight As Integer
Static iWidth As Integer

If bDown = 1 Then
' Copy the contents of picBack, back onto the form. (But only the parts needed)
If bDrawn = 1 Then BitBlt Me.hDC, iPositionX, iPositionY, iWidth, iHeight, picBack.hDC, iPositionX, iPositionY, SRCCOPY

' Set the variable so that we can start drawing
If bDrawn = 0 Then bDrawn = 1

' Draw the line
Me.Line (iSourceX, iSourceY)-(X, Y)

' Calculate only the necessary parts to copy
If iSourceX >= X Then
iPositionX = X
iWidth = iSourceX - X + 1
Else
iPositionX = iSourceX
iWidth = X - iSourceX + 1
End If

If iSourceY >= Y Then
iPositionY = Y
iHeight = iSourceY - Y + 1
Else
iPositionY = iSourceY
iHeight = Y - iSourceY + 1
End If
End If

End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

' Reset all information
bDown = 0
bDrawn = 0
iSourceX = 0
iSourceY = 0

End Sub

--------------------------------

Ok, that's the first method. Now for the second method, first put the picture box onto the form and set all its properties to the same as the last method, including its name. Then put a line control on the form and name it "DrawLine." (Please do not stop even though I just said to use a line control.) :) Then place the following code into the General Declarations of the form:

Option Explicit

' The main declaration of the BitBlt API
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

' This Const is given to BitBlt to mean that it should copy
Private Const SRCCOPY = &HCC0020

' Holds the mouse coordinates
Dim iSourceX As Integer
Dim iSourceY As Integer

' Says that the mouse is down
Dim bDown As Byte
Private Sub Form_Load()

' set the autoredraw to true, so that when the
' form is minimized the form will refresh
With Me
.AutoRedraw = True
.ScaleMode = vbPixels
.WindowState = vbMaximized
End With

Me.Show

End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
' Set the starting coordinates for the line
iSourceX = X
iSourceY = Y

With DrawLine
.X1 = X
.X2 = X
.Y1 = Y
.Y2 = Y
.Visible = True
End With

' Record that the mouse button is down
bDown = 1
End If

End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If bDown = 1 Then
' Draw the line
With DrawLine
.X1 = iSourceX
.X2 = X
.Y1 = iSourceY
.Y2 = Y
End With
End If

End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

' Reset all information
DrawLine.Visible = False
Me.Line (iSourceX, iSourceY)-(X, Y)
bDown = 0
iSourceX = 0
iSourceY = 0

End Sub

--------------------------------

Now, for the last method. This method I tried also, but it is REALLY slow. You most definitely won't use this for your purpose, but it may come in handy later. :) What this does is use LineDDA to grab all the point coordinates, and then it fills in those points with the color from picBack. Anyhow, this time do the same as you did in the first method. Then place the following code into the General Declarations of the form:

--------------------------------

Option Explicit

Private Declare Function LineDDA Lib "gdi32" (ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal lpLineDDAProc As Long, ByVal lParam As Long) As Long
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 SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

' This Const is given to BitBlt to mean that it should copy
Private Const SRCCOPY = &HCC0020

' Holds the mouse coordinates
Dim iSourceX As Integer
Dim iSourceY As Integer
Dim bDrawn As Byte

' Says that the mouse is down
Dim bDown As Byte
Private Sub Form_Load()

ReDim pPoints(0)

' set the autoredraw to true, so that when the
' form is minimized the form will refresh
With Me
.AutoRedraw = True
.ScaleMode = vbPixels
End With

Me.Show

With picBack
.Width = Me.ScaleWidth
.Height = Me.ScaleHeight
End With

End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

If Button = 1 Then
BitBlt picBack.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, Me.hdc, 0, 0, SRCCOPY

' Set the starting coordinates for the line
iSourceX = x
iSourceY = y

' Record that the mouse button is down
bDown = 1
End If

End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim nIndex As Integer

If bDown = 1 Then
' Copy the contents of picBack, back onto the form
If bDrawn = 1 Then
For nIndex = 1 To UBound(pPoints)
With pPoints(nIndex)
'SetPixel Me.hdc, .x, .y, GetPixel(picBack.hdc, .x, .y)
BitBlt Me.hdc, .x, .y, 1, 1, picBack.hdc, .x, .y, SRCCOPY
End With
Next nIndex
End If

If bDrawn = 0 Then bDrawn = 1

' Draw the line
Me.Line (iSourceX, iSourceY)-(x, y)

LineDDA iSourceX, iSourceY, x, y, AddressOf LineRetrievement, 5
End If

End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

' Reset all information
ReDim pPoints(0)

bDown = 0
bDrawn = 0
iSourceX = 0
iSourceY = 0

End Sub

--------------------------------

After that, place a mod into the project (name it modCallBack), and then place the following code into the mod:

Option Explicit

Private Type POINTAPI
x As Long
y As Long
End Type

Public pPoints() As POINTAPI
Public Sub LineRetrievement(ByVal x As Long, ByVal y As Long, ByVal lParam As Long)

ReDim Preserve pPoints(UBound(pPoints) + 1)

pPoints(UBound(pPoints)).x = x
pPoints(UBound(pPoints)).y = y

End Sub

--------------------------------

I sure hope one of these fixes the speed problem for you. Have fun on your paint project!

Reaper

[ef2k]

*wipes tear from his eye*
it's beautiful, just beautiful, the first method is EXACTLY what i was looking for. Thanks SO MUCH for all the time you devoted to me and my little project. I really appreciate it.
If you ever need website graphics or a web designer, let me know ;)

[Dim A]

Originally posted by ef2k
hi, thanks for the solution, it works, but when you try to drag the end of the line around, it takes a couple seconds to reach the new point, any way i can speed this up? i don't think it's my computer, because the disk activity light doesn't even come on, but there's still a delay...any help appreciated!

If you XOR the line onto the screen, you can just xor it again to restore the screen. This would seem to be the fastest method.

Hmm. I can't seem to find how to XOR a line in VB, I think Qbasic supported it but, I can't be positive.

You can write your own line subroutine that draws in a line(pixel by pixel), in a variation of the current screen colors, and then reverse the method in another routine. Or you could mimic XOR, I believe it does either the 1's or 2's compliment, whichever is reversible by itself.

- Dim A

Edit: eliminated redundancy....

[Nirces]

Theres an Even Easier way to do this without ANY Api calls, and keeps it nice and Simple.

Setup your picturebox up as before.

add a Line shape to it Line1 and make it invisible.



sub Picture1_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
line1.x1 = x
line1.y1 = y

if button = 1 then
if line1.visible then
picture1.line (line1.X1, line1.Y1)-(X, Y)
startpointx = x
startpointy = y
else
line1.visible = true
line1.x2 = x
line1.y2 = y
end if
else
line1.visible = false
end if

end sub

sub Picture1_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)

if line1.visible then
line1.x2 =x
line1.y2 = y
end if

end sub

[Zaei]

You can do just about any of the methods above without actually using the API. Use VB's PaintPicture, instead of BitBlt. Its the same thing.

Z.