Available in the LEADTOOLS Imaging toolkit. |
Drawing Simple Lines and Shapes (Access 2.0)
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.
Sub Lead1_MouseDown (Button As Integer, Shift As Integer, X As Long, Y As Long)
'Use the same scale mode as the mouse.
Me![LEAD1].Object.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.
Sub LEAD1_MouseMove (Button As Integer, Shift As Integer, X As Long, Y As Long)
'Declare local variables.
Dim OldEndX, OldEndY
Dim OldDrawX, OldDrawY, OldWidth, OldHeight
Dim DrawX, DrawY, NewWidth, NewHeight
If Button = 1 Then
'Set the drawing styles.
Me![LEAD1].Object.DrawPenStyle = DRAWPENSTYLE_SOLID
Me![LEAD1].Object.DrawMode = DRAWMODE_INVERT
Me![LEAD1].Object.DrawFillStyle = DRAWFILLSTYLE_TRANSPARENT
Me![LEAD1].Object.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
Me![LEAD1].Object.DrawEllipse OldDrawX, OldDrawY, OldWidth, OldHeight
Me![LEAD1].Object.DrawEllipse DrawX, DrawY, NewWidth, NewHeight
Case 1 'Line
Me![LEAD1].Object.DrawLine StartX, StartY, OldEndX, OldEndY
Me![LEAD1].Object.DrawLine StartX, StartY, EndX, EndY
Case 2 'Rectangle
Me![LEAD1].Object.DrawRectangle OldDrawX, OldDrawY, OldWidth, OldHeight
Me![LEAD1].Object.DrawRectangle DrawX, DrawY, NewWidth, NewHeight
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.
Sub LEAD1_MouseUp (Button As Integer, Shift As Integer, X As Long, Y As Long)
'Declare local variables.
Dim DrawX, DrawY, NewWidth, NewHeight
'Set the drawing style.
Me![LEAD1].Object.DrawPenStyle = DRAWPENSTYLE_SOLID
Me![LEAD1].Object.DrawPenWidth = 2
Me![LEAD1].Object.DrawPenColor = RGB(255, 0, 0) 'Red
Me![LEAD1].Object.DrawMode = DRAWMODE_COPY_PEN
Me![LEAD1].Object.DrawFillColor = RGB(0, 255, 0) 'Green
Me![LEAD1].Object.DrawFillStyle = DRAWFILLSTYLE_HORIZONTAL_LINE
Me![LEAD1].Object.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
Me![LEAD1].Object.DrawEllipse DrawX, DrawY, NewWidth, NewHeight
Case 1 'Line
Me![LEAD1].Object.DrawLine StartX, StartY, EndX, EndY
Case 2 'Rectangle
Me![LEAD1].Object.DrawRectangle DrawX, DrawY, NewWidth, NewHeight
End Select
End Sub
6. Run your program to test it.