PBWin detecting intersection of lines (function also works in PBCC)

[Chris Holbrook]

'==============================================================================
' uses an algo found in VB Helper to determine whether two line segments intersect
' Chris Holbrook Sep 2009
'==============================================================================
#compile exe
#include "win32api.inc"
'-------------------------------------------------------------------------------
' THIS FUNCTION DOES IT ALL - the rest is just to show working!
' Return True if the segments intersect.
' parameters are x, y of one end of first line, x, y of other end of first line
'                x, y of one end of second line, x, y of other end of second line
function SegmentsIntersect( X1 as long,  Y1 as long, _
                            X2 as long,  Y2 as long, _
                            A1 as long,  B1 as long, _
                            A2 as long,  B2 as long) as long
    local dx, dy, da, db as single ', t, s As Single
    local s, t as single

    dx = X2 - X1
    dy = Y2 - Y1
    da = A2 - A1
    db = B2 - B1
    if (da * dy - db * dx) = 0 then
        ' The segments are parallel.
        SegmentsIntersect = %False
        exit function
    end if

    s = (dx * (B1 - Y1) + dy * (X1 - A1)) / (da * dy - db * dx)
    t = (da * (Y1 - B1) + db * (A1 - X1)) / (db * dx - da * dy)
    if (s >= 0#) and (s <= 1#) and (t >= 0#) and (t <= 1#) then
        function = %true
    else
        function = %false
    end if

    ' If it exists, the point of intersection is:
    ' (x1 + t * dx, y1 + t * dy)
end function
'------------------------------------------------------------------------------
callback function CbMain
  local     hDc                 as dword
  local     PS                  as PAINTSTRUCT
  local     lp                  as POINTAPI
  static    start1x, start1y, end1x, end1y    as long
  static    start2x, start2y, end2x, end2y    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_lbuttondown
       GetCursorPos lp
       ScreenToClient cbhndl, lp
       start1x = lp.x
       start1y = lp.y

    case %wm_rbuttondown
       GetCursorPos lp
       ScreenToClient cbhndl, lp
       start2x = lp.x
       start2y = lp.y

    case %wm_mousemove
        select case cb.wparam
            '
            case %MK_LBUTTON
                GetCursorPos lp
                ScreenToClient cbhndl, lp
                end1x = lp.x
                end1y = lp.y
                InvalidateRect cbhndl, byval 0, byval %TRUE
                UpdateWindow cbhndl
            '
            case %MK_RBUTTON
                GetCursorPos lp
                ScreenToClient cbhndl, lp
                end2x = lp.x
                end2y = lp.y
                InvalidateRect cbhndl, byval 0, byval %TRUE
                UpdateWindow cbhndl
        end select
  end select
  exit function
''''''''''''''''''''
paintdlg:
    sz = "1. draw first 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 second line using mouse with R button down"
    rText.ntop = 38: rtext.nleft = 10: rtext.nright = 350: rtext.nbottom = 52
    drawtext (hdc, byval varptr(sz),len(sz), rtext, %DT_LEFT) to lresult
    MoveTo hdc, start1x, start1y
    LineTo hdc, end1x, end1y
    if start2x + start2y = 0 then return
    MoveTo hdc, start2x, start2y
    LineTo hdc, end2x, end2y
    lresult = segmentsintersect(start1x, start1y, end1x, end1y, start2x,start2y,end2x,end2y)
    if lresult = %true then
        sz = "true"
    else
        sz = "false"
    end if
    rText.ntop = end2y: rtext.nleft = end2x + 12: rtext.nright = end2x + 112: rtext.nbottom = end2y + 20
    drawtext (hdc, byval varptr(sz),len(sz), rtext, %DT_LEFT) to lresult
return
end function
'===============================================================
function pbmain as long
  local hDlg as long
  dialog new 0,"Lines intersect",,,300,300,%ws_sysmenu  to hDlg
  dialog show modal hDlg call CbMain
end function