Binaryworld - Using GetPath and PolyDraw API to extract and draw path segments. ... [ VB -> Graphics ]

GDI Paths are different than most of GDI objects. Path doesn't have handle but they always bound to device context. Path can be generated by calling BeginPath and EndPath API. Here the example how path can be generated.

Click here to copy the following block

BeginPath(Me.hDc)
'//....
'//Draw Lines
'//Draw Polygon
'//Do Text output to form
'//....
EndPath(Me.hDc)

So anything you draw between BeginPath and EndPath will be scanned instead of actual output on the screen for the specified DC.

Internally Path is made from several lines and curves. You can extract those line/curve segments using GetPath API. Any GDI Path can contain any of the following instructions.

PT_LINETO
PT_BEZIERTO
PT_MOVETO
PT_CLOSEFIGURE

GetPath API returns array of commands and points related to command. You can redraw that whole sequence of commands by calling PolyDraw API. PolyDraw API is very useful when you want to draw series of lines and curves without calling LineTo, MoveTo or BezierTo several times. PolyDraw function takes four parameters
1) handle to device context
2) array of points
3) command type (PT_MOVETO, PT_LINETO, PT_BEZIERTO and PT_CLOSEFIGURE) Note: PT_CLOSEFIGURE can be combined with any other command.
4) number of points

Now lets start real fun

Step-By-Step Example

- Create a standard exe project
- Add two command buttons on the form1
- Add the following code in form1

Click here to copy the following block

Private Type PointAPI
  X As Long
  Y As Long
End Type

Dim m_PointCoords() As PointAPI
Dim m_PointTypes() As Byte
Dim m_NumPoints As Long

Private Const PT_CLOSEFIGURE As Long = &H1
Private Const PT_LINETO As Long = &H2
Private Const PT_BEZIERTO As Long = &H4
Private Const PT_MOVETO As Long = &H6

Private Type RectAPI
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Declare Function MoveToEx Lib "GDI32.dll" ( _
    ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByRef lpPoint As Any) As Long

