#Include "vbcompat.bi"
Type Real As Double
'+-----------------------------------------------------------------------------------+
'|    Header: Bestimmen der Übergabeparameter                                        |
'|    AnzeigeCheck:|Il1 sind Alt-0124, Großes i, kleines L, Eins „ä”ö�üáߎę֚Üñ±ø°¸©|
Const Autor="Dreieck.Bas v3.0 ©2010 by Dipl.-Ing. Jörg Zühlke, MD"'                  |
'|           (Tastenkombination: keine)                                              |
Const FBVer="Getestet mit FB " &__fb_version__ &" und FBEdit"'|                      |
'|    Zweck : Dreiecksberechnung in mehreren Winkelmodi                              |
'+-----------------------------------------------------------------------------------+
'(Anmerkung zu den Sonderzeichen: zuerst steht das DOS-Zeichen, danach das Windowszeichen)
'mit -s gui kompilieren(also als Windows GUI)

#include "vbcompat.bi"
Declare Function Rho As Real
Declare Sub Hilfe()

Const False=0, True=Not False, Blau=1, Gruen=2, Rot=4, Schwarz=0, Weiss=7, VG=Schwarz, HG=Weiss
Const Tuerkis=3, Hell=8, Gelb=14, NK="0123456789*", Lf=!"\n", Esc=!"\27", Del=!"\08"
Type Koor
  As Integer x, y, mx, my
End Type
'senkrecht=Á
Screen 18
Color VG, HG
Dim Shared As Integer WMod=1, WNk=4, SNk=3, EingabeStart, cFG, cBG, NoSave=0, Berechnet=False, ES(6), Breite, Hoehe, NR, ERechts, ambig
Dim Shared As String FormatString, PN(2), wg, sg, zwo, EN
Dim Shared As Real EG(6), FG, zwei
  FG=0.0020/Rho
  FormatString=""
  zwo=""
  zwei=0
  Breite=Width And 65535
  Hoehe=Width\65535
  NR=Hoehe-7
  EN="àáçabc"
Dim m As String, sp As Integer, ze As Integer

Function Pi As Real 
  Pi=4.0*Atn(1.0) 'Da es FreeBasic-Pogrammierer gibt, die 'Bauchschmerzen' bekommen, wenn Pi Const ist..
End Function

Function Rho As Real
	Static As Real WFak(2)={45, 50, Atn(1.0)}
  Return WFak(WMod)/Atn(1.0)
End Function

Function WAnz As Integer
  Return -(ES(1)<>0)-(ES(2)<>0)-(ES(3)<>0)
End Function

Function SAnz As Integer
  Return -(ES(4)<>0)-(ES(5)<>0)-(ES(6)<>0)
End Function

Sub Gegeben()
  Var i=0
  wg=""
  For i=1 To 3
    If ES(i)=i Then wg+=*IIf(Len(wg)>0, @";", @"") &Chr(EN[i-1])
  Next
  sg=""
  For i=4 To 6
    If ES(i)=i Then sg+=*IIf(Len(sg)>0, @";", @"") &Chr(EN[i-1])
  Next
End Sub

Function RWTxt As String
  Select Case WMod
    Case 0: Return "90ø"
    Case 1: Return "100gon"
    Case 2: Return "Pi/2=" &(Pi/2.0)
    Case Else: Return "**U**"
   End Select
End Function

Function sWMod(Was As Integer) As String
  Return Mid("DegGonrad", 1+Was*3, 3)
End Function

Sub Farbe(fg As Integer, bg As Integer)
  cFG=fg
  cBG=bg
  Color fg, bg
End Sub

Sub PrintAt(WoZe As Integer, WoSp As Integer, Was As String, WieFG As Integer=-1, WieBG As Integer=-1)
  Var sp=Pos(0), ze=CsrLin
  If WieFG<0 Then WieFG=cFG
  If WieBG<0 Then WieBG=cBG
  Color WieFG, WieBG
  Locate WoZe, WoSp
  Print Was;
  Color cFG, cBG
End Sub

Function InputKomma2Punkt() As String
	Var s="", i=0
  Line Input s
  i=InStr(s, ",")
  If i Then s=Left(s, i-1) &"." &Mid(s, i+1)
	Return s
End Function

