• Home
 · 
• Graphics
 · 
• This is a paint program with several different tools. I am asking whoever downloads this to please

This is a paint program with several different tools. I am asking whoever downloads this to please

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



Rate This is a paint program with several different tools. I am asking whoever downloads this to please

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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