Private Declare Function LineTo Lib "GDI32.dll" ( _
    ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function PolyBezierTo Lib "GDI32.dll" ( _
    ByVal hDC As Long, ByRef lpPt As PointAPI, ByVal cCount As Long) As Long

Private Declare Function CloseFigure Lib "GDI32.dll" ( _
    ByVal hDC As Long) As Long

Private Declare Function GetPathAPI Lib "GDI32.dll" Alias "GetPath" ( _
    ByVal hDC As Long, ByRef lpPoints As Any, ByRef lpTypes As Any, ByVal nSize As Long) As Long

Private Declare Function BeginPath Lib "GDI32.dll" ( _
    ByVal hDC As Long) As Long

Private Declare Function EndPath Lib "GDI32.dll" ( _
    ByVal hDC As Long) As Long

Private Declare Function PolyDraw Lib "GDI32.dll" ( _
    ByVal hDC As Long, ByRef lpPt As PointAPI, ByRef lpbTypes As Byte, ByVal cCount As Long) As Long

Public Function GetPathVB(ByVal inDC As Long) As Boolean
  Erase m_PointCoords()
  Erase m_PointTypes()
  m_NumPoints = 0

  m_NumPoints = GetPathAPI(inDC, ByVal 0&, ByVal 0&, 0)

  If (m_NumPoints) Then
    ReDim m_PointCoords(m_NumPoints - 1) As PointAPI
    ReDim m_PointTypes(m_NumPoints - 1) As Byte

    'Get the path data from the DC
    GetPathVB = GetPathAPI(inDC, m_PointCoords(0), m_PointTypes(0), m_NumPoints) <> 0
  End If
End Function

Public Function SetPathVB(ByVal inDC As Long) As Boolean
  Dim ret As Long, s As String

  Me.Font.Name = "Arial"
  Me.Font.Size = 140
  Me.CurrentX = 10: Me.CurrentY = 30
  s = InputBox("Enter text to draw", , "GDI")

  ret = BeginPath(inDC)
  '//Draw anything to DC which will be scanned as a path
  Me.Print s
  ret = EndPath(inDC)
End Function

Private Sub PolyDrawVB(ByVal hDC As Long, ByRef lpPt() As PointAPI, _
  ByRef lpbTypes() As Byte, ByVal cCount As Long)
  Dim LoopPts As Long
  Dim BezIdx As Long
  Command2.Enabled = False
  For LoopPts = 0 To cCount - 1
    ' Clear bezier point index for non-bezier point
    If ((lpbTypes(LoopPts) And PT_BEZIERTO) = 0) Then BezIdx = 0

    Select Case lpbTypes(LoopPts) And Not PT_CLOSEFIGURE
      Case PT_LINETO  ' Straight line segment
        Call DrawBox(lpPt(LoopPts), 2, vbRed)
        Me.ForeColor = RGB(200, 50, 70)
        Call LineTo(hDC, lpPt(LoopPts).X, lpPt(LoopPts).Y)
        Me.Caption = LoopPts + 1 & "/" & cCount & " LINETO"
    Case PT_BEZIERTO  ' Curve segment
        '//
        Select Case BezIdx
          Case 0, 1 ' Bezier control handles
            Call DrawBox(lpPt(LoopPts), 2, vbBlue)
            Me.Caption = LoopPts + 1 & "/" & cCount & " Bezier control handles :" & BezIdx
          Case 2  ' Bezier end point
              '//Connecting lines betweenn (start to 1st control pt) and (2nd control pt to end point)
              Me.Line (lpPt(LoopPts - 3).X, lpPt(LoopPts - 3).Y)-(lpPt(LoopPts - 2).X, lpPt(LoopPts - 2).Y), vbBlue
              Me.Line (lpPt(LoopPts - 1).X, lpPt(LoopPts - 1).Y)-(lpPt(LoopPts).X, lpPt(LoopPts).Y), vbBlue

              Me.ForeColor = vbCyan
              ' Move to first point where we will start curve
              Call MoveToEx(hDC, m_PointCoords(LoopPts - 3).X, m_PointCoords(LoopPts - 3).Y, ByVal 0&)
              Call PolyBezierTo(hDC, m_PointCoords(LoopPts - 2), 3)
              Call DrawDot(lpPt(LoopPts), 2, &HFF00AA)
              Me.Caption = LoopPts + 1 & "/" & cCount & " Bezier End Point :" & BezIdx
        End Select
        BezIdx = (BezIdx + 1) Mod 3 '//Reset counter after 3 Bezier points
      Case PT_MOVETO  ' Move current drawing point
        Call DrawDot(lpPt(LoopPts), 4, RGB(0, 150, 50))
        Call MoveToEx(hDC, lpPt(LoopPts).X, lpPt(LoopPts).Y, ByVal 0&)
        Me.Caption = LoopPts + 1 & "/" & cCount & " MOVETO"
    End Select

    If (lpbTypes(LoopPts) And PT_CLOSEFIGURE) Then
      Call CloseFigure(hDC)
      Call DrawDot(lpPt(LoopPts), 6, vbYellow)
    End If
    Delay (0.01)
  Next LoopPts
  Command2.Enabled = True
End Sub

Private Sub DrawDot(Pt As PointAPI, nSize As Integer, lColor As Long)
  Me.Circle (Pt.X, Pt.Y), nSize, lColor
End Sub

Private Sub DrawBox(Pt As PointAPI, nSize As Integer, lColor As Long)
  Me.Line (Pt.X - nSize, Pt.Y - nSize)-(Pt.X + nSize, Pt.Y + nSize), lColor, B
End Sub

Sub Delay(nSec As Single)
  Dim t1 As Currency
  t1 = Timer
  Do While True
    If (Timer - t1) > nSec Then Exit Do
    DoEvents
  Loop
End Sub

Private Sub Command1_Click()
  Me.Cls
  Me.ScaleMode = vbPixels

  SetPathVB Me.hDC  '//This will create a path
  GetPathVB Me.hDC  '//Retrive path data
  PolyDraw Me.hDC, m_PointCoords(0), m_PointTypes(0), m_NumPoints  '//Draw path segments
End Sub

Private Sub Command2_Click()
  Me.Cls
  Me.ScaleMode = vbPixels

  SetPathVB Me.hDC  '//This will create a path
  GetPathVB Me.hDC  '//Retrive path data
  PolyDrawVB Me.hDC, m_PointCoords(), m_PointTypes(), m_NumPoints  '//Draw path segments
End Sub

Private Sub Form_Load()
  Me.AutoRedraw = True
  Command1.Caption = "PolyDrawAPI Demo"
  Command2.Caption = "PolyDrawVB Demo"
End Sub