السلام عليكم
عند محاولتي التعامل مع اجهزة تحديد المواقع GPS وفي نفس الوقت بناء برنامج لحساب اوقات الصلاة واتجاه القبلة احتجت الى بعض الوظائف الغير موجودة في Visual Basic 6 او Visual Basic ,NET
وقد يحتاج الكثيرون هذه المعادلات سواء لحساب اوقات الصلاة او غيرها
ضع الكود التالية في ما يسمى Module
Option Explicit
Public Type Vector2D
x As Single
y As Single
End Type
Public Const PI As Double = 3.14159265358979 'Tan(1) * 180
Public Const D2R As Double = 1 / (180 * PI)
Public Const R2D As Double = 180 * PI
Public Const TwoPi As Single = 6.2831853071795
Public Const ThreePiByTwo As Single = 4.71238898038469
Public Const PiByTwo As Single = 1.5707963267949
Private dX As Long
Private dY As Long
Public Function ArcCos(A As Double) As Double
'Inverse Cosine
On Error Resume Next
If A = 1 Then
ArcCos = 0
Exit Function
End If
ArcCos = Atn(-A / Sqr(-A * A + 1)) + 2 * Atn(1)
On Error GoTo 0
End Function
Public Function ArcSin(x As Double) As Double
'Inverse Sine
On Error Resume Next
ArcSin = Atn(x / Sqr(-x * x + 1))
On Error GoTo 0
End Function
Public Function ArcTan(x As Double) As Double
'Inverse Tangent
On Error Resume Next
ArcTan = Atn(x) * (180 / PI)
On Error GoTo 0
End Function
Public Function DegToRad(Degrees As Single) As Single
'DegToRad = Degrees / 180 * Pi
DegToRad = Degrees * D2R
End Function
Public Function DotProduct2D(FirstVector As Vector2D, SecondVector As Vector2D) As Single
'Calculates the dotproduct
'Calculate the DotProduct based on FX*SX + FY*SY
DotProduct2D = (FirstVector.x * SecondVector.x) + (FirstVector.y * SecondVector.y)
'If DotProduct2D = 0 Then DotProduct2D = 1 -> replaced by:
If DotProduct2D = 0 Then
DotProduct2D = 1
End If
End Function
Public Function GetAngle(P As Vector2D, Q As Vector2D) As Single
'Get the angle of 2 vectors, note:
'always assume that the third vector(the origin of the angle) of the 2 vectors is 0, if not it will return odd results
Dim tmpAngle As Single
tmpAngle = ArcCos(DotProduct2D(P, Q) / (VectorLength2D(Q) * VectorLength2D(P)))
GetAngle = RadToDeg(tmpAngle)
If Not Sgn(P.x) = Sgn(Q.y) Then
GetAngle = 0 - GetAngle
End If
End Function
Public Function GetDifferenceAngle(ByVal sourceAngle As Single, ByVal targetAngle As Single) As Single
'get the difference between the source angle and the target angle (in radians)
GetDifferenceAngle = targetAngle - sourceAngle
Do While GetDifferenceAngle > PI
GetDifferenceAngle = GetDifferenceAngle - TwoPi
Loop
Do While GetDifferenceAngle < -PI
GetDifferenceAngle = GetDifferenceAngle + TwoPi
Loop
End Function
Public Function GetDirection(ByVal xVelocity As Long, ByVal yVelocity As Long) As Single
Dim Direction As Single
If yVelocity < 0 Then
Direction = PI + Atn(xVelocity / yVelocity)
ElseIf yVelocity > 0 Then
Direction = Atn(xVelocity / yVelocity)
If Direction < 0 Then
Direction = Direction + TwoPi
End If
ElseIf xVelocity <= 0 Then
Direction = ThreePiByTwo
Else
Direction = PiByTwo
End If
GetDirection = Direction
End Function
Public Function GetDistance(CurX As Long, CurY As Long, NewX As Long, NewY As Long) As Long
dX = NewX - CurX
dY = NewY - CurY
GetDistance = Sqr(dX * dX + dY * dY)
End Function
Public Function GetSpeed(ByVal xVelocity As Long, ByVal yVelocity As Long) As Single
GetSpeed = Sqr(xVelocity ^ 2 + yVelocity ^ 2)
End Function
Public Function GetVectorPositionFromAngle(Position As Vector2D, Angle As Double, Steps As Double) As Vector2D
'Calculate a new position based on an old position, an angle, and steps
GetVectorPositionFromAngle.x = Position.x + Round(Steps * Cos(Angle))
GetVectorPositionFromAngle.y = Position.y + Round(Steps * Sin(Angle))
End Function
Public Function GetVelocityX(ByVal Speed As Long, ByVal Direction As Single) As Long
GetVelocityX = Speed * Sin(Direction)
End Function
Public Function GetVelocityY(ByVal Speed As Long, ByVal Direction As Single) As Long
GetVelocityY = Speed * Cos(Direction)
End Function
Public Function IsInTriangle2D(Position As Vector2D, FirstVector As Vector2D, SecondVector As Vector2D, ThirdVector As Vector2D) As Boolean
'Checks if a point is inside or outside a triangle
Dim bc As Double
Dim ca As Double
Dim ab As Double
Dim ap As Double
Dim bp As Double
Dim cp As Double
Dim abc As Double
bc = SecondVector.x * ThirdVector.y - SecondVector.y * ThirdVector.x
ca = ThirdVector.x * FirstVector.y - ThirdVector.y * FirstVector.x
ab = FirstVector.x * SecondVector.y - FirstVector.y * SecondVector.x
ap = FirstVector.x * Position.y - FirstVector.y * Position.x
bp = SecondVector.x * Position.y - SecondVector.y * Position.x
cp = ThirdVector.x * Position.y - ThirdVector.y * Position.x
abc = Sgn(bc + ca + ab)
If (abc * (bc - bp + cp) > 0) And (abc * (ca - cp + ap) > 0) And (abc * (ab - ap + bp) > 0) Then
IsInTriangle2D = True
End If
End Function
Public Function RadToDeg(Radians As Single) As Single
'RadToDeg = Radians * 180 / Pi
RadToDeg = Radians * R2D
End Function
Public Function VectorAddition2D(FirstVector As Vector2D, SecondVector As Vector2D) As Vector2D
'Returns two vectors added together
With VectorAddition2D
'Add
.x = FirstVector.x + SecondVector.x
.y = FirstVector.y + SecondVector.y
End With
End Function
Public Function VectorDistance2D(FirstVector As Vector2D, SecondVector As Vector2D) As Single
'Calculates the length based on Phytagoras theory
VectorDistance2D = VectorLength2D(VectorSubtract2D(FirstVector, SecondVector))
End Function
Public Function VectorLength2D(Vector As Vector2D) As Single
'Calculates the length based on Phytagoras theory
VectorLength2D = Sqr((Vector.x ^ 2) + (Vector.y ^ 2))
End Function
Public Function VectorNormalize2D(Vector As Vector2D) As Vector2D
'Returns a vector with a length of one, but still in the same direction
Dim VecLength As Single
VecLength = VectorLength2D(Vector)
'If VecLength = 0 Then VecLength = 1 -> replaced by:
If VecLength = 0 Then
VecLength = 1
End If
With VectorNormalize2D
.x = Vector.x / VecLength
.y = Vector.y / VecLength
End With
End Function
Public Function VectorSubtract2D(FirstVector As Vector2D, SecondVector As Vector2D) As Vector2D
'Returns the FirstVector subtracted by the SecondVector
With VectorSubtract2D
'Subtract the vectors
.x = FirstVector.x - SecondVector.x
.y = FirstVector.y - SecondVector.y
End With
End Function
لاستخدام نفس الوحدة النمطية في Visual Basic .NET لاتنسى تغيير بعض اسماء الوظائف مثل
SQR
الى
SQRT
Atn
الى
Atan
Sgn
الى
Sign
بالتوفيق
