'�=� , �=� , �=� ; �=� , �=�, �=� , �=� ,�=� , �=�, �=�
'Tested with FB 0.183b using FBEdit 1.0.5.8
#Include "vbcompat.bi" 'soll sich in [freeBASIC-Dir]\inc befinden

Type Punkt
  As String Titel, Nr
  As Double y, x
End Type

Const Pi=4*Atn(1), sfmt="0.000", wfmt="0.0000"
Const MenChr=4, Esc=!"\27", AltGrad="�"
Dim As Double dy, dx, Rho
Dim aRho(2) As Double={45, 50, Atn(1)}
Dim As Punkt Anfang, Ende
Dim As String y, WDim
Dim Shared As Integer FG, BG
Color 0, 8
BG=HIWord(Color)
FG=LOWord(Color)
Anfang.Titel="Stand"
Ende.Titel="Ziel"
'Width 120, 40

Function MenuChar(byVal c As String) As String
  Color MenChr
  Print Chr(c[0]);
  Color FG
  Return Mid(c, 2)
End Function

Function GetKeyPress(byVal Msg As String, byVal Allowed As String, byVal Upper As Integer=-1) As String
  Var y="", m=Allowed
  If Upper<>0 Then m=UCase(m)
  If Msg<>"" Then ?Msg;
  Do
    y=Input(1)
    If Upper<>0 Then y=UCase(y)
  Loop Until Instr(m, y)<>0
  Print y
  Return y
End Function

Sub HolePunkt(byRef Welchen As Punkt)
  With Welchen
    Print "PunktNummer vom " &.Titel &"punkt(leer=Ende):";
    Input .Nr
    If .Nr<>"" Then
      Print "Rechtswert von " &.Nr &":";:Input .y
      Print "Hochwert von " &.Nr &":";:Input .x
    End If
  End With
End Sub

Function Riwi(byVal DeltaY As Double, DeltaX As Double) As Double
  Dim As Double t=ATan2(Deltay, DeltaX)
  Return IIF(t<0, t+8*Atn(1), t)
End Function

Cls
Print "Richtungswinkel.Bas V2 �25.01.2006 by Dipl.-Ing. J�rg Z�hlke, MD"
Print "Gew�nschten Winkelmodus angeben:"
Print MenuChar("Deg(0..360" &AltGrad &"), "); MenuChar("Gon(0..400gon), "); MenuChar("Rad(0..2Pi)")
y=GetKeyPress("Was soll's denn werden ?(D, G, R):", "DGR" &Esc)
If y=Esc Then
  Print "Ohne Auswahl eines Winkelmodus kann kein Winkel berechnet werden..";
  Print Input(1)
Else
	Rho=aRho(Instr("DGR", y)-1)/Atn(1)
End If

Do
  HolePunkt(Anfang)
  If Anfang.Nr="" Then Exit Do
  Do
    HolePunkt(Ende)
    If Ende.Nr="" Then Exit Do
    dy=Ende.y-Anfang.y
    dx=Ende.x-Anfang.x
    Print "Eingabe\nPunktNr", "Rechtswert", "Hochwert", "   s", "    t(";WDim;")"
    Print Ende.Nr, Format(Ende.y, sfmt),  Format(Ende.x, sfmt)
    Print Anfang.Nr, Format(Anfang.y, sfmt), Format(Anfang.x, sfmt), Format(Sqr(dy^2+dx^2), sfmt), Format(Riwi(dy, dx)*Rho, wfmt)
  Loop Until Ende.Nr=""
Loop Until Anfang.Nr=""