Curved Arrows with PB Graphics, almost

Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' CurvedArrow.bas           by Jordi Vallès        version 1a         06/06/2008
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Sometimes, on application with graphic elements, is necessary include arrows
' to mark or indicate distances, flows, directions, links, trends, etc. but not
' always arrows can be rigth line. Even in some cases the arrow need to be curved,
' if this is the case Bézier curves can help you.
'
' This program is a continuation or complement of my previous:
'   [URL="http://www.powerbasic.com/support/pbforums/showthread.php?t=37391"]Arrows with PB Graphics[/URL] and
'   [URL="http://www.powerbasic.com/support/pbforums/showthread.php?t=37545"]Connectors with PB Graphics[/URL]
'
' Good explanation and tutorial, with animated samples, about this kind of curves
' can be found in:
'   [URL="http://en.wikipedia.org/wiki/Bezier_curves"]Wikipedia: Bézier curves[/URL]
'
' This program is also an example how some graphical APIs can be mixed with PB
' Graphic sentences without problems. See DrawBezier procedure.
'
' - Curved arrows, after created, can be resized, reoriented and dragged using
'   left mouse button over one end (or near) of selected curve.
' - Once selected, the four points of a Bézier curve, in red color, can be moved 
'   in order to obtain a wished curve.
' - To teminate inmediately a drag or resize press mouse right button.
' (This behaviour try to be similar offered in some Microsoft Office products
' for their curved connector autoshapes)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  - Program developed and tested with PowerBASIC for Windows (PB/Win 8.04) on a
'    PC HP Pavilion m7760 1.80 GHz with Windows Vista Home Premium.
'  - PB Graphic package is used to display information generated by program, only
'    the APIs needed to create Bézier curves are not part of PB package.
'  - Part of code is borrowed from PwrPaint.bas on PB for Windows in Samples folder.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  06/06/2008  Sentence added in DrawShapes. Thanks to Petr Schreiber jr. who detected an error.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' SED_PBWIN

#Compile Exe "CurvedArrow.exe"
#Dim All
#Include "Win32Api.inc"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
%ID_CONN1     = 1001
%ID_CONN2     = 1002
%ID_CONN3     = 1003
%ID_GRAPHIC   = 1111
%ID_POSIT     = 1112
%ID_CLEAR     = 1113
%ID_EXIT      = 1114
%ID_FRAME     = 1115
%ID_CONNTXT   = 1116
%ID_MODETXT   = 1117
%ID_CBOX2     = 1121
%ID_CBOX3     = 1131
%CANVAS       = &hEEFAFA???  'RGB(250,250,238)
%LTLINES      = &hEAEAEA???  'RGB(234,234,234)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Macro Pi        =  3.141592653589793# 'some comment?
Macro NearZero  =  0.000000000000001# 'to avoid problems in some divisions
Macro Sharp     = 12.0#               'length of arrows
Macro Sharp3    = Sharp*3             'minimum distance between head and tail to create an arrow
Macro HeadAngle = Pi/2.5#             'angle of arrow sharp
Macro MinusHead = Pi-HeadAngle        'save time, to avoid repetitive calculations
Macro PlusHead  = Pi+HeadAngle        '  "    "    "   "        "          "
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Type POLYARRAY
   cnt As Long
   xx1 As Single  :  yy1 As Single
   xx2 As Single  :  yy2 As Single
   xx3 As Single  :  yy3 As Single
   xx4 As Single  :  yy4 As Single
End Type

Type ARROWSTORE
   atype  As Long                         'arrow or connector type
   awidth As Long                         'graphic pen width
   astyle As Long                         'graphic style
   aform  As Long                         'orientation 1 = N-S, 2 = W-E
   adrag  As Long                         'drag indicator, 0 = no dragged
   aX1   As Double  :  aY1 As Double      'segment points
   aX2   As Double  :  aY2 As Double
   aX3   As Double  :  aY3 As Double
   aX4   As Double  :  aY4 As Double
   adX   As Double  :  adY As Double      'distance of Xs and Ys