Function Geg(i As Integer) As Integer
  Select Case ES(i)
    Case 127: Return Gruen
    Case 1, 2, 3, 4, 5, 6: Return Schwarz
  End Select
  Return Rot
End Function

Sub ClrEol(Wieviel As Integer=40)
  Var sp=Pos(0), ze=CsrLin
  Print String(Breite-sp, " ");
  Locate ze, sp
End Sub

Function MenuChar(s As String, First As Integer=1, nVG As Integer=Hell+Rot) As String
  Var cVG=cFG, cHG=cBG
  If First<>1 Then Print Left(s, First-1);
  Farbe(nVG, cBG)
  Print Chr(s[First-1]);
  Farbe(cVG, cHG)
  Return Mid(s, First+1)
End Function

Sub ChWMod(m As String)
  Var sp=Pos(0), ze=CsrLin
  Color Schwarz, Gelb
  Locate Hoehe-1, 1
  Print "Neuer WinkelModus:"; MenuChar("Deg "); MenuChar("Gon "); MenuChar("rad");
  Color cFG, cBG
  ClrEol
  Do
    m=lcase(Input(1))
  Loop Until Instr("dgr" &Esc, m)
  If m<>Esc Then WMod=Instr("dgr", m)-1
  Locate ze, sp
  ClrEol
End Sub

Sub ChNk(Was As String)
  Var sp=Pos(0), ze=CsrLin, i=-SNk*(Was="S")-WNk*(Was="W"), m=""
  PrintAt(Hoehe-1, 1, "Anzahl der Nachkommastellen(0..9,*=Keine Formatierung):", Schwarz, Gelb)
  ClrEol
  Do
    m=Input(1)
  Loop Until Instr(NK &Esc, m)
  If m<>Esc Then i=InStr(NK, m)-1
  Locate ze, sp
  ClrEol
  SNk=IIF(Was="S", i, SNk)
  WNK=IIF(Was="W", i, WNk)
  Locate ze, sp
  ClrEol
End Sub

Sub GetEingabe(Was As Integer, m As String)
  Dim i As Integer
  If ES(Was)>6 Then Exit Sub
  Locate EingabeStart+Was+2+2*(Was<4), ERechts+2, 1
  ClrEol
  Color Schwarz, Gelb
  Print Chr(EN[Was-1]) &":";
  Color cFG, cBG
  m=InputKomma2Punkt() 'jetzt kann auch das ',' bei Zahlen benutzt werden
  If m="" Or Val(m)=0 Then
    If ES(Was)<>0 Then
      For i=1 To 6
        If ES(i)=127 Then
          Berechnet=1=0
          EG(i)=0.0
          ES(i)=0
        End If
      Next
    End If
    EG(Was)=0.0
    ES(Was)=0
    Exit Sub
  End If
  ES(Was)=Was
  EG(Was)=Val(m)
  If Was<4 Then EG(Was)/=Rho
End Sub

Sub GetFG()
  Var sp=Pos(0), ze=CsrLin, m=""
  PrintAt(Hoehe-1, 1, "Fehlergrenze f�r die Winkelkontrolle:", Schwarz, Gelb)
  ClrEol
  m=InputKomma2Punkt()
  If m="" Then Exit Sub
  If Val(m)<>0 Then FG=Val(m)/Rho
  Locate ze, sp
End Sub

Sub GetPN(n As String)
  Var sp=Pos(0), ze=CsrLin, m=""
  PrintAt(Hoehe-1, 1, "Name f�r " &n &":", Schwarz, Gelb)
  ClrEol
  Input m
  PN(ASC(n)-Asc("A"))=""
  If m<>"" Then PN(ASC(n)-Asc("A"))="=" &m
  Locate ze, sp
  ClrEol
End Sub

Function WDiff(byVal x As Real, Pvz As String="") As String
	Var m=Format(x, "-0.0E-00")
	If x=0.0 Then Return "ñ0"
	Return m
End Function

Function WAusgabe(Winkel As Real) As String
  Var s=Format(Winkel*Rho, "0." &String(WNk, "0"))
  If WNk>9 Then s=Str(Winkel*Rho)
  If WMod<>2 And Instr(s, ",")<4 Then s=" " &s
	Return "=" &s
End Function

Function SAusgabe(Seite As Real) As String
  Var s=Format(Seite, FormatString &"####0." &String(SNk, "0"))
  If SNk>9 Then s=Str(Seite)
	Return "=" &s
