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

Connectors with PB Graphics

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

  • Connectors with PB Graphics

    Code:
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' Connector.bas                by Jordi Vallès        version 1a      31/05/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 a rigth line. To solve this problem the connectors shown
    ' here can help.
    '
    ' This program is a continuation or complement of my previous post:
    '   Arrows with PB Graphics
    '
    ' - Arrows, after created, can be resized, reoriented and dragged using left
    '   mouse button over each end (or near) of selected arrow.
    ' - Middle segment of straight arrow can be dragged to adjust the adequate place,
    '   orientation and arrow shape.
    ' (This behaviour try to be similar offered to in some Microsoft Office products
    ' for their straight 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.
    '  - Only PB Graphic package is used to display information generated by program.
    '  - Part of code is borrowed from PwrPaint.bas on PB for Windows in Samples folder.
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' SED_PBWIN
    
    #Compile Exe "Connector.exe"
    #Dim All
    #Include "Win32Api.inc"
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    %ID_CONN1     = 1001
    %ID_CONN2     = 1002
    %ID_CONN3     = 1003
    %ID_CONN4     = 1004
    %ID_CONN5     = 1005
    %ID_CONN6     = 1006
    %ID_CONN7     = 1007
    %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)
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Macro Pi        = 3.141592653589793#
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    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
       arX1   As Double  :  arY1 As Double    'segment points
       arX2   As Double  :  arY2 As Double
       arX3   As Double  :  arY3 As Double
       arX4   As Double  :  arY4 As Double
       ajdX   As Double  :  ajdY As Double    'distance of Xs and Ys
    End Type
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Global oldGraphicProc        As Dword
    Global X1, Y1, X2, Y2        As Double
    Global oldX1, oldY1          As Double
    Global oldX2, oldY2          As Double
    Global j2X, j2Y, j3X, j3Y    As Double
    Global jdX, jdY, jft         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 conn()                As ARROWSTORE
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Declare Function PointToPointDistance(px1 As Double, py1 As Double, px2 As Double, py2 As Double) As Double
    Declare Function PointToLineDistance(mx As Double, my as Double, x1 As Double, y1 As Double, _
                                         x2 As Double, y2 As Double) As Double
    Declare Function TestPointInLine(mx As Double, my as Double, x1 As Double, y1 As Double, _
                                     x2 As Double, y2 As Double, linew As Long) As Long
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function PBMain () As Long
       Local hDlg As Dword
       Local w, h As Long
    
       Dialog New Pixels, 0, "Connectors 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",                 422,  24, 126, 16, %WS_GROUP
       Control Add Option,   hDlg, %ID_CONN2,   "Simple",               422,  40, 126, 16
       Control Add Option,   hDlg, %ID_CONN3,   "Double",               422,  56, 126, 16
       Control Add Option,   hDlg, %ID_CONN4,   "Aggregation arrow",    422,  72, 126, 16
       Control Add Option,   hDlg, %ID_CONN5,   "Composition arrow",    422,  88, 126, 16
       Control Add Option,   hDlg, %ID_CONN6,   "Generalization arrow", 422, 104, 120, 16
       Control Add Option,   hDlg, %ID_CONN7,   "Interface connector",  422, 120, 120, 16
       Control Set Option    hDlg, %ID_CONN1, %ID_CONN1, %ID_CONN7
    
       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
             oldGraphicProc = SetWindowLong(hGraphic, %GWL_WNDPROC, CodePtr(GraphicProc))
             contype = 1   :  conwidth = 1   :  constyle = 0
             savetype = 1  :  savewidth = 1  :  savestyle = 0
             Call CanvasCleaner(CbHndl, %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_CONN7            '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(CbHndl, %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)
       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, j As Long
       Local pt As POINTAPI
       Local dX, dY, d1, d2 As Double
    
       X2 = Lo(Integer, lParam)  :  Y2 = Hi(Integer, lParam)
       Control Set Text GetParent(hWnd), %ID_POSIT, "Pos : " + Str$(X2) + "," + Str$(Y2)
    
       If canresize And (wParam And %MK_LBUTTON) Then           'if in resize sate then.....
          Call CanvasCleaner(hWnd, %FALSE, %FALSE)
          GetCursorPos pt
          ScreenToClient hWnd, pt
          dX = pt.x  :  dY = pt.y    'convert to double
          d1 = PointToPointDistance(dX, dY, conn(curconn).arX1, conn(curconn).arY1)
          d2 = PointToPointDistance(dX, dY, conn(curconn).arX4, conn(curconn).arY4)
          If d1 < d2 Then            'check wich end is more near to mouse pointer
             conn(curconn).arX1 = dX
             conn(curconn).arY1 = dY
          Else
             conn(curconn).arX4 = dX
             conn(curconn).arY4 = dY
          End If
          For i = 1 to cntconn      'redraw all conns
             conwidth = conn(i).awidth
             contype  = conn(i).atype
             constyle = conn(i).astyle
             If i <> curconn Then j = i Else j = 0
             Call DrawConnectors(conn(i).arX1, conn(i).arY1, conn(i).arX4, conn(i).arY4, j)
             If j = 0 Then conn(i).aform = jft
             conn(i).arX2  = j2X  :  conn(i).arY2 = j2Y
             conn(i).arX3  = j3X  :  conn(i).arY3 = j3Y
          Next i
       ElseIf candrag And (wParam And %MK_LBUTTON) Then            'if in drag state then....
          Call CanvasCleaner(hWnd, %FALSE, %FALSE)
          Call MoveMiddleSegment(X2, Y2, candrag)
          For i = 1 to cntconn         'redraw all conns
             If candrag <> i Then
                conwidth = conn(i).awidth
                contype  = conn(i).atype
                constyle = conn(i).astyle
                Call DrawConnectors(conn(i).arX1, conn(i).arY1, conn(i).arX4, conn(i).arY4, i)
             End If
          Next
       ElseIf candraw And (wParam And %MK_LBUTTON) Then            'if in draw state then....
          If oldX1 > -1 Then Call DrawConnectors(oldX1, oldY1, oldX2, oldY2, 0)
          Call DrawConnectors(X1, Y1, X2, Y2, 0)
          oldX1 = X1  :  oldY1 = Y1
          oldX2 = X2  :  oldY2 = Y2
       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
          For i = 1 To cntconn
             If TestPointInLine(X1, Y1, conn(i).arX2, conn(i).arY2, conn(i).arX3, conn(i).arY3, conn(i).awidth) Then
                candrag = i                'set in dragging state
                Control Set Text GetParent(hWnd), %ID_MODETXT, "Mode :  dragging" + Str$(i)
                Exit Sub
             ElseIf (PointToPointDistance(X1, Y1, conn(i).arX1, conn(i).arY1) <= 6.0) Or _
                    (PointToPointDistance(X1, Y1, conn(i).arX4, conn(i).arY4) <= 6.0) Then
                canresize = i              'set in resize state
                curconn = i
                Control Set Text GetParent(hWnd), %ID_MODETXT, "Mode :  resizing" + Str$(i)
                Exit Sub
             End If
          Next i
       End If
    
       constyle = savestyle
       conwidth = savewidth
       contype  = savetype
       oldX1 = X1  :  oldY1 = Y1
       oldX2 = X1  :  oldY2 = Y1
       Graphic Set Mix %R2_NOTXORPEN
       Call DrawConnectors(X1, Y1, X1, Y1, 0)
       Graphic ReDraw
       candraw = 1                  'set in creation state
       Control Set Text GetParent(hWnd), %ID_MODETXT, "Mode :  draw"
    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 DrawConnectors(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
          candraw = 0
          Graphic Set Mix %R2_COPYPEN
          Call DrawConnectors(oldX1, oldY1, oldX2, oldY2, 0)
          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).aform  = jft   'orientation
             conn(cntconn).arX1   = oldX1
             conn(cntconn).arY1   = oldY1
             conn(cntconn).arX2   = j2X
             conn(cntconn).arY2   = j2Y
             conn(cntconn).arX3   = j3X
             conn(cntconn).arY3   = j3Y
             conn(cntconn).arX4   = oldX2
             conn(cntconn).arY4   = oldY2
             conn(cntconn).ajdX   = jdX
             conn(cntconn).ajdY   = jdY
             oldX1  = -1  :  oldY1  = 0
             oldX2  = 0   :  oldY2  = 0
          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 MoveMiddleSegment(mX As Double, mY As Double, nc As Long)
       '--- to be improved with same PowerPoint behaviour ---
       newconn = %FALSE
       contype  = conn(nc).atype
       conwidth = conn(nc).awidth
       constyle = conn(nc).astyle
       Graphic Width conwidth
       Graphic Style constyle
    
       Select Case conn(nc).aform             'middle segment orientation
          Case 1                              'is N-S or S-N
             If conn(nc).arX1 < conn(nc).arX4 Then
                If mX < conn(nc).arX1+10 Then mX = conn(nc).arX1+10
                If mX > conn(nc).arX4-10 Then mX = conn(nc).arX4-10
             Else
                If mX > conn(nc).arX1-10 Then mX = conn(nc).arX1-10
                If mX < conn(nc).arX4+10 Then mX = conn(nc).arX4+10
             End If
             Graphic Line (conn(nc).arX1, conn(nc).arY1) - (mX, conn(nc).arY2)
             Graphic Line                                - (mX, conn(nc).arY3)
             Graphic Line                                - (conn(nc).arX4, conn(nc).arY4)
             conn(nc).arX2 = mX
             conn(nc).arX3 = mX
          Case 2                              'is E-W or W-E
             If conn(nc).arY1 < conn(nc).arY4 Then
                If mY < conn(nc).arY1+10 Then mY = conn(nc).arY1+10
                If mY > conn(nc).arY4-10 Then mY = conn(nc).arY4-10
             Else
                If mY > conn(nc).arY1-10 Then mY = conn(nc).arY1-10
                If mY < conn(nc).arY4+10 Then mY = conn(nc).arY4+10
             End If
             Graphic Line (conn(nc).arX1, conn(nc).arY1) - (conn(nc).arX2, mY)
             Graphic Line                                - (conn(nc).arX3, mY)
             Graphic Line                                - (conn(nc).arX4, conn(nc).arY4)
             conn(nc).arY2 = mY
             conn(nc).arY3 = mY
       End Select
    
       conn(nc).adrag = %TRUE
       conn(nc).ajdX = conn(nc).arX4-conn(nc).arX1
       conn(nc).ajdY = conn(nc).arY4-conn(nc).arY1
       Call DrawShapes(conn(nc).arX1, conn(nc).arY1, conn(nc).arX4, conn(nc).arY4, conn(nc).ajdX, conn(nc).ajdY)
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub DrawConnectors(frX As Double, frY As Double, toX As Double, toY As Double, nc As Long)
       '--- this procedure can be quite optimized, in size and speed ---
       '---      here is "as is" in benefit of clarity in code       ---
       newconn = %FALSE
       If PointToPointDistance(frX, frY, toX, toY) <= 20 Then Exit Sub
       If not nc Then newconn = %TRUE
    
       '--- common part for all styles
       Graphic Width conwidth
       Graphic Style constyle
    
       If nc Then
          Graphic Line (conn(nc).arX1, conn(nc).arY1) - (conn(nc).arX2, conn(nc).arY2)
          Graphic Line                                - (conn(nc).arX3, conn(nc).arY3)
          Graphic Line                                - (conn(nc).arX4, conn(nc).arY4)
          j2X = conn(nc).arX2  :  j2Y = conn(nc).arY2
          j3X = conn(nc).arX3  :  j3Y = conn(nc).arY3
          conn(nc).ajdX = conn(nc).arX4-conn(nc).arX1
          conn(nc).ajdY = conn(nc).arY4-conn(nc).arY1
          If Abs(conn(nc).ajdX) > Abs(conn(nc).ajdY) Then conn(nc).aform = 1 Else conn(nc).aform = 2  'orientation
          Call DrawShapes(conn(nc).arX1, conn(nc).arY1, conn(nc).arX4, conn(nc).arY4, conn(nc).ajdX, conn(nc).ajdY)
       Else
          jdX = toX-frX  :  jdY = toY-frY
          If Abs(jdX) > Abs(jdY) Then
             Graphic Line (frX, frY) - (frX+jdX/2, frY)
             Graphic Line            - (frX+jdX/2, toY)
             Graphic Line            - (toX, toY)
             j2X = frX+jdX/2  :  j2Y = frY
             j3X = frX+jdX/2  :  j3Y = toY
             jft = 1              'orientation N-S
          Else
             Graphic Line (frX, frY) - (frX, frY+jdY/2)
             Graphic Line            - (toX, frY+jdY/2)
             Graphic Line            - (toX, toY)
             j2X = frX  :  j2Y = frY+jdY/2
             j3X = toX  :  j3Y = frY+jdY/2
             jft = 2
          End If                  'orientation W-E
          Call DrawShapes(frX, frY, toX, toY, jdX, jdY)
       End If
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub DrawShapes(frX As Double, frY As Double, toX As Double, toY As Double, jiX As Double, jiY As Double)
       '--- this procedure can be quite optimized, in size and speed ---
       '---      here is "as is" in benefit of clarity in code       ---
       Local poly1, poly2 As POLYARRAY
    
       Graphic Style 0
       Select Case As Long contype
          Case 1   '--- line simple --- nothing to do for this type
          Case 2   '--- one end arrow --- one polygon
             poly1.cnt = 3
             poly1.xx1 = toX  :  poly1.yy1 = toY
             If Abs(jiX) > Abs(jiY) Then
                If jiX > jiY Then
                   poly1.xx2 = toX-10  :  poly1.yy2 = toY-4
                   poly1.xx3 = toX-10  :  poly1.yy3 = toY+4
                Else
                   poly1.xx2 = toX+10  :  poly1.yy2 = toY-4
                   poly1.xx3 = toX+10  :  poly1.yy3 = toY+4
                End If
             Else
                If jiX < jiY Then
                   poly1.xx2 = toX-4  :  poly1.yy2 = toY-10
                   poly1.xx3 = toX+4  :  poly1.yy3 = toY-10
                Else
                   poly1.xx2 = toX-4  :  poly1.yy2 = toY+10
                   poly1.xx3 = toX+4  :  poly1.yy3 = toY+10
                End If
             End If
             Graphic Polygon poly1, %BLUE, %BLUE
         Case 3   '--- two ends arrow --- two polygons
             poly1.cnt = 3    :  poly2.cnt = 3
             poly1.xx1 = toX  :  poly1.yy1 = toY
             poly2.xx1 = frX  :  poly2.yy1 = frY
             If Abs(jiX) > Abs(jiY) Then
                If jiX > jiY Then
                   poly1.xx2 = toX-10  :  poly1.yy2 = toY-4
                   poly1.xx3 = toX-10  :  poly1.yy3 = toY+4
                   poly2.xx2 = frX+10  :  poly2.yy2 = frY-4
                   poly2.xx3 = frX+10  :  poly2.yy3 = frY+4
                Else
                   poly1.xx2 = toX+10  :  poly1.yy2 = toY-4
                   poly1.xx3 = toX+10  :  poly1.yy3 = toY+4
                   poly2.xx2 = frX-10  :  poly2.yy2 = frY-4
                   poly2.xx3 = frX-10  :  poly2.yy3 = frY+4
                End If
             Else
                If jiX < jiY Then
                   poly1.xx2 = toX-4  :  poly1.yy2 = toY-10
                   poly1.xx3 = toX+4  :  poly1.yy3 = toY-10
                   poly2.xx2 = frX-4  :  poly2.yy2 = frY+10
                   poly2.xx3 = frX+4  :  poly2.yy3 = frY+10
                Else
                   poly1.xx2 = toX-4  :  poly1.yy2 = toY+10
                   poly1.xx3 = toX+4  :  poly1.yy3 = toY+10
                   poly2.xx2 = frX-4  :  poly2.yy2 = frY-10
                   poly2.xx3 = frX+4  :  poly2.yy3 = frY-10
                End If
             End If
             Graphic Polygon poly1, %BLUE, %BLUE
             Graphic Polygon poly2, %BLUE, %BLUE
          Case 4, 5   '--- UML arrows --- two polygons
             poly1.cnt = 3    :  poly2.cnt = 4
             poly1.xx1 = toX  :  poly1.yy1 = toY
             poly2.xx1 = frX  :  poly2.yy1 = frY
             If Abs(jiX) > Abs(jiY) Then
                If jiX > jiY Then
                   poly1.xx2 = toX-10  :  poly1.yy2 = toY-4
                   poly1.xx3 = toX-10  :  poly1.yy3 = toY+4
                   poly2.xx2 = frX+10  :  poly2.yy2 = frY-4
                   poly2.xx3 = frX+20  :  poly2.yy3 = frY
                   poly2.xx4 = frX+10  :  poly2.yy4 = frY+4
                Else
                   poly1.xx2 = toX+10  :  poly1.yy2 = toY-4
                   poly1.xx3 = toX+10  :  poly1.yy3 = toY+4
                   poly2.xx2 = frX-10  :  poly2.yy2 = frY-4
                   poly2.xx3 = frX-20  :  poly2.yy3 = frY
                   poly2.xx4 = frX-10  :  poly2.yy4 = frY+4
                End If
             Else
                If jiX < jiY Then
                   poly1.xx2 = toX-4  :  poly1.yy2 = toY-10
                   poly1.xx3 = toX+4  :  poly1.yy3 = toY-10
                   poly2.xx2 = frX-4  :  poly2.yy2 = frY+10
                   poly2.xx3 = frX    :  poly2.yy3 = frY+20
                   poly2.xx4 = frX+4  :  poly2.yy4 = frY+10
                Else
                   poly1.xx2 = toX-4  :  poly1.yy2 = toY+10
                   poly1.xx3 = toX+4  :  poly1.yy3 = toY+10
                   poly2.xx2 = frX-4  :  poly2.yy2 = frY-10
                   poly2.xx3 = frX    :  poly2.yy3 = frY-20
                   poly2.xx4 = frX+4  :  poly2.yy4 = frY-10
                End If
             End If
             Graphic Polygon poly1, %BLUE, %BLUE
             Graphic Polygon poly2, %BLUE, Iif(contype = 4, %WHITE, %BLUE)
          Case 6   '--- discriminator arrow --- one polygon
             poly1.cnt = 3
             poly1.xx1 = toX  :  poly1.yy1 = toY
             If Abs(jiX) > Abs(jiY) Then
                If jiX > jiY Then
                   poly1.xx2 = toX-10  :  poly1.yy2 = toY-8
                   poly1.xx3 = toX-10  :  poly1.yy3 = toY+8
                Else
                   poly1.xx2 = toX+10  :  poly1.yy2 = toY-8
                   poly1.xx3 = toX+10  :  poly1.yy3 = toY+8
                End If
             Else
                If jiX < jiY Then
                   poly1.xx2 = toX-8  :  poly1.yy2 = toY-10
                   poly1.xx3 = toX+8  :  poly1.yy3 = toY-10
                Else
                   poly1.xx2 = toX-8  :  poly1.yy2 = toY+10
                   poly1.xx3 = toX+8  :  poly1.yy3 = toY+10
                End If
             End If
             Graphic Polygon poly1, %BLUE, %WHITE
          Case 7   '--- interface connector --- arcs are needed
             If  Abs(jiX) > Abs(jiY) Then
                If jiX > jiY Then
                   Graphic Arc (toX,toY-10) - (toX+20,toY+10), Pi/2, 3*Pi/2
                Else
                   Graphic Arc (toX-20,toY-10) - (toX,toY+10), 3*Pi/2, Pi/2
                End If
             Else
                If jiX < jiY Then
                   Graphic Arc (toX-10,toY) - (toX+10,toY+20), 0, Pi
                Else
                   Graphic Arc (toX-10,toY-20) - (toX+10,toY+1), Pi, 0
                End If
             End If
       End Select
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub CanvasCleaner(hWnd As Dword, clearAll As Long, wantRedraw As Long)
       Local j As Long
    
       Graphic Clear
       Graphic Width 1
       If clearAll Then
          cntconn = 0  :  Redim conn()
          Control Set Text hWnd, %ID_CONNTXT, "Num : " + Str$(cntconn)
       End If
       For j = 0 To 19
          Graphic Line (j*20, 00) - (j*20, 400), RGB(234,234,234)
          Graphic Line (00, j*20) - (500, j*20), RGB(234,234,234)
       Next
       If wantRedraw Then Graphic Redraw
       Graphic Width conwidth
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function PointToPointDistance(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 PointToLineDistance(pX As Double, pY as Double, vX1 As Double, vY1 As Double, _
                                 vX2 As Double, vY2 As Double) As Double
       Local dX, dY As Double
    
       If (vX1 = vX2) Then
          Function = Abs(vX1 - pX)
       ElseIf vY1 = vY2 Then
          Function = Abs(vY1 - pY)
       Else
          dX = vX2 - vX1  :  dY = vY2 - vY1
          Function = Abs(dY*pX - dX*pY + vX2*vY1 - vX1*vY2) / Sqr(dX*dX + dY*dY)
       End If
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function TestPointInLine(mX As Double, mY as Double, vX1 As Double, vY1 As Double, _
                             vX2 As Double, vY2 As Double, linew As Long) As Long
       'return true if the distance from point to line is within the width of line plus margin.
       'linew is the existing line width.
       Local distance, halflinew, pmargin As Double
    
       pmargin = 5.0
       'exit if the mouse click is past the endpoints of the line
       halflinew = linew/2
       If (vX1 < vX2) Then
          If (mX < vX1-pmargin) Or (mX > vX2+pmargin) Then Exit Function
       Else
          If (mX > vX1+pmargin) Or (mX < vX2-pmargin) Then Exit Function
       End If
       If (vY1 < vY2) Then
          If (mY < vY1-pmargin) Or (mY > vY2+pmargin) Then Exit Function
       Else
          If (mY > vY1+pmargin) Or (mY < vY2-pmargin) Then Exit Function
       End If
       distance = Abs(PointToLineDistance(mX, mY, vX1, vY1, vX2, vY2))
       Function = (distance >= -halflinew-pmargin) And (distance <= halflinew+pmargin)
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    'eof
Working...
X