point to line distance, nearest point on line

[Chris Holbrook]

This compiles with PB Windows 8.04 and should be easy to convert to PBCC if required

'==============================================================================
' uses an algo found in VB Helper to calculate distance to a line
' and find the coordinates of the nearest point on the line.
' Chris Holbrook Aug 2008
'==============================================================================
#COMPILE EXE
#INCLUDE "win32api.inc"
'-------------------------------------------------------------------------------
' Calculate the distance between the point and the segment.
' near_x, near_Y defines the closest point on the line,
' which can be an end!
FUNCTION DistToSegment(BYVAL px AS SINGLE, BYVAL py _
    AS SINGLE, BYVAL X1 AS SINGLE, BYVAL Y1 AS SINGLE, _
    BYVAL X2 AS SINGLE, BYVAL Y2 AS SINGLE, BYREF near_x AS _
    SINGLE, BYREF near_y AS SINGLE) AS SINGLE
DIM dx AS SINGLE
DIM dy AS SINGLE
DIM t AS SINGLE

    dx = X2 - X1
    dy = Y2 - Y1
    IF dx = 0 AND dy = 0 THEN
        ' It's a point not a line segment.
        dx = px - X1
        dy = py - Y1
        near_x = X1
        near_y = Y1
        DistToSegment = SQR(dx * dx + dy * dy)
        EXIT FUNCTION
    END IF

    ' Calculate the t that minimizes the distance.
    t = ((px - X1) * dx + (py - Y1) * dy) / (dx * dx + dy * _
        dy)

    ' See if this represents one of the segment's
    ' end points or a point in the middle.
    IF t < 0 THEN
        dx = px - X1
        dy = py - Y1
        near_x = X1
        near_y = Y1
    ELSEIF t > 1 THEN
        dx = px - X2
        dy = py - Y2
        near_x = X2
        near_y = Y2
    ELSE
        near_x = X1 + t * dx
        near_y = Y1 + t * dy
        dx = px - near_x
        dy = py - near_y
    END IF

    DistToSegment = SQR(dx * dx + dy * dy)
END FUNCTION

'------------------------------------------------------------------------------
CALLBACK FUNCTION CbMain
  LOCAL     hDc                 AS DWORD
  LOCAL     PS                  AS PAINTSTRUCT
  LOCAL     lp                  AS POINTAPI
  STATIC    a, b, c, d, p, q    AS LONG
  LOCAL     ra, rb, rc, rd, rp, rq _
                                AS SINGLE
  LOCAL     sz                  AS ASCIZ * 64
  LOCAL     rtext               AS rect
  LOCAL     lresult             AS LONG
  LOCAL     lx, ly              AS SINGLE 'closest point coordinates

  SELECT CASE CBMSG
    CASE %WM_INITDIALOG

    CASE %WM_PAINT
        hDc = BeginPaint(CBHNDL, PS)
        GOSUB paintdlg
        EndPaint CBHNDL, PS

    CASE %WM_ERASEBKGND


    CASE %WM_RBUTTONDOWN
       GetCursorPos lp
       ScreenToClient CBHNDL, lp
       p = lp.x
       q = lp.y
       invalidaterect CBHNDL, BYVAL 0, BYVAL %TRUE
       UpdateWindow CBHNDL
       
    CASE %WM_LBUTTONDOWN
       GetCursorPos lp
       ScreenToClient CBHNDL, lp
       a = lp.x
       b = lp.y

    CASE %WM_MOUSEMOVE
        IF CBWPARAM = %MK_LBUTTON THEN
             GetCursorPos lp
             ScreenToClient CBHNDL, lp
             c = lp.x
             d = lp.y
             InvalidateRect CBHNDL, BYVAL 0, BYVAL %TRUE
             UpdateWindow CBHNDL
        END IF
  END SELECT
  EXIT FUNCTION
''''''''''''''''''''
paintdlg:
    sz = "1. draw line using mouse with L button down"
    rText.ntop = 20: rtext.nleft = 10: rtext.nright = 350: rtext.nbottom = 36
    drawtext (hdc, BYVAL VARPTR(sz),LEN(sz), rtext, %DT_LEFT) TO lresult
    sz = "2. draw point by R click, anywhere"
    rText.ntop = 38: rtext.nleft = 10: rtext.nright = 350: rtext.nbottom = 52
    drawtext (hdc, BYVAL VARPTR(sz),LEN(sz), rtext, %DT_LEFT) TO lresult
    IF a <> 0 THEN
        MoveTo hdc, a, b
        sz = STR$(a) + "," + STR$(b)
        rText.ntop = b: rtext.nleft = a: rtext.nright = a + 100: rtext.nbottom = b + 20
        drawtext (hdc, BYVAL VARPTR(sz),LEN(sz), rtext, %DT_LEFT) TO lresult
    END IF
    MoveTo hdc, a, b
    LineTo hdc, c, d
    IF a <> 0 THEN
        sz = STR$(c) + "," + STR$(d)
        rText.ntop = d: rtext.nleft = c: rtext.nright = c + 100: rtext.nbottom = d + 20
        drawtext (hdc, BYVAL VARPTR(sz),LEN(sz), rtext, %DT_LEFT) TO lresult
    END IF
    IF p <> 0 THEN
        moveto hdc, p, q
        sz = STR$(p) + "," + STR$(q)
        rText.ntop = q: rtext.nleft = p: rtext.nright = p + 100: rtext.nbottom = q + 20
        drawtext (hdc, BYVAL VARPTR(sz),LEN(sz), rtext, %DT_LEFT) TO lresult
        rp = p: rq = q: ra = a: rb = b: rc = c: rd = d
        sz = "distance from point to line is " + STR$(disttosegment(rp, rq, ra, rb, rc, rd, BYREF lx, BYREF ly))
        rText.ntop = 420: rtext.nleft = 10: rtext.nright = 600: rtext.nbottom = 440
        drawtext (hdc, BYVAL VARPTR(sz),LEN(sz), rtext, %DT_LEFT) TO lresult
        sz = "closest point on line is " + STR$(INT(lx)) + "," + STR$(INT(ly))
        rText.ntop = 440: rtext.nleft = 10: rtext.nright = 600: rtext.nbottom = 460
        drawtext (hdc, BYVAL VARPTR(sz),LEN(sz), rtext, %DT_LEFT) TO lresult
    END IF
RETURN
END FUNCTION
'===============================================================
FUNCTION PBMAIN AS LONG
  LOCAL hDlg AS LONG
  DIALOG NEW 0,"Point-line distance",,,300,300,%WS_SYSMENU  TO hDlg
  DIALOG SHOW MODAL hDlg CALL CbMain
END FUNCTION