End Type
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Global oldGraphicProc, hDlg  As Dword
Global hDC                   As Dword
Global X1, Y1, X2, Y2        As Double
Global oldX1, oldY1          As Double
Global oldX2, oldY2          As Double
Global contype, savetype     As Long
Global conwidth, savewidth   As Long
Global constyle, savestyle   As Long
Global cntconn, curconn      As Long
Global candraw, canresize    As Long
Global candrag, newconn      As Long
Global canpoints             As Long
Global conn()                As ARROWSTORE
Global apt()                 As POINTAPI
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Declare Function PointToPointDouble(px1 As Double, py1 As Double, px2 As Double, py2 As Double) As Double
Declare Function PointToPointLong(px1 As Long, py1 As Long, px2 As Long, py2 As Long) As Long
Declare Function Atn2(Y As Double, X As Double) As Double
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function PBMain () As Long
   Local w, h As Long

   Dialog New Pixels, 0, "Curved arrows with PB Graphics - 1a", , , 556, 414, _
                         %WS_CAPTION Or %WS_SYSMENU, 0 To hDlg
   Control Add Graphic,  hDlg, %ID_GRAPHIC,"", 5, 5, 404, 404, %WS_BORDER Or %SS_NOTIFY
   Graphic Attach        hDlg, %ID_GRAPHIC, ReDraw
   Control Get Client    hDlg, %ID_GRAPHIC To w, h   'get client size
   Graphic Scale (0, 0) - (w, h)                     'scale to pixel coordinate system
   Graphic Color %BLUE, %CANVAS                      'canvas colors

   Control Add Button,   hDlg, %ID_CLEAR,   "Clear",                416, 387,  66, 22
   Control Add Button,   hDlg, %ID_EXIT,    "Quit",                 484, 387,  66, 22
   Control Add Label,    hDlg, %ID_CONNTXT, "Num :  0",             446, 328, 120, 14
   Control Add Label,    hDlg, %ID_MODETXT, "Mode :  draw ",        446, 344, 120, 14
   Control Add Label,    hDlg, %ID_POSIT,   "Pos : ",               446, 360, 100, 14
   Control Add Frame,    hDlg, %ID_FRAME,   "Connector Styles",     416,   5, 135, 316

   Control Add Option,   hDlg, %ID_CONN1,   "Line only",            422,  24, 126, 16, %WS_GROUP
   Control Add Option,   hDlg, %ID_CONN2,   "Simple arrow",         422,  40, 126, 16
   Control Add Option,   hDlg, %ID_CONN3,   "Double arrow",         422,  56, 126, 16

   Control Set Option    hDlg, %ID_CONN1, %ID_CONN1, %ID_CONN3

   Control Add ComboBox, hDlg, %ID_CBOX2,, 420, 268, 126, 225, %CBS_DROPDOWNLIST Or %WS_TABSTOP
   ComboBox Add          hDlg, %ID_CBOX2,   "Pen width =  1"
   ComboBox Add          hDlg, %ID_CBOX2,   "Pen width =  2"
   ComboBox Add          hDlg, %ID_CBOX2,   "Pen width =  3"
   ComboBox Add          hDlg, %ID_CBOX2,   "Pen width =  4"
   ComboBox Add          hDlg, %ID_CBOX2,   "Pen width =  5"
   ComboBox Select       hDlg, %ID_CBOX2, 1

   Control Add ComboBox, hDlg, %ID_CBOX3,, 420, 294, 126, 125, %CBS_DROPDOWNLIST Or %WS_TABSTOP
   ComboBox Add          hDlg, %ID_CBOX3,   "Pen type = Solid"
   ComboBox Add          hDlg, %ID_CBOX3,   "Pen type = Dash"
   ComboBox Add          hDlg, %ID_CBOX3,   "Pen type = Dot"
   ComboBox Add          hDlg, %ID_CBOX3,   "Pen type = DashDot"
   ComboBox Add          hDlg, %ID_CBOX3,   "Pen type = DashDotDot"
   ComboBox Select       hDlg, %ID_CBOX3, 1

   Dialog Show Modal hDlg Call DialogProc
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CallBack Function DialogProc() As Long
   Local hGraphic As Dword

   Select Case As Long CbMsg
      Case %WM_INITDIALOG
         Control Handle CbHndl, %ID_GRAPHIC To hGraphic
         Graphic Get DC To hDC
         Redim apt(1 To 4) As POINTAPI
         oldGraphicProc = SetWindowLong(hGraphic, %GWL_WNDPROC, CodePtr(GraphicProc))
         contype = 1   :  conwidth = 1   :  constyle = 0
         savetype = 1  :  savewidth = 1  :  savestyle = 0
         Call CanvasCleaner(%TRUE, %TRUE)
      Case %WM_SETCURSOR
         If CbWParam <> hGraphic Then  Control Set Text CbHndl, %ID_POSIT, "Pos :"
      Case %WM_COMMAND
         Select Case CbCtl
            Case %ID_CONN1 To %ID_CONN3            'connector type
               contype = CbCtl - 1000
               savetype = contype
            Case %ID_CBOX2                         'pen width
               If CbCtlMsg = %CBN_SELENDOK Then
                  Control Send CbHndl, %ID_CBOX2, %CB_GETCURSEL, 0, 0 To conwidth
                  conwidth = Max(1, conwidth +1)
                  savewidth = conwidth
                  If conwidth = 1 Then Control Enable CbHndl, %ID_CBOX3 _
                                  Else Control Disable CbHndl, %ID_CBOX3
               End If
            Case %ID_CBOX3                         'pen type
               If CbCtlMsg = %CBN_SELENDOK Then
                  Control Send CbHndl, %ID_CBOX3, %CB_GETCURSEL, 0, 0 To constyle
                  savestyle = constyle
               End If
            Case %ID_EXIT
               If CbCtlMsg = %BN_CLICKED Then Dialog End CbHndl
            Case %ID_CLEAR
               If CbCtlMsg = %BN_CLICKED Then Call CanvasCleaner(%TRUE, %TRUE)
         End Select
      Case %WM_DESTROY
         If oldGraphicProc Then SetWindowLong hGraphic, %GWL_WNDPROC, oldGraphicProc
   End Select
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Subclass procedure
Function GraphicProc(ByVal hWnd As Dword, ByVal wMsg As Long, ByVal wParam As Dword, ByVal lParam As Long) As Long
   Select Case wMsg
      Case %WM_MOUSEMOVE    :  Call MouseMove       (hWnd, wParam, lParam)
      Case %WM_LBUTTONDOWN  :  Call LeftButtonDown  (hWnd, wParam, lParam)
      Case %WM_LBUTTONUP    :  Call LeftButtonUp    (hWnd, wParam, lParam)
      Case %WM_RBUTTONUP    :  Call RightButtonDown (hWnd)
   End Select
   Function = CallWindowProc(oldGraphicProc, hWnd, wMsg, wParam, lParam)
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub MouseMove(ByVal hWnd As Dword, ByVal wParam As Dword, ByVal lParam As Long)
   Local i As Long

   X2 = Lo(Integer, lParam)  :  Y2 = Hi(Integer, lParam)
   Control Set Text GetParent(hWnd), %ID_POSIT, "Pos : " + Str$(X2) + "," + Str$(Y2)

   If candrag And (wParam And %MK_LBUTTON) Then           'if in drag sate then.....
      Call CanvasCleaner(%FALSE, %FALSE)
      If PointToPointDouble(X2, Y2, conn(curconn).aX1, conn(curconn).aY1) <= 10.0 Then
         conn(curconn).aX1 = X2  :  conn(curconn).aY1 = Y2
      ElseIf PointToPointDouble(X2, Y2, conn(curconn).aX2, conn(curconn).aY2) <= 10.0 Then
         conn(curconn).aX2 = X2  :  conn(curconn).aY2 = Y2
      ElseIf PointToPointDouble(X2, Y2, conn(curconn).aX3, conn(curconn).aY3) <= 10.0 Then
         conn(curconn).aX3 = X2  :  conn(curconn).aY3 = Y2
      ElseIf PointToPointDouble(X2, Y2, conn(curconn).aX4, conn(curconn).aY4) <= 10.0 Then
         conn(curconn).aX4 = X2  :  conn(curconn).aY4 = Y2
      End If
      For i = 1 to cntconn      'redraw all conns
         conwidth = conn(i).awidth
         contype  = conn(i).atype
         constyle = conn(i).astyle
         canpoints = Iif(i = curconn, %TRUE, %FALSE)
         Call DrawPoints(0, 0, 0, 0, i)
      Next i
   ElseIf canresize And (wParam And %MK_LBUTTON) Then           'if in resize sate then.....
      Call CanvasCleaner(%FALSE, %FALSE)
      If PointToPointDouble(X2, Y2, conn(curconn).aX1, conn(curconn).aY1) <= 10.0 Then
         conn(curconn).aX1 = X2  :  conn(curconn).aY1 = Y2
      ElseIf PointToPointDouble(X2, Y2, conn(curconn).aX4, conn(curconn).aY4) <= 10.0 Then
         conn(curconn).aX4 = X2  :  conn(curconn).aY4 = Y2
      End If
      For i = 1 to cntconn      'redraw all conns
         conwidth = conn(i).awidth
         contype  = conn(i).atype
         constyle = conn(i).astyle
         canpoints = Iif(i = curconn, %TRUE, %FALSE)
         Call DrawPoints(0, 0, 0, 0, i)
      Next i
   ElseIf candraw And (wParam And %MK_LBUTTON) Then            'if in draw state then....
      If oldX1 > -1 Then Call DrawPoints(oldX1, oldY1, oldX2, oldY2, 0)
      Call DrawPoints(X1, Y1, X2, Y2, 0)
      oldX1 = X1  :  oldY1 = Y1
      oldX2 = X2  :  oldY2 = Y2
   End If
   Graphic ReDraw
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub RightButtonDown(hWnd As Dword)
   Local i As Long

   candraw   = 0  :  canresize = 0  :  candrag = 0  :  canpoints  = %FALSE
   Call CanvasCleaner(%FALSE, %FALSE)
   If cntconn > 0 Then
      For i = 1 To cntconn
         Call DrawPoints(0, 0, 0, 0, i)
         Call DrawShapes(i)
      Next i
   End If
   Graphic Redraw
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub LeftButtonDown(ByVal hWnd As Dword, ByVal wParam As Dword, ByVal lParam As Long)
   Local i As Long

   SetCapture hWnd
   SetFocus hWnd
   Graphic Attach GetParent(hWnd), %ID_GRAPHIC, ReDraw
   X1 = Max(0, Lo(Integer, lParam))  :  Y1 = Max(0, Hi(Integer, lParam))
   Control Set Text GetParent(hWnd), %ID_CONNTXT, "Num : " + Str$(cntconn)
   If cntconn > 0 Then
      curconn = 0
      If canresize Then
         For i = 1 To cntconn
            If (PointToPointDouble(X1, Y1, conn(i).aX1, conn(i).aY1) <= 10.0) Or _
               (PointToPointDouble(X1, Y1, conn(i).aX2, conn(i).aY2) <= 10.0) Or _
               (PointToPointDouble(X1, Y1, conn(i).aX3, conn(i).aY3) <= 10.0) Or _
               (PointToPointDouble(X1, Y1, conn(i).aX4, conn(i).aY4) <= 10.0) Then
               candrag = i  :  curconn = i
               Control Set Text GetParent(hWnd), %ID_MODETXT, "Mode :  dragging" + Str$(i)
               Exit Sub
            End If
         Next i
      End If

      For i = 1 To cntconn
         If (PointToPointDouble(X1, Y1, conn(i).aX1, conn(i).aY1) <= 10.0) Or _
            (PointToPointDouble(X1, Y1, conn(i).aX4, conn(i).aY4) <= 10.0) Then
            canresize = i  :  curconn = i
            canpoints = %TRUE
            Control Set Text GetParent(hWnd), %ID_MODETXT, "Mode :  resizing" + Str$(i)
            Exit Sub
         End If
      Next i
   End If

   Call DrawRefresh(%FALSE)

   constyle = savestyle
   conwidth = savewidth
   contype  = savetype
   oldX1 = X1  :  oldY1 = Y1
   oldX2 = X1  :  oldY2 = Y1
   Graphic Set Mix %R2_NOTXORPEN
   canpoints = %FALSE
   Call DrawPoints(X1, Y1, X1, Y1, 0)
   Graphic ReDraw
   candraw = 1                  'set in creation state
   Control Set Text GetParent(hWnd), %ID_MODETXT, "Mode :  draw points"
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub LeftButtonUp(ByVal hWnd As Dword, ByVal wParam As Dword, ByVal lParam As Long)

   If canresize Then              'finish mouse resizing state
      Graphic Set Mix %R2_COPYPEN
      Call DrawPoints(oldX1, oldY1, oldX2, oldY2, canresize)
      'canresize = 0
      Graphic ReDraw
      oldX1  = -1  :  oldY1  = 0
      oldX2  = 0   :  oldY2  = 0
   ElseIf candrag Then            'finish conn dragging state
      candrag = 0
   ElseIf candraw Then            'finish conn creation state
      Graphic Set Mix %R2_COPYPEN
      Graphic ReDraw
      If newconn Then
         Incr cntconn              'store conn info on conn array
         Redim Preserve conn(1 To cntconn)
         conn(cntconn).atype  = contype
         conn(cntconn).awidth = conwidth
         conn(cntconn).astyle = constyle
         conn(cntconn).aX1   = apt(1).x
         conn(cntconn).aY1   = apt(1).y
         conn(cntconn).aX2   = apt(2).x
         conn(cntconn).aY2   = apt(2).y
         conn(cntconn).aX3   = apt(3).x
         conn(cntconn).aY3   = apt(3).y
         conn(cntconn).aX4   = apt(4).x
         conn(cntconn).aY4   = apt(4).y
         oldX1  = -1  :  oldY1  = 0
         oldX2  = 0   :  oldY2  = 0
         Call DrawShapes(cntconn)
      End If
   End If

   ReleaseCapture
   Control Set Text GetParent(hWnd), %ID_MODETXT, "Mode :  draw"
   Control Set Text GetParent(hWnd), %ID_CONNTXT, "Num : " + Str$(cntconn)
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub DrawRefresh(dpoints As Long)
   Local i As Long

   Call CanvasCleaner(%FALSE, %FALSE)
   If cntconn > 0 Then
      canpoints = dpoints
      For i = 1 To cntconn
         Call DrawPoints(0, 0, 0, 0, i)
      Next i
   End If
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub DrawPoints(frX As Double, frY As Double, toX As Double, toY As Double, nc As Long)
   Local dX As Double

   newconn = %FALSE
   'for new curve a minimum size is required, 36 pixels of distance between head and tail
   If (nc = 0) And (PointToPointDouble(frX, frY, toX, toY) <= Sharp3) Then
      canresize = 0  :  candrag = 0
      Exit sub
   End If
   newconn = %TRUE

   '--- common part for all styles
   If nc Then
      apt(1).x = conn(nc).aX1  :  apt(1).y = conn(nc).aY1
      apt(2).x = conn(nc).aX2  :  apt(2).y = conn(nc).aY2
      apt(3).x = conn(nc).aX3  :  apt(3).y = conn(nc).aY3
      apt(4).x = conn(nc).aX4  :  apt(4).y = conn(nc).aY4
      conwidth = conn(nc).awidth
      constyle = conn(nc).astyle
      contype  = conn(nc).atype
   Else
      apt(1).x = frX  :  apt(1).y = frY
      apt(4).x = toX  :  apt(4).y = toY
      dX = frX - toX
      If Abs(dX) < 20 Then dX = 20.0 Else dX = Abs(dX)
      If frX < toX Then
         apt(2).x = frX + dX  :  apt(2).y = frY
         apt(3).x = toX - dX  :  apt(3).y = toY
      Else
         apt(2).x = frX - dX  :  apt(2).y = frY
         apt(3).x = toX + dX  :  apt(3).y = toY
      End If
   End If

   Call DrawBezier
   If canpoints Then
      Graphic Width 1
      Graphic Style 2
      Graphic Line(apt(1).x,apt(1).y) - (apt(2).x,apt(2).y), %RED
      Graphic Line(apt(3).x,apt(3).y) - (apt(4).x,apt(4).y), %RED
      Graphic style 0
      Graphic Box (apt(1).x-3,apt(1).y-3) - (apt(1).x+3,apt(1).y+3),, %BLACK, %RED
      Graphic Box (apt(4).x-3,apt(4).y-3) - (apt(4).x+3,apt(4).y+3),, %BLACK, %RED
      Graphic Box (apt(2).x-3,apt(2).y-3) - (apt(2).x+3,apt(2).y+3),, %BLACK, %RED
      Graphic Box (apt(3).x-3,apt(3).y-3) - (apt(3).x+3,apt(3).y+3),, %BLACK, %RED
   Else
      If nc > 0 Then Call DrawShapes(nc)
   End If
   Graphic Width conwidth
   Graphic Style constyle
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub DrawShapes(nc As Long)
   '--- this procedure can be quite optimized, in size and speed ---
   '---      here is "as is" in benefit of clarity in code       ---
   Local poly As POLYARRAY
   local dist As Long
   Local slopy, hlX, hlY, hrX, hrY As Double

   'for draw arrow shaps a minimum size is required,
   '36 pixels of distance between head and tail
   dist = PointToPointLong(apt(1).x, apt(1).y, apt(4).x, apt(4).y)
   If dist <= Sharp3 Then exit Sub

   Graphic Style 0
   Graphic Width conwidth                      'sentence added 06/06/08, thanks Petr
   Select Case As Long contype
      Case 1   '--- line simple --- nothing to do for this type
      Case 2   '--- one end arrow --- one polygon
         slopy  = Atn2(apt(4).y - apt(3).y, apt(4).x - apt(3).x)
         hlX = Abs(apt(4).x-Sharp*Cos(slopy +MinusHead))
         hlY = Abs(apt(4).y-Sharp*Sin(slopy +MinusHead))
         hrX = Abs(apt(4).x+Sharp*Cos(slopy +PlusHead))
         hrY = Abs(apt(4).y+Sharp*Sin(slopy +PlusHead))
         poly.cnt = 3
         poly.xx1 = apt(4).x  :  poly.yy1 = apt(4).y
         poly.xx2 = hlX       :  poly.yy2 = hlY
         poly.xx3 = hrX       :  poly.yy3 = hrY
         Graphic Polygon poly, %BLUE, %BLUE
      Case 3   '--- two ends arrow --- two polygons
         slopy  = Atn2(apt(4).y - apt(3).y, apt(4).x - apt(3).x)
         hlX = Abs(apt(4).x-Sharp*Cos(slopy +MinusHead))
         hlY = Abs(apt(4).y-Sharp*Sin(slopy +MinusHead))
         hrX = Abs(apt(4).x+Sharp*Cos(slopy +PlusHead))
         hrY = Abs(apt(4).y+Sharp*Sin(slopy +PlusHead))
         poly.cnt = 3
         poly.xx1 = apt(4).x  :  poly.yy1 = apt(4).y
         poly.xx2 = hlX       :  poly.yy2 = hlY
         poly.xx3 = hrX       :  poly.yy3 = hrY
         Graphic Polygon poly, %BLUE, %BLUE
         slopy  = Atn2(apt(1).y - apt(2).y, apt(1).x - apt(2).x)
         hlX = Abs(apt(1).x-Sharp*Cos(slopy +MinusHead))
         hlY = Abs(apt(1).y-Sharp*Sin(slopy +MinusHead))
         hrX = Abs(apt(1).x+Sharp*Cos(slopy +PlusHead))
         hrY = Abs(apt(1).y+Sharp*Sin(slopy +PlusHead))
         poly.cnt = 3
         poly.xx1 = apt(1).x  :  poly.yy1 = apt(1).y
         poly.xx2 = hlX       :  poly.yy2 = hlY
         poly.xx3 = hrX       :  poly.yy3 = hrY
         Graphic Polygon poly, %BLUE, %BLUE
   End Select
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub CanvasCleaner(clearAll As Long, wantRedraw As Long)
   Local j As Long

   Graphic Clear
   Graphic Width 1
   If clearAll Then
      cntconn = 0  :  candraw   = 0  :  canresize = 0
      canpoints  = %FALSE  :  candrag = 0
      Redim conn()
      Control Set Text hDlg, %ID_CONNTXT, "Num : " + Str$(cntconn)
   End If
   For j = 0 To 19
      Graphic Line (j*20, 00) - (j*20, 400), %LTLINES
      Graphic Line (00, j*20) - (500, j*20), %LTLINES
   Next
   If wantRedraw Then Graphic Redraw
   Graphic Width conwidth
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function PointToPointDouble(pX1 As Double, pY1 As Double, pX2 As Double, pY2 As Double) As Double
   Function = Sqr((pX1-pX2)*(pX1-pX2) + (pY1-pY2)*(pY1-pY2))
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function PointToPointLong(pX1 As Long, pY1 As Long, pX2 As Long, pY2 As Long) As Long
   Function = Sqr((pX1-pX2)*(pX1-pX2) + (pY1-pY2)*(pY1-pY2))
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function Atn2(X As Double, Y As Double) As Double
   'Atn2 optimized version. Simple but sufficient for this purpose.
   'Range of the result is 0 to 2Pi radians.
   If Y = 0 Then Y = NearZero
   Function = (Atn(Abs(X)/Abs(Y)) * Sgn(X) - Pi/2) * Sgn(Y)
End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub DrawBezier()
   'As only one Graphic Attach sentence is used in this program hDC is obtained
   'in %WM_INITDIALOG and saved as Global.
   Local hPen As Dword

   hPen = SelectObject(hDC, CreatePen(constyle, conwidth, %BLUE))
   PolyBezier hDC, apt(1), 4
   DeleteObject hPen
End Sub

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'eof
Many thanks to Petr Schreiber who pointed out an error in the code.
The source code han been corrected.
Announcement

Forum Guidelines
