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

Curved Arrows with PB Graphics, almost

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

  • Jordi Vallès
    replied
    The sentence
    Code:
    Graphic Width conwidth
    han been added in source code, inside DrawShapes subroutine, in order to solve a problem related with the width of arrow shapes.

    Thanks to Petr Schreiber than report this error.
    Jordi

    Leave a comment:


  • Jordi Vallès
    started a topic Curved Arrows with PB Graphics, almost

    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:
    '   Arrows with PB Graphics and
    '   Connectors with PB Graphics
    '
    ' Good explanation and tutorial, with animated samples, about this kind of curves
    ' can be found in:
    '   Wikipedia: Bézier curves
    '
    ' 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.
    Last edited by Jordi Vallès; 6 Jun 2008, 12:58 PM. Reason: Sentence added on DrawShapes.
Working...
X