Drawing Simple Lines and Shapes (Access 95 and 97)

Take the following steps to add code that lets you draw a line, rectangle and ellipse on the bitmap.

1. Start with the project that you created in Loading and Displaying an Image.

2. Add the following form-level variables to the declarations procedure of the general object in your main form:

Dim DrawObject As Integer 'The object we are drawing
Dim StartX As Single 'Starting X position
Dim StartY As Single 'Starting Y position
Dim EndX As Single 'Ending X position
Dim EndY As Single 'Ending Y position

3. Code the LEAD control's MouseDown event as follows. This code selects a different drawing object each time the event occurs.

Private Sub Lead1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Long, ByVal Y As Long)

'Use the same scale mode as the mouse.
Lead1.ScaleMode = 1

'Save the starting position.
StartX = X
StartY = Y
EndX = X
EndY = Y

'Cycle through the types of drawing objects.
Select Case DrawObject
Case 0
  DrawObject = 1 'Line
Case 1
  DrawObject = 2 'Rectangle
Case 2
  DrawObject = 0 'Ellipse
Case Else
  DrawObject = 0
End Select

End Sub

4. Code the LEAD control's MouseMove event as follows. This code uses DRAWMODE_INVERT for the DrawMode, which means that pixel colors are inverted. Thus, the drawing methods can erase the previous object and draw a new one.

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

'Declare local variables.
Dim OldEndX, OldEndY
Dim OldDrawX, OldDrawY, OldWidth, OldHeight
Dim DrawX, DrawY, NewWidth, NewHeight

If Button = 1 Then
  'Set the drawing styles.
  Lead1.DrawPenStyle = DRAWPENSTYLE_SOLID
  Lead1.DrawMode = DRAWMODE_INVERT
  Lead1.DrawFillStyle = DRAWFILLSTYLE_TRANSPARENT
  Lead1.DrawPersistence = False 'On the window, not the bitmap

  'Save the previous ending mouse position.
  OldEndX = EndX
  OldEndY = EndY

  'Get the current mouse position.
  EndX = X
  EndY = Y

  'Calculate the origin of the current object.
  If EndX > StartX Then
      DrawX = StartX
  Else
      DrawX = EndX
  End If
  If EndY > StartY Then
      DrawY = StartY
  Else
      DrawY = EndY
  End If

  'Calculate the origin of the previous object.
  If OldEndX > StartX Then
      OldDrawX = StartX
  Else
      OldDrawX = OldEndX
  End If
  If OldEndY > StartY Then
      OldDrawY = StartY
  Else
      OldDrawY = OldEndY
  End If

  'Calculate the height and width of the current object.
  NewHeight = Abs(StartY - EndY)
  NewWidth = Abs(StartX - EndX)

  'Calculate the height and width of the previous object.
  OldHeight = Abs(StartY - OldEndY)
  OldWidth = Abs(StartX - OldEndX)

  'Erase the old object and draw the new one.
  Select Case DrawObject
  Case 0 'Ellipse
    Lead1.DrawEllipse OldDrawX, OldDrawY, OldWidth, OldHeight
    Lead1.DrawEllipse DrawX, DrawY, NewWidth, NewHeight
  Case 1 'Line
    Lead1.DrawLine StartX, StartY, OldEndX, OldEndY
    Lead1.DrawLine StartX, StartY, EndX, EndY
  Case 2 'Rectangle
    Lead1.DrawRectangle OldDrawX, OldDrawY, OldWidth, OldHeight
    Lead1.Drawrectangle DrawX, DrawY, NewWidth, NewHeight
  Case Else
  End Select

End If

End Sub

5. Code the LEAD control's MouseUp event as follows. This code sets the drawing style and draws the object on the bitmap.

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

'Declare local variables.
Dim DrawX, DrawY, NewWidth, NewHeight

'Set the drawing style.
Lead1.DrawPenStyle = DRAWPENSTYLE_SOLID
Lead1.DrawPenWidth = 2
Lead1.DrawPenColor = RGB(255, 0, 0) 'Red
Lead1.DrawMode = DRAWMODE_COPY_PEN
Lead1.DrawFillColor = RGB(0, 255, 0) 'Green
Lead1.DrawFillStyle = DRAWFILLSTYLE_HORIZONTAL_LINE
Lead1.DrawPersistence = True 'On the bitmap

'Get the current mouse position
EndX = X
EndY = Y

'Determine the origin of the object.
If EndX > StartX Then
  DrawX = StartX
Else
  DrawX = EndX
End If
If EndY > StartY Then
  DrawY = StartY
Else
  DrawY = EndY
End If

'Determine the height and width of the object.
NewHeight = Abs(StartY - EndY)
NewWidth = Abs(StartX - EndX)

'Draw the object
Select Case DrawObject
Case 0 'Ellipse
  Lead1.DrawEllipse DrawX, DrawY, NewWidth, NewHeight
Case 1 'Line
  Lead1.DrawLine StartX, StartY, EndX, EndY
Case 2 'Rectangle
  Lead1.DrawRectangle DrawX, DrawY, NewWidth, NewHeight
Case Else
End Select

End Sub

6. Run your program to test it.