End Function

Sub StatusZeile()
  Var sp=Pos(0), ze=CsrLin
  Locate Hoehe, 1
  Farbe(Schwarz, Hell+Tuerkis)
  Gegeben
  Print "Status: ";MenuChar(sWMod(WMod));MenuChar(" WNk:", 2); Mid(NK, WNk+1, 1);MenuChar(" SNk:", 2);
  Print Mid(NK, SNk+1, 1);MenuChar(" FG", 2);WAusgabe(FG);
  Print " WAnz=" &WAnz &" SAnz=" &SAnz &" gegW=";wg; " gegS=";sg;
  Farbe(VG, HG)
  Locate ze, sp
End Sub

Function SeitenUngl() As Integer
  Var sp=Pos(0), ze=CsrLin, UnGl=30, i=0, j=0, m="456"
  If SAnz<3 Then Exit Function
  Locate Nr, 61
  Print "Seitenungleichungen:"
  For i=1 To 3
    Locate Nr+i, 68
    Color Rot, cBG
    If EG(Val(Chr(m[0])))+EG(Val(Chr(m[1])))>EG(Val(Chr(m[2]))) Then
      Color Gruen, cBG
      j+=1
    End If
    Print Chr(EN[Val(Chr(m[0]))-1]) &"+" &Chr(EN[Val(Chr(m[1]))-1]) &">" &Chr(EN[Val(Chr(m[2]))-1])
    m=Mid(m, 2, 2)+Chr(m[0])
  Next
  Farbe(VG, HG)
  Locate ze, sp
  Return j
End Function

Sub CSatzW(s1 As Real, s2 As Real, s3 As Real)'berechnet den Winkel zur 1. Seite
	EG(s1-3)=ACos((EG(s2)*EG(s2)+EG(s3)*EG(s3)-EG(s1)*EG(s1))/(2.0*EG(s2)*EG(s3)))
  ES(s1-3)=127
End Sub

Sub CSatzS(s1 As Real, s2 As Real, w As Real) 'berechnet die Seite zu w
  If EG(w+3)=0 Then
    EG(w+3)=Sqr(EG(s1)*EG(s1)+EG(s2)*EG(s2)-2.0*EG(s1)*EG(s2)*Cos(EG(w)))
    ES(w+3)=127
  End If
End Sub

Sub SSatzW(s1 As Real, w As Real)
  EG(s1-3)=ASin(EG(s1)/EG(w+3)*Sin(EG(w))) 'Winkel zu s1 berechnen
  ES(s1-3)=127
  If (w+3)<s1 Then
    zwei=Pi-EG(s1-3)
    zwo=!"2.L”sung\n" &Chr(EN[s1-4]) &"'" &WAusgabe(zwei) &Lf
  End If
End Sub

Sub WSumme
  IF WAnz<3 Then
    EG(0)=0.0
    Print 
  Else
    EG(0)=EG(1)+EG(2)+EG(3)
    PrintAt(CsrLin, Pos(0), "  ä", Gruen+2*(ES(1)=1 And ES(2)=2 And ES(3)=3))
    Print WAusgabe(EG(0));" ";
    If Abs(Pi-EG(0))>FG Then Color Gelb, Rot
    Print "ë=" &WDiff((Pi-EG(0))*Rho)
    Color cFG, cBG
  End If
End Sub

Sub hpq()
  Var h=EG(5)*Sin(EG(1)), h2=EG(4)*Sin(EG(2)), p=EG(5)*Cos(EG(1)), q=EG(4)*Cos(EG(2))
  If Not Berechnet Then Exit Sub
  Dim hsp As Integer=20
  PrintAt(NR, hsp, "HilfsgrӇen", Blau)
  PrintAt(NR+1, hsp, "h    ", Gruen)
  Print SAusgabe(h)
  PrintAt(NR+2, hsp, "h'=h ", Gruen)
  Print SAusgabe(h2) &" ë=" &WDiff(h-h2)
  PrintAt(NR+3, hsp, "p    ", Gruen)
  Print SAusgabe(p)
  PrintAt(NR+4, hsp, "q    ", Gruen)
  Print SAusgabe(q)
  PrintAt(NR+5, hsp, "c=", Geg(6))
  PrintAt(NR+5, hsp+2, "p+q", Gruen)
  Print SAusgabe(p+q) &" ë=" &WDiff(EG(6)-p-q)
  PrintAt(NR+6, hsp, "Fl„che", Gruen)
  Print SAusgabe(EG(6)/2.0*h) &" nur als Zahl ohne Garantie"
  If zwo<>"" Then PrintAt(Hoehe-6, 1, zwo, Rot)
