PureBasic Forums - English

Code: Select all

CompilerIf Defined(INCLUDE_ARROWEDLINES, #PB_Constant)=0
#INCLUDE_ARROWEDLINES=1
;/////////////////////////////////////////////////////////////////////////////////
;***Arrowed Lines***
;
;©nxSoftWare 2010.
;=================
;   Stephen Rodriguez (srod)
;   Created with Purebasic 4.51 for Windows.
;
;   Platforms:  Windows.
;
;   Fully Unicode compliant and threadsafe.
;/////////////////////////////////////////////////////////////////////////////////

;-CONSTANTS.

;/////////////////////////////////////////////////////////////////////////////////
  ;The following constants are used for the arrowType parameter in the ArrowedLineXY function.
    #ARROWEDLINES_FROMEND         = 1
    #ARROWEDLINES_TOEND           = 2
    #ARROWEDLINES_BOTHENDS        = #ARROWEDLINES_FROMEND | #ARROWEDLINES_TOEND
;/////////////////////////////////////////////////////////////////////////////////


;-PUBLIC FUNCTIONS.

;/////////////////////////////////////////////////////////////////////////////////
;The following function draws an arrowed line. The line itself is drawn using the pen currently selected into the hdc.
;The arrowheads are drawn and filled with the specified color (they do not use the currently selected pen because for a filled arrow
;you really only get good results with a pen of thickness at most 1).
Procedure ArrowedLineXY(hdc, x1, y1, x2, y2, arrowLength, baseWidth, arrowType = #ARROWEDLINES_BOTHENDS, arrowColor = #Black)
  Protected lineLength.d, ratio.d, left, top, right, bottom, blnSwitchedPts, aLeft, aTop, aRight, aBottom
  Protected lambda.d, Dim vertices.POINT(2), i, brush, oldBrush, oldPen, t1
  ;Now check the parameters
    If arrowLength > 0 And baseWidth > 0 And arrowType = arrowType & #ARROWEDLINES_BOTHENDS
      lineLength = Sqr((x2 - x1)*(x2 - x1) + (y2 - y1)*(y2 - y1))
      If lineLength
        t1 = lineLength
        If arrowType & #ARROWEDLINES_FROMEND
          t1 - arrowLength
        EndIf
        If arrowType & #ARROWEDLINES_TOEND
          t1 - arrowLength
        EndIf
        If t1 >= 0
          lambda = baseWidth / lineLength / 2
          ;Calculate the adjusted end-points.
            ratio = arrowLength / lineLength
            If x1 < x2 Or (x1 = x2 And y1 < y2)
              left = x1 : top = y1 : right = x2 : bottom = y2
            Else
              left = x2 : top = y2 : right = x1 : bottom = y1
              blnSwitchedPts = #True
            EndIf
            aLeft = left : aTop = top : aRight = right : aBottom = bottom
            brush = CreateSolidBrush_(arrowColor)
            If brush
              oldBrush = SelectObject_(hdc, brush)
              oldPen = SelectObject_(hdc, GetStockObject_(#NULL_PEN))
              For i = #ARROWEDLINES_FROMEND To #ARROWEDLINES_TOEND
                If arrowType & i
                  If (i = #ARROWEDLINES_FROMEND And blnSwitchedPts = #False) Or (i = #ARROWEDLINES_TOEND And blnSwitchedPts = #True) 
                    aLeft = (1 - ratio) * left + ratio * right
                    aTop = (1 - ratio) * top + ratio * bottom
                    vertices(0)\x = left : vertices(0)\y = top
                    vertices(1)\x = aLeft - lambda * (bottom - top) : vertices(1)\y = aTop + lambda * (right - left)
                    vertices(2)\x = aLeft<<1 - vertices(1)\x : vertices(2)\y = aTop<<1 - vertices(1)\y
                  Else
                    aRight = (1 - ratio) * right + ratio * left
                    aBottom = (1 - ratio) * bottom + ratio * top
                    vertices(0)\x = right : vertices(0)\y = bottom
                    vertices(1)\x = aRight - lambda * (bottom - top) : vertices(1)\y = aBottom + lambda * (right - left)
                    vertices(2)\x = aRight<<1 - vertices(1)\x : vertices(2)\y = aBottom<<1 - vertices(1)\y
                  EndIf
                  Polygon_(hdc, vertices(), 3)
                EndIf      
              Next
              SelectObject_(hdc, oldBrush)
              SelectObject_(hdc, oldPen)
              DeleteObject_(brush)
            EndIf
          ;Draw the main (truncated) line.
            MoveToEx_(hdc, aLeft, aTop, 0)
            LineTo_(hdc, aRight, aBottom)
        Else
          MoveToEx_(hdc, x1, y1, 0)
          LineTo_(hdc, x2, y2)
        EndIf
      EndIf
    Else ;Just draw the complete line.
      MoveToEx_(hdc, x1, y1, 0)
      LineTo_(hdc, x2, y2)
    EndIf
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////

CompilerEndIf

Code: Select all

If OpenWindow(0, 0, 0, 300, 300, "Arrowed Lines demo", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If CreateImage(0, 300, 300)
    hdc = StartDrawing(ImageOutput(0))
    If hdc
      Box(0, 0, 300, 300, #White)
      oldPen = SelectObject_(hdc, GetStockObject_(#BLACK_PEN))
      ArrowedLineXY(hdc, 10, 20, 290, 20, 10, 10, #ARROWEDLINES_BOTHENDS)
      ArrowedLineXY(hdc, 290, 60, 10, 60, 10, 10, #ARROWEDLINES_BOTHENDS)
      ArrowedLineXY(hdc, 50, 100, 50, 200, 10, 10, #ARROWEDLINES_BOTHENDS)
      ArrowedLineXY(hdc, 100, 200, 100, 100, 10, 10, #ARROWEDLINES_BOTHENDS)
      SelectObject_(hdc, oldPen)
      StopDrawing() 
      ImageGadget(0, 0, 0, 200, 200, ImageID(0))
    EndIf
  EndIf    
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf

Code: Select all

;Create some pens.
  Dim arrowColor(100)
  Dim pen(100)
  arrowColor(0) = #Black
  pen(0) = CreatePen_(#PS_SOLID, 1, #Black)
  For i = 1 To 100
    arrowColor(i) = Random(#White)
    pen(i) = CreatePen_(#PS_DASH, 2 * Random(6) + 1, arrowColor(i))
  Next

;Draw 40 random lines each using a pen at random and with a random combination of arrow heads.
If OpenWindow(0, 0, 0, 500, 500, "Arrowed Lines demo", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If CreateImage(0, 500, 500)
    hdc = StartDrawing(ImageOutput(0))
    If hdc
      Box(0, 0, 500, 500, #White)
      For i = 1 To 40
        penIndex = Random(100)
        oldPen = SelectObject_(hdc, pen(penIndex))
        arrowHead = Random(2) + 1
        ArrowedLineXY(hdc, Random(500), Random(500), Random(500), Random(500), 20, 30, arrowHead, arrowColor(penIndex))
        SelectObject_(hdc, oldPen)
      Next
      StopDrawing() 
      ImageGadget(0, 0, 0, 200, 200, ImageID(0))
    EndIf
  EndIf    
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf

;Tidy up.
  For i = 0 To 100
    DeleteObject_(pen(i))
  Next