VB 5/6-Tipp 0714: Alle trigonometrischen / transzendenten Funktionen
von Oliver Meyer
Beschreibung
Hier ein kleines Modul, welches alle trigonometrischen, bzw. transzendenten Funktionen incl. Test-Routinen und Grafikausgabe beinhaltet.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: keine | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Projekt1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Kombinationsliste "CmbGrafikTest" ' Steuerelement: Bildfeld-Steuerelement "PBTrigo" ' Steuerelement: Schaltfläche "BtnTextTest" ' Steuerelement: Textfeld "TxtTrigo" ' Steuerelement: Beschriftungsfeld "LblGrafikTest" Option Explicit Private Sub Form_Load() Call FillCombo(CmbGrafikTest) Call BtnTextTest_Click PBTrigo.ScaleMode = 7 'cm End Sub Private Sub FillCombo(aCMB As ComboBox) Dim A: A = Array( _ "Sinus", "Cosinus", "Tangens", _ "Cosecans", "Secans", "Cotangens", _ "ArcusSinus", "ArcusCosinus", "ArcusTangens", _ "ArcusCosecans", "ArcusSecans", "ArcusCotangens", _ "SinusHyperbolicus", "CosinusHyperbolicus", "TangensHyperbolicus", _ "CosecansHyperbolicus", "SecansHyperbolicus", "CotangensHyperbolicus", _ "AreaSinusHyperbolicus", "AreaCosinusHyperbolicus", "AreaTangensHyperbolicus", _ "AreaCosecansHyperbolicus", "AreaSecansHyperbolicus", "AreaCotangensHyperbolicus", _ "SinusCardinalis") Dim i As Long With aCMB .Clear For i = 0 To UBound(A) Call .AddItem(A(i)) Next End With aCMB.Text = "Sinus" End Sub Private Sub CmbGrafikTest_Click() PBTrigo.ZOrder 0 PBTrigo.Refresh End Sub 'Private Sub CmbGrafikTest_Change() ' PBTrigo.ZOrder 0 ' PBTrigo.Refresh 'End Sub Private Sub BtnTextTest_Click() TxtTrigo.ZOrder 0 Call TextTestTrigo End Sub Private Sub TextTestTrigo() Dim t As String t = t & TestTrigonoMath t = t & TestATAN t = t & TestAngleConverter t = t & TestLogarithm t = t & TestFloorCeilingBigMul TxtTrigo.Text = t End Sub Private Function TestTrigonoMath() As String Dim s As String Dim A As Double, r As Double s = s & "Test Trigono Math" & vbCrLf A = PI / 3 r = ModTrigonoMath.Sinus(A) s = s & " Sinus(" & Format(RadToDeg(A), "0.0°") & ") = " & Format(r, "0.000") & vbCrLf r = ModTrigonoMath.Cosinus(A) s = s & " Cosinus(" & Format(RadToDeg(A), "0.0°") & ") = " & Format(r, "0.000") & vbCrLf r = ModTrigonoMath.Tangens(A) s = s & " Tangens(" & Format(RadToDeg(A), "0.0°") & ") = " & Format(r, "0.000") & vbCrLf r = ModTrigonoMath.Cosecans(A) s = s & " Cosecans(" & Format(RadToDeg(A), "0.0°") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.Secans(A) s = s & " Secans(" & Format(RadToDeg(A), "0.0°") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.Cotangens(A) s = s & " Cotangens(" & Format(RadToDeg(A), "0.0°") & ") = " & CStr(r) & vbCrLf A = 0.5 r = ModTrigonoMath.ArcusSinus(A) s = s & " ArcusSinus(" & Format(A, "0.000") & ") = " & Format(RadToDeg(r), "0.0°") & vbCrLf r = ModTrigonoMath.ArcusCosinus(A) s = s & " ArcusCosinus(" & Format(A, "0.000") & ") = " & Format(RadToDeg(r), "0.0°") & vbCrLf A = Sqr(3) r = ModTrigonoMath.ArcusTangens(A) s = s & " ArcusTangens(" & Format(A, "0.000") & ") = " & Format(RadToDeg(r), "0.0°") & vbCrLf A = 1.5 r = ModTrigonoMath.ArcusCosecans(A) s = s & " ArcusCosecans(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.ArcusSecans(A) s = s & " ArcusSecans(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.ArcusCotangens(A) s = s & " ArcusCotangens(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.SinusHyperbolicus(A) s = s & " SinusHyperbolicus(" & Format(RadToDeg(A), "0.000") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.CosinusHyperbolicus(A) s = s & " CosinusHyperbolicus(" & Format(RadToDeg(A), "0.000") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.TangensHyperbolicus(A) s = s & " TangensHyperbolicus(" & Format(RadToDeg(A), "0.000") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.CosecansHyperbolicus(A) s = s & " CosecansHyperbolicus(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.SecansHyperbolicus(A) s = s & " SecansHyperbolicus(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.CotangensHyperbolicus(A) s = s & " CotangensHyperbolicus(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf A = 0.5 r = ModTrigonoMath.AreaSinusHyperbolicus(A) s = s & " AreaSinusHyperbolicus(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf A = 1.5 r = ModTrigonoMath.AreaCosinusHyperbolicus(A) s = s & " AreaCosinusHyperbolicus(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf A = 0.5 r = ModTrigonoMath.AreaTangensHyperbolicus(A) s = s & " AreaTangensHyperbolicus(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.AreaCosecansHyperbolicus(A) s = s & " AreaCosecansHyperbolicus(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf r = ModTrigonoMath.AreaSecansHyperbolicus(A) s = s & " AreaSecansHyperbolicus(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf A = 1.5 r = ModTrigonoMath.AreaCotangensHyperbolicus(A) s = s & " AreaCotangensHyperbolicus(" & Format(A, "0.000") & ") = " & CStr(r) & vbCrLf TestTrigonoMath = s & vbCrLf End Function Private Function TestATAN() As String Dim s As String s = s & "Test ArcusTangensXY (aka Atan2)" & vbCrLf s = s & TestATANToString(0, 0) s = s & TestATANToString(1.5, 0) s = s & TestATANToString(0, 1.5) s = s & TestATANToString(1.2, 1.5) s = s & TestATANToString(-1.5, 0) s = s & TestATANToString(0, -1.5) s = s & TestATANToString(-1.2, -1.5) s = s & TestATANToString(1.2, -1.5) s = s & TestATANToString(-1.2, 1.5) TestATAN = s & vbCrLf End Function Private Function TestATANToString(ByVal x As Double, _ ByVal y As Double) As String Dim A As Double Dim s As String A = ArcusTangensXY(x, y) s = s & " ArcusTangensXY(x := " & _ Format$(x, "0.0") & "; y := " & Format$(x, "0.0") & ") = " & _ Format$(A, "0.000") & vbCrLf TestATANToString = s End Function Public Function TestAngleConverter() As String Dim angleD As Double ' Winkel in Grad Dim angleR As Double ' Winkel in Radians Dim angleG As Double ' Winkel in Gon angleD = 180# angleR = DegToRad(angleD) angleG = DegToGon(angleD) angleD = RadToDeg(angleR) angleG = RadToGon(angleR) angleD = GonToDeg(angleG) angleR = GonToRad(angleG) ' 180 3,14159265358979 200 TestAngleConverter = "Test Winkelkonvertierung: " & vbCrLf & _ " Angle [deg] = " & Format$(angleD, "0.0") & vbCrLf & _ " Angle [rad] = " & Format$(angleR, "0.00000") & vbCrLf & _ " Angle [gon] = " & Format$(angleG, "0.0") & vbCrLf End Function Public Function TestLogarithm() As String Dim s As String Dim x As Double Dim b As Double Dim N As Double Dim L As Double s = s & vbCrLf & "Test Logarithmus: " & vbCrLf x = 10000 b = 10 L = LogN(x, b) s = s & " LogN(" & CStr(x) & ", " & CStr(b) & ") = " & CStr(L) & vbCrLf b = 5 L = LogN(x, b) s = s & " LogN(" & CStr(x) & ", " & CStr(b) & ") = " & CStr(L) & vbCrLf b = 4 L = LogN(x, b) s = s & " LogN(" & CStr(x) & ", " & CStr(b) & ") = " & CStr(L) & vbCrLf N = 2 L = LogN(x, N) s = s & " LogN(" & CStr(x) & ", " & CStr(N) & ") = " & CStr(L) & vbCrLf ' N = 10 L = LogN(x) s = s & " LogN(" & CStr(x) & ") = " & CStr(L) & vbCrLf ' N = 10 L = Log10(x) ' , N) s = s & " Log10(" & CStr(x) & ") = " & CStr(L) & vbCrLf x = 2 L = LN(x) s = s & " Ln(" & CStr(x) & ") = " & CStr(L) & vbCrLf ' N = 1 L = LogN(x, 2) s = s & " LogN(" & CStr(x) & ") = " & CStr(L) & vbCrLf TestLogarithm = s End Function Private Function TestFloorCeilingBigMul() As String Dim s As String Dim d As Double s = s & vbCrLf & "Test Floor, Ceiling, BigMul" & vbCrLf d = 2147483649.12345 s = s & MessDFC(d, Floor(d), Ceiling(d)) d = 2147483649.56789 s = s & MessDFC(d, Floor(d), Ceiling(d)) d = 1# s = s & MessDFC(d, Floor(d), Ceiling(d)) d = 0# s = s & MessDFC(d, Floor(d), Ceiling(d)) d = -1# s = s & MessDFC(d, Floor(d), Ceiling(d)) d = -2147483649.12345 s = s & MessDFC(d, Floor(d), Ceiling(d)) d = -2147483649.56789 s = s & MessDFC(d, Floor(d), Ceiling(d)) Dim dec dec = BigMul(999999999#, 999999999#) s = s & " BigMul(999999999, 999999999) = " & CStr(dec) TestFloorCeilingBigMul = s End Function Private Function MessDFC(ByVal d As Double, _ ByVal f As Double, _ ByVal c As Double) As String MessDFC = " Floor(" & CStr(d) & ") = " & CStr(f) & vbCrLf & _ " Ceiling(" & CStr(d) & ") = " & CStr(c) & vbCrLf End Function Private Sub PBTrigo_Paint() 'is rather quick'n'dirty 'soll nur zum Testen der Funktionen dienen On Error Resume Next Dim X1 As Double, Y1 As Double Dim X2 As Double, Y2 As Double Dim XN As Double, YN As Double 'die Koordinaten des Nullpunkts (zur Verschiebung) XN = PBTrigo.ScaleWidth / 2 YN = PBTrigo.ScaleHeight / 2 'Koordinatensystem zeichnen 'die X-Achse zeichnen X1 = 0: Y1 = YN X2 = PBTrigo.ScaleWidth: Y2 = Y1 PBTrigo.Line (X1, Y1)-(X2, Y2) 'die Y-Achse zeichnen X1 = XN: Y1 = 0 X2 = X1: Y2 = PBTrigo.ScaleHeight PBTrigo.Line (X1, Y1)-(X2, Y2) 'Kurve zeichnen Dim i As Long Dim DrawItem As String DrawItem = CmbGrafikTest.Text ReDim Pts(0 To 720) As Double 'zwei Perioden zeichnen -pi...0...+pi Dim p As Double 'Array füllen For i = 0 To UBound(Pts) p = CDbl(DegToRad(i - 360)) Select Case DrawItem 'DrawItem 'Trigonometrische Funktionen Case "Sinus" Pts(i) = ModTrigonoMath.Sinus(p) Case "Cosinus" Pts(i) = ModTrigonoMath.Cosinus(p) Case "Tangens" Pts(i) = ModTrigonoMath.Tangens(p) Case "Cosecans" Pts(i) = ModTrigonoMath.Cosecans(p) Case "Secans" Pts(i) = ModTrigonoMath.Secans(p) Case "Cotangens" Pts(i) = ModTrigonoMath.Cotangens(p) 'Trigonometrische Umkehrfunktionen Case "ArcusSinus" Pts(i) = ModTrigonoMath.ArcusSinus(p) Case "ArcusCosinus" Pts(i) = ModTrigonoMath.ArcusCosinus(p) Case "ArcusTangens" Pts(i) = ModTrigonoMath.ArcusTangens(p) Case "ArcusCosecans" Pts(i) = ModTrigonoMath.ArcusCosecans(p) Case "ArcusSecans" Pts(i) = ModTrigonoMath.ArcusSecans(p) Case "ArcusCotangens" Pts(i) = ModTrigonoMath.ArcusCotangens(p) 'Hyperbolische Funktionen Case "SinusHyperbolicus" Pts(i) = ModTrigonoMath.SinusHyperbolicus(p) Case "CosinusHyperbolicus" Pts(i) = ModTrigonoMath.CosinusHyperbolicus(p) Case "TangensHyperbolicus" Pts(i) = ModTrigonoMath.TangensHyperbolicus(p) Case "CosecansHyperbolicus" Pts(i) = ModTrigonoMath.CosecansHyperbolicus(p) Case "SecansHyperbolicus" Pts(i) = ModTrigonoMath.SecansHyperbolicus(p) Case "CotangensHyperbolicus" Pts(i) = ModTrigonoMath.CotangensHyperbolicus(p) 'Hyperbolische Umkehrfunktionen Case "AreaSinusHyperbolicus" Pts(i) = ModTrigonoMath.AreaSinusHyperbolicus(p) Case "AreaCosinusHyperbolicus" Pts(i) = ModTrigonoMath.AreaCosinusHyperbolicus(p) Case "AreaTangensHyperbolicus" Pts(i) = ModTrigonoMath.AreaTangensHyperbolicus(p) Case "AreaCosecansHyperbolicus" Pts(i) = ModTrigonoMath.AreaCosecansHyperbolicus(p) Case "AreaSecansHyperbolicus" Pts(i) = ModTrigonoMath.AreaSecansHyperbolicus(p) Case "AreaCotangensHyperbolicus" Pts(i) = ModTrigonoMath.AreaCotangensHyperbolicus(p) 'Spezielle Funktionen Case "SinusCardinalis" Pts(i) = ModTrigonoMath.SinusCardinalis(p * 2 * PI) * 4 End Select Next 'Kurve in Array zeichnen For i = LBound(Pts) To UBound(Pts) - 1 X1 = (-2 * PI + i * PI / 180) + XN: Y1 = -(Pts(i)) + YN X2 = (-2 * PI + (i + 1) * PI / 180) + XN: Y2 = -(Pts(i + 1)) + YN PBTrigo.Line (X1, Y1)-(X2, Y2) Next End Sub Private Sub Form_Resize() Dim L As Single, t As Single, w As Single, H As Single Dim brdr As Single brdr = 8 * 15 L = brdr: t = TxtTrigo.Top w = Me.ScaleWidth - L - brdr H = Me.ScaleHeight - t - brdr If w > 0 And H > 0 Then Call TxtTrigo.Move(L, t, w, H) Call PBTrigo.Move(L, t, w, H) PBTrigo.Cls Call PBTrigo_Paint End If End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '--- Anfang Modul "ModTrigonoMath" alias ModTrigonoMath.bas --- Option Explicit Public Const PI As Double = 3.14159265358979 '##########' Trigonometrische Funktionen '##########' Public Function Sinus(ByVal A As Double) As Double ' aka sin Sinus = VBA.Math.Sin(A) End Function Public Function Cosinus(ByVal A As Double) As Double ' aka cos Cosinus = VBA.Math.Cos(A) End Function Public Function Tangens(ByVal A As Double) As Double ' aka tan Tangens = VBA.Math.Tan(A) End Function Public Function Cosecans(ByVal A As Double) As Double ' aka csc Cosecans = 1 / VBA.Math.Sin(A) End Function Public Function Secans(ByVal A As Double) As Double ' aka sec Secans = 1 / VBA.Math.Cos(A) End Function Public Function Cotangens(ByVal A As Double) As Double ' aka cot Cotangens = 1 / VBA.Math.Tan(A) End Function '##########' Trigonometrische Umkehrfunktionen '##########' Public Function ArcusSinus(ByVal y As Double) As Double ' aka arcsin Select Case y Case 1 ArcusSinus = 0.5 * PI Case -1 ArcusSinus = -0.5 * PI Case Else ArcusSinus = VBA.Math.Atn(y / Sqr(1 - y * y)) End Select End Function Public Function ArcusCosinus(ByVal x As Double) As Double ' aka arccos ArcusCosinus = 0.5 * PI - ArcusSinus(x) End Function Public Function ArcusTangens(ByVal t As Double) As Double ' aka arctan ArcusTangens = VBA.Math.Atn(t) End Function 'ArcusTangensXY: also known as ATan2 Public Function ArcusTangensXY(ByVal x As Double, _ ByVal y As Double) As Double If y > 0 Then If x > 0 Then ' 1. Quadrant ArcusTangensXY = Atn(Abs(y) / Abs(x)) '+ PI * 0# ElseIf x < 0 Then ' 2. Quadrant ArcusTangensXY = -Atn(Abs(y) / Abs(x)) + PI '* 1# Else 'If x = 0 Then ' pos. Y-Achse ArcusTangensXY = 0.5 * PI End If ElseIf y < 0 Then If x < 0 Then ' 3. Quadrant ArcusTangensXY = Atn(Abs(y) / Abs(x)) + PI '* 1# ElseIf x > 0 Then ' 4. Quadrant ArcusTangensXY = -Atn(Abs(y) / Abs(x)) + PI * 2 Else 'If x = 0 Then ' neg. Y-Achse ArcusTangensXY = 1.5 * PI End If Else 'If y = 0 Then If x > 0 Then ' pos. X-Achse ArcusTangensXY = 0 ElseIf x < 0 Then ' neg. X-Achse ArcusTangensXY = PI Else 'If x = 0 Then ' Nullpunkt ArcusTangensXY = 0 End If End If End Function Public Function ArcusCosecans(ByVal y As Double) As Double ' aka arccsc ArcusCosecans = ArcusSinus(1 / y) End Function Public Function ArcusSecans(ByVal x As Double) As Double ' aka arcsec ArcusSecans = ArcusCosinus(1 / x) End Function Public Function ArcusCotangens(ByVal t As Double) As Double ' aka arccot ArcusCotangens = PI * 0.5 - VBA.Math.Atn(t) End Function '######################' Hyperbolische Funktionen '#####################' Public Function SinusHyperbolicus(ByVal A As Double) As Double ' aka sinh SinusHyperbolicus = (Exp(A) - Exp(-A)) / 2 End Function Public Function CosinusHyperbolicus(ByVal A As Double) As Double ' aka sinh CosinusHyperbolicus = (Exp(A) + Exp(-A)) / 2 End Function Public Function TangensHyperbolicus(ByVal A As Double) As Double ' aka tanh TangensHyperbolicus = (Exp(A) - Exp(-A)) / (Exp(A) + Exp(-A)) End Function Public Function CosecansHyperbolicus(ByVal y As Double) As Double ' aka csch CosecansHyperbolicus = 2 / (Exp(y) - Exp(-y)) End Function Public Function SecansHyperbolicus(ByVal x As Double) As Double ' aka sech SecansHyperbolicus = 2 / (Exp(x) + Exp(-x)) End Function Public Function CotangensHyperbolicus(ByVal t As Double) As Double ' aka coth CotangensHyperbolicus = (Exp(t) + Exp(-t)) / (Exp(t) - Exp(-t)) End Function '##########' Hyperbolische Umkehrfunktionen '##########' Public Function AreaSinusHyperbolicus(ByVal y As Double) As Double ' aka arsinh AreaSinusHyperbolicus = VBA.Math.Log(y + Sqr(y * y + 1)) End Function Public Function AreaCosinusHyperbolicus(ByVal x As Double) As Double ' aka arcosh AreaCosinusHyperbolicus = VBA.Math.Log(x + Sqr(x * x - 1)) End Function Public Function AreaTangensHyperbolicus(ByVal t As Double) As Double ' aka artanh AreaTangensHyperbolicus = VBA.Math.Log((1 + t) / (1 - t)) / 2 End Function Public Function AreaCosecansHyperbolicus(ByVal x As Double) As Double ' aka arcsch AreaCosecansHyperbolicus = VBA.Math.Log((Sgn(x) * Sqr(x * x + 1) + 1) / x) End Function Public Function AreaSecansHyperbolicus(ByVal x As Double) As Double ' aka arsech AreaSecansHyperbolicus = VBA.Math.Log((Sqr(-x * x + 1) + 1) / x) End Function Public Function AreaCotangensHyperbolicus(ByVal x As Double) As Double ' aka arcoth AreaCotangensHyperbolicus = VBA.Math.Log((x + 1) / (x - 1)) / 2 End Function '##########' Zusätzliche Funktionen '##########' Public Function SinusCardinalis(ByVal x As Double) As Double ' aka sinc If x = 0 Then SinusCardinalis = 1 Else SinusCardinalis = VBA.Math.Sin(x) / x End If End Function Public Function Log10(ByVal d As Double) As Double Log10 = VBA.Math.Log(d) / VBA.Math.Log(10) End Function Public Function LN(ByVal d As Double) As Double LN = VBA.Math.Log(d) End Function Public Function LogN(ByVal x As Double, _ Optional ByVal N As Double = 10#) As Double 'n darf nicht eins und nicht 0 sein LogN = VBA.Math.Log(x) / VBA.Math.Log(N) End Function Public Function BigMul(ByVal A As Long, ByVal b As Long) As Variant BigMul = CDec(A) * CDec(b) End Function Public Function Floor(ByVal A As Double) As Double Floor = CDbl(Int(A)) End Function Public Function Ceiling(ByVal A As Double) As Double Ceiling = CDbl(Int(A)) If A <> 0 Then If Abs(Ceiling / A) <> 1 Then Ceiling = Ceiling + 1 End Function '##########' Winkelumrechnung '##########' ' Grad(=Deg), Neugrad(=Gon) und Radians(=Rad) Public Function DegToRad(ByVal A As Double) As Double DegToRad = A * PI / 180 End Function Public Function DegToGon(ByVal A As Double) As Double DegToGon = A / 0.9 End Function Public Function RadToDeg(ByVal A As Double) As Double RadToDeg = A * 180 / PI End Function Public Function RadToGon(ByVal A As Double) As Double RadToGon = A * 200 / PI End Function Public Function GonToDeg(ByVal A As Double) As Double GonToDeg = A * 0.9 End Function Public Function GonToRad(ByVal A As Double) As Double GonToRad = A * PI / 200 End Function '--- Ende Modul "ModTrigonoMath" alias ModTrigonoMath.bas --- '-------------- Ende Projektdatei Projekt1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von soundso am 23.05.2010 um 16:50
Die Atan2-Funktion ist in den verschiedenen aktuellen großen Frameworks (C, C++STL, Java, .NET) anders definiert. Wer Kompatibilität dazu braucht kann diesen Code verwenden:
Public Function Atan2(ByVal y As Double, ByVal x As Double) As Double
If x > 0 Then
'egal ob y > 0 oder y < 0 '1. Quadrant und 4. Quadrant
Atan2 = VBA.Math.Atn(y / x)
ElseIf x < 0 Then
If y > 0 Then '2. Quadrant
Atan2 = VBA.Math.Atn(y / x) + PI
ElseIf y < 0 Then '3. Quadrant
Atan2 = VBA.Math.Atn(y / x) - PI
Else 'neg x-Achse
Atan2 = PI
End If
Else
If y > 0 Then 'pos y-Achse
Atan2 = 0.5 * PI
ElseIf y < 0 Then 'neg y-Achse
Atan2 = -0.5 * PI
Else 'Nullpunkt
Atan2 = 0#
End If
End If
End Function
die Funktion unterschiedet sich in:
* die Parameter sind anders herum definiert als hier:
zuerst kommt y dann x
* liefert für negative y-Werte negative Winkel
Kommentar von soundso am 24.02.2010 um 09:36
Fehlerkorrektur
bei CosinusHyperbolicus steht hinter der Funktion eine falsche Abkürzung:
' aka sinh
richtig ist natürlich:
' aka cosh
Gruß
soundso