End Sub

Sub Gegeben3s
  If SeitenUngl<3 Then Exit Sub
  CSatzW(4, 5, 6) 'Alpha berechnen
  CSatzW(5, 6, 4) 'Beta berechnen
  CSatzW(6, 4, 5) 'Gamma berechnen
  Berechnet=True
End Sub

Sub Gegeben1s2w
  Var ws=-4*(ES(4)<>0)-5*(ES(5)<>0)-6*(ES(6)<>0), ww=-(ES(1)=0)-2*(ES(2)=0)-3*(ES(3)=0), i=0, d=0.0
  EG(ww)=Pi-EG(1)-EG(2)-EG(3) 'jetzt sind Alpha, Beta und Gamma definiert
  ES(ww)=127
  d=EG(ws)/Sin(EG(ws-3))
  For i=4 To 6
    If i<>ws Then
      EG(i)=Sin(EG(i-3))*d
      ES(i)=127
    End If
  Next
  Berechnet=True
End Sub

Sub Gegeben2s1w 'bei a, b, Alpha ist nur der Fall a<b nicht eindeutig
  Var w=ValInt(wg), s1=ValInt(Chr(sg[0])), s2=ValInt(Chr(sg[1])), i=0, d=0.0
  If ES(w+3)=0 Then 'z.B:gamma gegeben und c nicht => a, b also eindeutig..
    CSatzS(s1, s2, w) '3. Seite berechnen
    SSatzW(s1, w) 'Winkel zu s1 berechnen
    SSatzW(s2, w) 'Winkel zu s2 berechnen
  Else 'z.B:alpha gegeben und a => b oder c egal, SinSatz
    Select Case w+3
      Case s1: SSatzW(s2, w)'Hier, ja zweite Lösung
      Case s2: SSatzW(s1, w)'Hier, ja zweite Lösung
    End Select
    i=-1*(ES(1)=0)-2*(ES(2)=0)-3*(ES(3)=0)
    EG(i)=Pi-EG(1)-EG(2)-EG(3)
    ES(i)=127
    EG(i+3)=Sin(EG(i))/Sin(EG(s2-3))*EG(s2) 'Oooops
    ES(i+3)=127
    If zwo<>"" Then
      zwo+=Chr(EN[i-1]) &"'" &WAusgabe(Pi-zwei-EG(w)) &Lf
      zwo+=Chr(EN[i+2]) &"'" &SAusgabe(Sin(Pi-zwei-EG(w))/Sin(EG(s2-3))*EG(s2))
    End If
  End If
  Berechnet=TRUE
End Sub

