by Ryan Murphy (1 Submission)
Category: Graphics
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 31st May 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This is a paint program with several different tools. I am asking whoever downloads this to please help me out with the "point to point" tool.
API Declarations
'This code is designed to function as a drawing program.
Option Explicit
Dim gfDrawing As Integer
Dim gfFree As Integer
Dim gfSingle As Integer
Dim gColor As Integer
Dim gWidth As Integer
Dim gfCircle As Integer
Dim gfRectangle As Integer
Dim gfPoint As Integer
Dim P As Integer
Dim X1 As Integer
Dim Y1 As Integer
Dim OldX As Single
Dim OldY As Single
VBcoders
Private Sub cmdColor_Click(Index As Integer)
'Set the color value to use
gColor = Index
End Sub
Private Sub cmdErase_Click()
'Set value of color for eraser
gfFree = True
gfSingle = False
gfCircle = False
gfRectangle = False
gColor = 15
End Sub
Private Sub cmdPoint_Click()
gfCircle = False
gfSingle = False
gfFree = False
gfRectangle = False
gfPoint = True
End Sub
Private Sub cmdRectangle_Click()
gfCircle = False
gfSingle = False
gfFree = False
gfRectangle = True
gfPoint = False
End Sub
Private Sub cmdSingle_Click()
'Enable the gfSingle variable to enable the Single line tool
gfSingle = True
gfFree = False
gfCircle = False
gfRectangle = False
gfPoint = False
End Sub
Private Sub Form_DblClick()
gfPoint = False
P = 0
End Sub
Private Sub Form_Load()
'Default the width equal to 1
gWidth = 1
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If gfPoint Then
If P = 0 Then
CurrentX = OldX
CurrentY = OldY
P = 1
End If
If P = 1 Then
Line -(x, y), QBColor(gColor)
Line -(OldX, OldY)
CurrentX = OldX
CurrentY = OldY
End If
End If
If gfRectangle Then
If P = 0 Then
PSet (x, y), gColor
X1 = x: Y1 = y
P = 1
End If
End If
'Tell the program to begin to draw
gfDrawing = True
DrawWidth = gWidth
'Set form's CurrentX, CurrentY properties
CurrentX = x
CurrentY = y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If gfFree = True Then
'Enabled the flag variable
If gfDrawing Then
DrawWidth = (gWidth)
'decide where to start the line or circle by retriving the
'x and y coordinates of the mouse
Line -(x, y), QBColor(gColor)
End If
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If gfPoint = False Then
If gfRectangle Then
If P = 1 Then
Line -(X1, y), QBColor(gColor)
Line -(x, y), QBColor(gColor)
Line -(x, Y1), QBColor(gColor)
Line -(X1, Y1), QBColor(gColor)
P = 0
End If
End If
'Stop drawing by disabling the flag variable
DrawWidth = (gWidth)
'Decide whether to draw a circle or not
If gfCircle = True Then
If gfDrawing = True Then
'Draw the circle
If (x - CurrentX) > 0 Then
Circle (CurrentX, CurrentY), (x - CurrentX), QBColor(gColor)
End If
If (x - CurrentX) < 0 Then
Circle (CurrentX, CurrentY), (CurrentX - x), QBColor(gColor)
End If
End If
End If
End If
'Stop drawing
gfDrawing = False
'If not drawing a circle, draw a line
If gfRectangle = False Then
If gfCircle = False Then
Line -(x, y), QBColor(gColor)
End If
End If
End Sub
Private Sub mnuClear_Click()
'Clear the form
frmMain.Cls
End Sub
Private Sub mnuCustom_Click()
'Let the user set their custom width
gWidth = (InputBox("How thick do you want your line?", "Line Width"))
End Sub
Private Sub cmdFreehand_Click()
'Use the mnuFreehand sub to turn on the free hand tool
Call mnuFreehand_Click
End Sub
Private Sub mnuFreehand_Click()
'Enable the gfFree variable to enable the Freehand line tool
gfFree = True
gfSingle = False
gfCircle = False
gfRectangle = False
gfPoint = False
End Sub
Private Sub mnuPrint_Click()
frmMain.PrintForm
End Sub
Private Sub mnuWidth_Click(Index As Integer)
'Set the width of the line or circle
gWidth = Index
End Sub
Private Sub mnuCircle_Click()
'Use the radius sub to use the circle tool
Call Radius_Click
End Sub
Private Sub cmdRadius_Click()
'Set the circle radius tool on
gfCircle = True
gfSingle = False
gfFree = False
gfRectangle = False
gfPoint = False
End Sub
Private Sub mnuExit_Click()
End
End Sub
Private Sub Timer1_Timer()
MsgBox "Welcome to Muprh's Paint! Please Paint Responsibly!", vbDefaultButton1, "Welcome"
Timer1.Enabled = False
End Sub
No comments have been posted about This is a paint program with several different tools. I am asking whoever downloads this to please . Why not be the first to post a comment about This is a paint program with several different tools. I am asking whoever downloads this to please .