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
The source code han been corrected.
Comment