Arrowed Lines (Windows only)

[srod]

Hi,

I was in need of a little routine for drawing lines with arrows on them (and without using GDI+ which will of course do this natively) and so hacked up this little routine.

I know there are other routines for doing this in the forums, but this one doesn't use trig and allows for lines of any thickness and geometric style (dashed etc.) The routine is for Windows only as it requires that you select a gdi pen into the drawing DC before invoking the routine. This pen is used to render the line (not the arrowheads) and is how any style line is supported since you can use geometric pens etc.

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

Some examples will follow.

[Kuron]

Very interesting, oh great Srod!

[srod]

Demo 1.

The following draws 4 lines, 2 horizontal and 2 vertical lines.

Each has an arrow on both ends and each uses the same pen.

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

[srod]

Demo 2.

The following draws some random lines selecting randomly from 100 pens with 100 random colors... Each line either has an arrowhead at just one end or both ends etc.

This demo produced the screenshot in the first post.

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

[blueznl]

Pretty good for a donkey, oh great mule!

[srod]

Pretty good for a donkey, oh great mule!

ee-aw ee-aw ee-aw ee-aw.....

Now look what you've done!

[blueznl]

(Frankly I'm just very jealous, just don't tell anyone...)

[idle]

Thanks nice tip.

Why does he call you donkey?

ee-aw ee-aw ee-aw ee-aw..... *always calls me donkey

[srod]

Thanks nice tip.

Why does he call you donkey?

ee-aw ee-aw ee-aw ee-aw..... *always calls me donkey

I may look like a mule, but I'm not a complete ass!

[blueznl]

Thanks nice tip.

Why does he call you donkey?

ee-aw ee-aw ee-aw ee-aw..... *always calls me donkey

I may look like a mule, but I'm not a complete ass!

You just *knew* this was going to happen, didn't you?

[Kwai chang caine]

Waooouuuhh !!!!
Arrow like i have dreamed to create there is several monts for my flowChart

Why you don't create this code before ???
Kcc would not have had to break the head several months not much has come to end and use finally a freeware

Or perhaps you want fight the famous KCC code

Splendid like usualy, but it's a pity, that she don't move with the mouse, if i can make a little critical

Congratulation and thanks a lot for sharing

[srod]

Sorry KCC, but why would I want it to move with the mouse? As a 'tip' this is intended only to show one way of drawing arrowed lines on Windows using good old GDI, and as such has nothing to do with the mouse etc.

Moving lines under mouse control would comprise a completely separate tip.

Beside's, moving lines under mouse control is a somewhat easier affair.

[Kwai chang caine]

Don't worry MASTER, it is just for do a comment.
I'm a little bit forced to criticize a little bit, because your job is always perfect

And .....when i have see this splendid lines
The first move i have do, it's clicked on the end of the line and whant to move it
Perhaps a residue of my nightmare during two monts with this flowcharts

But i reassure you....kcc is cured now....he have no nightmare with lines ...it's finish
He have nightmare with structure and passing it from VB to DLL

Again congratulation for your great job

[srod]

If you want to move the lines then you would simply set the DC's foreground mix mode (SetROP2_()) to XOR etc. Very simple.

[Kwai chang caine]

you would simply set the DC's foreground mix mode (SetROP2_()) to XOR

Equal for me at :

Aaaaahhhh obviooooouuusly !!!!! Ouaaaarfff Ouaaaarfff Ouaaaarfff !!!!
You are right......how cannot thinking at a thing also simple

Decidedly ....i really love you...but also your humor