Attribute VB_Name = "modPlotAPI"
Option Explicit

Declare Function GetDC Lib "coredll" (ByVal hwnd As Long) As Long
Declare Function GetFocus Lib "coredll" () As Long
Declare Function Polygon Lib "coredll" (ByVal hDc As Long, ByVal lpPoint As String, ByVal nCount As Long) As Long
Declare Function Polyline Lib "coredll" (ByVal hDc As Long, ByVal lpPoint As String, ByVal nCount As Long) As Long
Declare Function CreateSolidBrush Lib "coredll" (ByVal color As Long) As Long
Declare Function SelectObject Lib "coredll" (ByVal hDc As Long, ByVal obj As Long) As Long
Declare Function DeleteObject Lib "coredll" (ByVal obj As Long) As Long
Declare Function DeleteDC Lib "coredll" (ByVal hDc As Long) As Long
Declare Function CreatePen Lib "coredll" (ByVal style As Long, ByVal width As Long, ByVal color As Long) As Long
Public Const PS_SOLID = &H0
Public Const PS_DASH = &H1
Public Const PS_NULL = &H5



Public hWnd_pic As Long     'plot picturebox window handle
Public hDCpic As Long       'plot picturebox device context
Public hBrush As Long       'current brush
Public hOldBrush As Long    'original brush at startup'
Public hPen As Long       'current brush
Public hOldPen As Long    'original brush at startup
Public LastPlotPntStr As String     'last plot for refresh redraw

Public Sub CreatePlotDC(picPlot As PictureBox)
    picPlot.SetFocus                            'set the focus on the picturebox
    hWnd_pic = GetFocus()                       'GetFocus returns the picturebox win handle
    hDCpic = GetDC(hWnd_pic)                    'get the device context of the picturebox
    hBrush = CreateSolidBrush(vbRed)            'create a default red solid brush
    hOldBrush = SelectObject(hDCpic, hBrush)    'select the brush and save the original brush
    hPen = CreatePen(PS_SOLID, 1, vbRed)        'create a default red solid pen
    hOldPen = SelectObject(hDCpic, hPen)        'select the brush and save the original pen
End Sub

Public Sub DeletePlotDC()
    If (hOldBrush > 0) Then Call SelectObject(hDCpic, hOldBrush)    'restore settings
    If (hOldPen > 0) Then Call SelectObject(hDCpic, hOldPen)
    If (hBrush > 0) Then DeleteObject (hBrush)                      'delete objects
    If (hPen > 0) Then DeleteObject (hPen)
    If (hDCpic > 0) Then DeleteDC (hDCpic)
End Sub

Public Function PlotPolygon(ByVal lpPoint As String, ByVal nCount As Long) As Long
    Call SelectObject(hDCpic, hBrush)
    PlotPolygon = Polygon(hDCpic, lpPoint, nCount)
End Function

Public Function PlotPolyline(ByVal lpPoint As String, ByVal nCount As Long) As Long
    Call SelectObject(hDCpic, hPen)
    PlotPolyline = Polyline(hDCpic, lpPoint, nCount)
End Function

Public Function ChangeBrush(ByVal color As Long)
    If (hOldBrush > 0) Then Call SelectObject(hDCpic, hOldBrush)    'restore settings
    If (hBrush > 0) Then DeleteObject (hBrush)                      'delete objects
    hBrush = CreateSolidBrush(vbRed)            'create a default red solid brush
    hOldBrush = SelectObject(hDCpic, hBrush)    'select the brush and save the original brush
End Function

Public Function ChangePen(ByVal color As Long)
    If (hOldPen > 0) Then Call SelectObject(hDCpic, hOldPen)
    If (hPen > 0) Then DeleteObject (hPen)
    hPen = CreatePen(PS_SOLID, 1, vbRed)        'create a default red solid pen
    hOldPen = SelectObject(hDCpic, hPen)        'select the brush and save the original pen
End Function

Public Function CreatePointString(ByVal varPoints As Variant) As String
    Dim idxLB As Long
    Dim idxUB As Long
    Dim idxPnt As Long
    Dim strPnts As String
    'Dim strMsg As String
    Dim xVal As Long
    Dim yVal As Long
    
    strPnts = ""
    If IsEmpty(varPoints) Then
        CreatePointString = ""
        Exit Function
    End If
    idxLB = LBound(varPoints, 2)
    idxUB = UBound(varPoints, 2)
    For idxPnt = idxLB To idxUB
        xVal = varPoints(0, idxPnt)
        yVal = varPoints(1, idxPnt)
        'strMsg = strMsg & " X:" & xVal & " Y:" & yVal & vbNewLine
        strPnts = strPnts & PointToBinaryString(xVal, yVal)
        Call CEDoEvents
    Next
    'MsgBox strMsg
    CreatePointString = strPnts
End Function

Public Function CreatePointStringEx(ByVal varPoints As Variant, ByVal idxLB As Long, idxUB As Long) As String
    Dim idxPnt As Long
    Dim strPnts As String
    
    strPnts = ""
    If IsEmpty(varPoints) Then
        CreatePointString = ""
        Exit Function
    End If
    For idxPnt = idxLB To idxUB
        strPnts = strPnts & PointToBinaryString(varPoints(0, idxPnt), varPoints(1, idxPnt))
    Next
    CreatePointStringEx = strPnts
End Function

Public Function LongToBinaryString(ByVal LongVal As Long) As String
    Dim idxPos As Integer
    Dim tmpVal As Long
    tmpVal = LongVal
    If (LongVal < 0) Then tmpVal = LongVal - &H80000000
    For idxPos = 1 To 3
        LongToBinaryString = LongToBinaryString & ChrB(tmpVal Mod 256)
        tmpVal = tmpVal \ 256
    Next idxPos
    If (LongVal < 0) Then
        LongToBinaryString = LongToBinaryString & ChrB(tmpVal + &H80)
    Else
        LongToBinaryString = LongToBinaryString & ChrB(tmpVal)
    End If
End Function

Public Function PointToBinaryString(xVal As Long, yVal As Long) As String
    PointToBinaryString = LongToBinaryString(xVal) & LongToBinaryString(yVal)
End Function

'Private Sub cmdTestAPI_Click()
'    Dim PointArr(1, 3) As Long
'    Dim strPoints As String
'    Dim Results As Long
'
'    PointArr(0, 0) = 20
'    PointArr(1, 0) = 50
'
'    PointArr(0, 1) = 200
'    PointArr(1, 1) = 100
'
'    PointArr(0, 2) = 200
'    PointArr(1, 2) = 120
'
'    PointArr(0, 3) = 20
'    PointArr(1, 3) = 50
'
'    strPoints = CreatePointString(PointArr)
'
'    'Results = PlotPolygon(strPoints, 4)
'    Results = PlotPolyline(strPoints, 4)
'End Sub
'
'Private Sub Command1_Click()
'    PictureBox1.Cls
'End Sub
'
'Private Sub Form_Load()
'    CreatePlotDC PictureBox1    'Create DC and Brushes
'End Sub
'
'Private Sub Form_Unload(Cancel As Integer)
'    DeletePlotDC                'Delete all GDI objects
'    App.End
'End Sub