Jump to content


Athanasios Gardos

Member Since 21 Mar 2005
Offline Last Active Sep 27 2017 07:25 PM

Topics I've Started

Arrows

27 September 2017 - 07:18 PM

Option Explicit

Private Const PI As Double = 3.14159265359

Private Function FnCos(A As Single) As Single
    FnCos = Cos((CDbl(A) / 180#) * PI#)
End Function

Public Function FnSin(A As Single) As Single
    FnSin = Sin((CDbl(A) / 180#) * PI#)
End Function

Private Function FnArcTan(A As Single) As Single
    FnArcTan = Atn(A) * 180# / PI#
End Function

Public Function FnZero(A As Single) As Single
    If Abs(A) < 0.01 Then FnZero = 1 Else FnZero = 0
End Function

Private Sub PolarPoint(xc As Single, yc As Single, dist As Single, Angle As Single, xNew As Single, yNew As Single)
    xNew = xc + FnCos(Angle) * dist
    yNew = yc + FnSin(Angle) * dist
End Sub

Private Function LineInclination(x As Single, y As Single, xc As Single, yc As Single) As Single
    Dim Angle As Single
    If xc = x And yc = y Then
       LineInclination = 0
       Exit Function
    ElseIf FnZero(xc - x) = 1 Then
       If yc < y Then
          LineInclination = 90
       Else
          LineInclination = 270
       End If
       Exit Function
    ElseIf FnZero(yc - y) = 1 Then
       If xc < x Then
          LineInclination = 0
       Else
          LineInclination = 180
       End If
       Exit Function
    Else
       Angle = FnArcTan((yc - y) / (xc - x))
    End If
    Angle = Abs(Angle)
    If x >= xc And y < yc Then
       Angle = 360 - Angle
    ElseIf x < xc And y < yc Then
       Angle = 180 + Angle
    ElseIf x < xc And y >= yc Then
       Angle = 180 - Angle
    End If
    LineInclination = Angle
End Function

Private Sub Form_Load()
    Dim ArrowLength As Single, ArrowHeight As Single
    Call cAvax1.StartAvax
    ArrowLength = 0.2
    ArrowHeight = 0.4
    Call MakeArrow(0, 0, 0, 10, ArrowLength, ArrowHeight, True)
    Call MakeArrow(10, 10, 10, 0, ArrowLength, ArrowHeight, False)
    cAvax1.Command = AutoLimits_c
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call cAvax1.EndAvax
End Sub

Private Sub MakeArrow(x1 As Single, y1 As Single, x2 As Single, y2 As Single, ArrowLength As Single, ArrowHeight As Single, bFill As Boolean)
    Dim px1 As Single, py1 As Single, Angle As Single
    Dim px2 As Single, py2 As Single
    Dim xV() As Single, yV() As Single, zV() As Single
    ReDim xV(3) As Single, yV(3) As Single, zV(3) As Single
    Dim z As Single

    Angle = LineInclination(x1, y1, x2, y2)
    PolarPoint x2, y2, ArrowLength, Angle, px1, py1
    PolarPoint px1, py1, ArrowHeight / 2, Angle + 90, xV(1), yV(1)
    PolarPoint px1, py1, ArrowHeight / 2, Angle - 90, xV(2), yV(2)
    xV(3) = x2
    yV(3) = y2
    If bFill = False Then
       cAvax1.Add_Line xV(1), yV(1), z, xV(2), yV(2), z
       cAvax1.Add_Line xV(2), yV(2), z, xV(3), yV(3), z
       cAvax1.Add_Line xV(3), yV(3), z, xV(1), yV(1), z
    Else
       cAvax1.Add_Shape xV(), yV(), zV()
    End If

    Angle = Angle + 180
    If Angle > 360 Then Angle = Angle - 360
    PolarPoint x1, y1, ArrowLength, Angle, px2, py2
    PolarPoint px2, py2, ArrowHeight / 2, Angle + 90, xV(1), yV(1)
    PolarPoint px2, py2, ArrowHeight / 2, Angle - 90, xV(2), yV(2)
    xV(3) = x1
    yV(3) = y1
    If bFill = False Then
        cAvax1.Add_Line xV(1), yV(1), z, xV(2), yV(2), z
        cAvax1.Add_Line xV(2), yV(2), z, xV(3), yV(3), z
        cAvax1.Add_Line xV(3), yV(3), z, xV(1), yV(1), z
    Else
       cAvax1.Add_Shape xV(), yV(), zV()
    End If

    If bFill = False Then
       cAvax1.Add_Line px2, py2, z, px1, py1, z
    Else
       cAvax1.Add_Line px2, py2, z, px1, py1, z, , , 2
    End If
End Sub