VB 5/6-Tipp 0455: Arkustangens - Winkel einer Geraden
von Klaus Langbein
Beschreibung
Ein schönes Beispiel zur richtigen Berechnung des Arcustangens in allen 4 Quadranten (die VB ATN-Funktion allein ist hier nicht ausreichend, da sie die Möglichkeit negativer Werte für x und y nicht berücksichtigt).
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 Project1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Beschriftungsfeld "lbldescr" (Index von 0 bis 8) ' Steuerelement: Beschriftungsfeld "LblTeta" ' Steuerelement: Beschriftungsfeld "lblPhi" ' Steuerelement: Beschriftungsfeld "lblY" ' Steuerelement: Beschriftungsfeld "lblX" ' Steuerelement: Figur-Steuerelement "Shape1" ' Steuerelement: Linien-Steuerelement "Line3" ' Steuerelement: Linien-Steuerelement "Line2" ' Steuerelement: Linien-Steuerelement "Line1" Dim x1 As Integer Dim y1 As Integer Dim dx As Integer Dim dy As Integer Const Pi = 3.14159265358979 Function Atann(x, y) Dim alpha As Double Dim atan As Double If x <> 0 Then atan = Atn(Abs(y) / Abs(x)) Else atan = 0 End If Select Case x Case Is > 0 If y >= 0 Then alpha = atan ' 1st quad Else alpha = 2 * Pi - atan ' 4th quad End If Case Is < 0 If y >= 0 Then alpha = Pi - atan ' 2nd quad Else alpha = atan + Pi ' 3rd quad End If Case Is = 0 Select Case y Case Is > 0 alpha = Pi / 2 ' 1st Case Is < 0 alpha = 3 * Pi / 2 ' 3rd Case Is = 0 alpha = 0 End Select End Select aus_atann: Atann = alpha End Function Sub calc_angle(xi As Integer, yi As Integer) Dim x As Double Dim y As Double x = xi - Line1.x1 y = Line2.y1 - yi phi = Atann(x, y) teta = phi * 360 / (2 * Pi) lblX.Caption = Format$(x) lblY.Caption = Format$(y) lblPhi.Caption = Format$(phi, "0.000") LblTeta.Caption = Format$(teta, "0.000") End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = 1 Then If x > Shape1.Left And x < Shape1.Left + Shape1.Width Then If y > Shape1.Top And y < Shape1.Top + Shape1.Height Then dx = x - Shape1.Left dy = y - Shape1.Top x1 = x y1 = y End If End If End If End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = 1 Then Shape1.Move x - dx, y - dy Line3.X2 = Shape1.Left + Shape1.Width / 2 Line3.Y2 = Shape1.Top + Shape1.Height / 2 Call calc_angle(Line3.X2, Line3.Y2) End If End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '-------------- Ende Projektdatei Project1.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 Frank Müller am 07.06.2010 um 01:57
Ich habe den Winkel in [rad] gebraucht für Koordinatenberechnungen und das funktioniert prima in Access 2003.
danke
Kommentar von am 17.11.2002 um 18:52
So geht's kürzer:
Private Function MyAtn(ByVal X As _
Double, ByVal Y As Double) As Double
If X = 0 Then
X = 1E-300
End If
MyAtn = Atn(Y / X)
If X < 0 Then
MyAtn = MyAtn + Pi
ElseIf Y < 0 Then
MyAtn = MyAtn + 2 * Pi
End If
End Function