Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

detecting intersection of lines (function also works in PBCC)

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

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

    Code:
    '==============================================================================
    ' 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
    Chris Holbrook
    Member
    Last edited by Chris Holbrook; 2 Oct 2009, 04:04 PM.
Working...
X