Sub Eingabe()
  Var m="", Move=-5, i=0
  Dim As Koor PA, PB, PC
  Do
    WindowTitle Autor &" - Eingabe"
    Cls
    StatusZeile()
    Print !"Berechnungen im allgemeinen Dreieck\n-ggfs. rechten Winkel als " &RWTxt &" eintragen"
    Print "-sind drei Winkel gegeben, erst diese eintragen, sonst keine Winkelkontrolle"
    Print "-die Seiten m�ssen die Dreicksungleichung erf�llen(z.B.:a+b>c)"
    Print "-Del oder 0 l”scht die gesamte Eingabe"
   	PA.x=Move+24
    PA.y=304
    PB.x=Move+450
    PB.y=PA.y
    PC.x=Move+295
    PC.y=115
    PA.mx=20
    PA.my=2
    PB.mx=PA.mx
    PB.my=58
    PC.mx=7
    PC.my=37
    Line(PA.x, PA.y)-(PB.x, PB.y) 'c
    Line(PB.x, PB.y)-(PC.x, PC.y) 'a
    Line(PC.x, PC.y)-(PA.x, PA.y) 'b
    Line(PC.x, PC.y)-(PC.x, PA.y), 2 'h
    Line(PC.x, PA.y-15)-(PC.x+15, PA.y), 2 'RW1
    Line(PC.x, PA.y-10)-(PC.x+10, PA.y), 2 'RW2
    PrintAt(PA.mx, PA.my, UCase(Chr(EN[3])), Hell+Rot) 'A
    If PN(0)<>"" Then PrintAt(PA.mx, PA.my+1, PN(0))
    PrintAt(PB.mx, PB.my, UCase(Chr(EN[4])), Hell+Rot) 'B
    If PN(1)<>"" Then PrintAt(PB.mx, PB.my+1, PN(1))
    PrintAt(PC.mx, PC.my, UCase(Chr(EN[5])), Hell+Rot)  'C
    If PN(2)<>"" Then PrintAt(PC.mx, PC.my+1, PN(2))
    PrintAt(PA.mx-1, PA.my+5, Chr(EN[0]), Geg(1)) 'Alpha
    PrintAt(PA.mx-1, PB.my-5, Chr(EN[1]), Geg(2)) 'Beta
    PrintAt(PC.mx+2, PC.my-1, Chr(EN[2]), Geg(3)) 'Gamma
    Locate PC.mx+Int((PB.mx-PC.mx)/2), PC.my+Int((PB.my-PC.my)/2)+1

    Print MenuChar(Mid(EN, 4, 1),, Geg(4)) 'a
    Locate PA.mx+Int((PC.mx-PA.mx)/2), PA.my+Int((PC.my-PA.my)/2)-1
    Print MenuChar(Mid(EN, 5, 1),, Geg(5)) 'b
    PrintAt(PA.mx+Int((PB.mx-PA.mx)/2)+1, PA.my+Int((PB.my-PA.my)/2), Chr(EN[5]), Geg(6)) 'c
    PrintAt(PC.mx+Int((PA.mx-PC.mx)/2)+1, PC.my+1, "h", Gruen)
    PrintAt(PA.mx-1, PA.my+20, "p", Gruen)
    PrintAt(PA.mx-1, PB.my-12, "q", Gruen)
    Circle(PA.x, PA.y), 45,, 0, Atn((PA.x-PB.x)/(PA.y-PB.y))-Atn((PA.x-PC.x)/(PA.y-PC.y))
    Circle(PB.x, PB.y), 40,, Pi-(Atn((PB.x-PA.x)/(PB.y-PA.y))-Atn((PB.x-PC.x)/(PB.y-PC.y))), Pi
    Circle(PC.x, PC.y), 33,, Pi/2*3+Atn((PC.x-PA.x)/(PC.y-PA.y)), Pi/2*3+Atn((PC.x-PB.x)/(PC.y-PB.y))
    EingabeStart=SeitenUngl
    EingabeStart=6
    ERechts=57
    Line(1, PA.y+40)-(640, PA.y+40), 3 'RW2
    Locate NR, 1
    Print !"Nebenrechnung:\nRho=" &Format(Rho(), "#.###0")
    Locate EingabeStart, ERechts
    Print "Winkel"
    For i=1 To 3
      Locate EingabeStart+i, ERechts
      Print MenuChar(Str(i) &":");
      Print MenuChar(Chr(EN[i-1]),, Geg(i));
      If ES(i)<>0 Then Print WAusgabe(EG(i)) Else Print
    Next
    Locate EingabeStart+4, ERechts
    WSumme
    hpq()
    Locate EingabeStart+5, ERechts
    Print "Seiten"
    For i=4 To 6
      Locate EingabeStart+2+i, ERechts
      Print MenuChar(Str(i) &":");
      Print MenuChar(Chr(EN[i-1]),, Geg(i));
      If ES(i)<>0 Then Print SAusgabe(EG(i)) Else Print
    Next
    PrintAt(EingabeStart+3, 1, "Was darf's denn sein?")
    Do
      m=UCase(Input(1))
    Loop Until m<>""
    Print m
    Select Case m
      Case "1", "2", "3", "4", "5", "6": GetEingabe(ValInt(m), m)
      Case Del, "0"
        PN(0)=""
        PN(1)=""
        PN(2)=""
        For i=1 To 6
          ES(i)=0
          EG(i)=0
        Next
        Berechnet=False
        zwo=""
      Case "A", "B", "C": GetPN(m)
      Case "D", "G", "R": ChWMod(m)
      Case "F": GetFG()
      Case "H", ";": Hilfe()
      Case "S", "W": ChNk(m)
      Case "K": m="Q"
    End Select
    If EG(0)=0 Then
      Gegeben
      If SAnz=3 Then Gegeben3s 'a, b, c gegeben ->eindeutig
      If SAnz=1 And WAnz=2 Then Gegeben1s2w '1 Seite, 2 Winkel gegeben ->eindeutig ! ggfs. hier > einfügen..
      If SAnz=2 And WAnz=1 Then	Gegeben2s1w '2 Seiten, 1 Winkel gegeben ->nicht immer eindeutig
    End If
  Loop Until Instr("Q*" &Esc, m)<>0
