Binaryworld - Using LineDDA api to control each point of line. ... [ VB -> Graphics ]

This small code snippet will show you the use of LineDDA api which is very useful when you want to control each point of line. LineDDA use a callback method which gives x and y cordinates of the point to be drawn.

Step-By-Step Example

- Create a standard exe project
- Add one module to the project
- Add the following code in form1

Form1.frm

Click here to copy the following block

Private Sub Form_Paint()
  Dim LinePts() As typLinePoint
  Dim LoopPts As Long, NumPts As Long

  ' Grab the line points for this line
  LinePts() = GetLinePts(10, 10, 100, 100, NumPts)

  If (NumPts) Then  ' Draw them
    For LoopPts = 0 To NumPts - 1
      Form1.PSet ( _
          LinePts(LoopPts).X * Screen.TwipsPerPixelX, _
          LinePts(LoopPts).Y * Screen.TwipsPerPixelY), _
          CLng(LoopPts / NumPts * &HFF) * &H10101
    Next LoopPts
  End If
End Sub

Module1.frm

Click here to copy the following block

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

Public Type typLinePoint
  X As Long
  Y As Long
End Type

Private LinePts() As typLinePoint
Private NumPts As Long

Public Function GetLinePts(ByVal inXa As Long, ByVal inYa As Long, _
  ByVal inXb As Long, ByVal inYb As Long, _
  ByRef outPointCount As Long) As typLinePoint()
  Erase LinePts()
  NumPts = 0

  ' Call the function that does the work
  Call LineDDA(inXa, inYa, inXb, inYb, AddressOf LineDDAProc, 0&)

  ' Return point list and number of returned points
  GetLinePts = LinePts()
  outPointCount = NumPts
End Function

Private Sub LineDDAProc(ByVal X As Long, _
  ByVal Y As Long, ByVal lpData As Long)
  ReDim Preserve LinePts(NumPts) As typLinePoint
  LinePts(NumPts).X = X  ' Callback for LineDDA()
  LinePts(NumPts).Y = Y  ' Add this point to the list
  NumPts = NumPts + 1
End Sub