End Sub

Sub Hilfe()
  Var m=""
  WindowTitle Autor &" - Hilfe"
  Do
    Cls
    StatusZeile()
    m=!"Hilfe-Seite\nDie Bedienung des Programme erfolgt interaktiv, diese\n"_
      !"Hilfe-Seite kann allerdings per Dreieck /? aufgerufen werden.\n"_
       "Das allgemeine Dreieck hat 3 Winkel(" &Chr(EN[0]) &"," &Chr(EN[1]) &"," &Chr(EN[2]) &_
       ") und 3 Seiten(" &Chr(EN[3]) &"," &Chr(EN[4]) &"," &Chr(EN[5]) &!").\n"_
      !"Der Sonderfall 'rechtwinkliges Dreieck' kann ggfs. durch Eingabe\n" _
      !"des rechten Winkels abgefangen werden.\n"_
      !"Die Berechnung erfolgt automatisch, wenn genug Bestimmungsst�cke da sind:\n"_
      !"3 Seiten              (eindeutig) oder\n"_
      !"1 Seite und 2 Winkel  (eindeutig) oder\n"_
      !"2 Seiten und 1 Winkel (nicht immer eindeutig, 2. L”sung wird ggfs. angezeigt)\n"_
	    !"Bei 3 gegebenen Winkeln sind erst die drei Winkel einzugeben, eine Abstimmung\n"_
	    !"auf die korrekte Winkelsumme muá dann manuell erfolgen..\n"_
      !"Die Fehlergrenze FG gibt an, ab welchen Differenzen Winkel FEHLERHAFT sind.\n"_
      !"Auáer bei Winkeln ist KEINE Ber�cksichtigung von šberbestimmungen vorgesehen.\n\n"_
      !"Das Programm sollte auf JEDEM Rechner mit installiertem FreeBASIC laufen,\n"_
      !"da keine OS-spezifischen Funktionen verwendet werden.\n"_
      !"(Vorausgesetzt, das FreeBASIC ist aktuell..)\n\n"_
      !"Tipps:\n1 springt ins EingabeMen�\n0 l”scht alle Eingaben\n* verl„át das EingabeMen�\n"_
      !"auch drei abgestimmte Winkel reichen nicht, um ein Dreieck zu berechnen..ROFL\n"
    Print m;MenuChar("Zur�ck(oder ESC)");
    Do
      m=UCase(Input(1))
    Loop Until m<>""
    Print m
    Select Case m
      Case "D", "G", "R": ChWMod(m)
      Case "F": GetFG()
      Case "S", "W": ChNk(m)
    End Select
  Loop Until Instr("Z" &Esc, m)
End Sub

If Command(1)="/?" Then Hilfe
Do
  WindowTitle Autor &" - Hauptmenü"
  Cls
  StatusZeile()
  Print "Berechnungen im allgemeinen Dreieck"
  Print MenuChar("Eingabe")
  Print MenuChar("Hilfe")
  Print MenuChar("Quit")
  Print "Was darf's denn sein ?(EHQ):";
  sp=Pos(0)
  ze=CsrLin
  ClrEol
  Locate ze, sp
  Do
    m=UCase(Input(1))
  Loop Until m<>""
  Print m
  Select Case m
    Case "E", "1" : Eingabe()
    Case "F" : GetFG()
    Case "D", "G", "R": ChWMod(m)
    Case "H", ";" : Hilfe()
    Case "S" : ChNk(m)
    Case "K": m="Q" 'AltGr+F4
    Case "W" : ChNk(m)
  End Select
Loop Until Instr("Q*" &Esc, m)<>0
End