'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü=� , ß=á ,§=õ , ©=¸, °=ø
'KreisDurch3Punkte
'Tested with FB 0.183b using FBEdit 1.0.5.8";
#define Real Double
#include "vbcompat.bi"
#include "windows.bi"

Type PktRec
  Nr As String
  y As Real
  x As Real
End Type

Const Autor="Kreis durch 3 Punkte ¸2006 by Dipl.-Ing. J”rg Z�hlke, MD", CrLf=!"\r\n", fw=15, nk=3, yWidth=90, yHeight=30
Const Black=0, LightRed=12, Green=2
Width yWidth, yHeight
Dim Shared As PktRec Pkt(3) ' Was soll's, Punkte haben Nummern..
Dim Shared As Real r, dx21, dx32, ym2=0, xm2=0, xm1, ym1

Sub ClrEol
  Dim As Integer ze=CsrLin, sp=Pos()
  Print String(yWidth-sp, " ");
  Locate ze, sp
End Sub

Function Mittel(byVal a As Real, byVal b As Real) As Real
  Mittel=(a+b)/2.0
End Function

Function GetDouble(byVal s As String) As Real
  Dim As Integer sp, ze, i
  Dim As String t, ErrMsg
  Dim As Real g
    ze=CsrLin
    sp=Pos()
    ErrMsg=""
    Do
      Locate ze, sp
      Print (ErrMsg+s);
      ClrEol
      Input t
      g=Val(t)
      If Str(g)<>t Then ErrMsg="Das war nicht Okay, nochmal.." &CrLf
    Loop Until Str(g)=t
    GetDouble=g
End Function

Function Strecke(byVal dy As Real, byVal dx As Real) As Real
  Strecke=Sqr(dy*dy+dx*dx)
End Function

Data "1", 0.9080732, 4.0642982, "2", 2.8485684, 1.6679862, "3", 0.4589868, 4.0996421

Sub Eingabe()
  Dim As Integer i
  Dim As String y
  Print Autor
  Print "E=Eingebautes Beispiel ansehen"
  Print "M=Manuelle Eingabe dreier Punkte"
  Print "Was darf's denn sein, Fremder?(E/M):";
  Do
    y=UCase(Input(1))
  Loop Until Instr(!"EM\27", y)
  Print y
  Select Case y
    Case "E"
      Restore
      For i=1 To 3
        Read Pkt(i).Nr, Pkt(i).y, Pkt(i).x
      Next
    Case "M"
      For i=1 To 3
        With Pkt(i)
          Print "PunktNummer vom " &i &". Punkt:";
          Input "", .Nr
          .y=GetDouble("Rechtswert(y) von "+.Nr+":")
          .x=GetDouble("Hochwert(x) von "+.Nr+":")
        End With
      Next
    Case Else
      Print "..denn tsch�ssss..";
      GetKey
      End
  End Select
End Sub

Function K3Pa() As Real
  Dim As Real y1s, x1s, y2s, x2s, m1, m2
  Dim As Integer i
'Koordinaten von P1'
  y1s=Mittel(Pkt(1).y, Pkt(2).y)
  x1s=Mittel(Pkt(1).x, Pkt(2).x)
'Koordinaten von P2'
  y2s=Mittel(Pkt(2).y, Pkt(3).y)
  x2s=Mittel(Pkt(2).x, Pkt(3).x)
'Steigungen berechnen
  dx21=Pkt(2).x-Pkt(1).x
  dx32=Pkt(3).x-Pkt(2).x
  m1=(Pkt(2).y-Pkt(1).y)/dx21
  m2=(Pkt(3).y-Pkt(2).y)/dx32
'1. L”sung f�r den Fall, daá weder x2-x1=0 noch x3-x2=0 ist:
  If dx21*dx32<>0 Then 'also sind beide<>0 !!
    xm1=x1s+m1*(m2*(y1s-y2s)+(x1s-x2s))/(m2-m1)
    ym1=y1s-(xm1-x1s)/m1
'Kontrolle:
    xm2=x2s+m2*(m1*(y1s-y2s)+(x1s-x2s))/(m2-m1)
    ym2=y2s-(xm2-x2s)/m2
    Pkt(0).y=Mittel(ym1,ym2)
    Pkt(0).x=Mittel(xm1,xm2)
  ElseIf dx21=0 Then '2. L”sung f�r den Fall, daá x2-x1=0 ist:
    Pkt(0).x=x2s-m2*(y1s-y2s)
    Pkt(0).y=y1s
  ElseIf dx32=0 Then '3. L”sung f�r den Fall, daá x3-x2=0 ist:
    Pkt(0).x=x1s-m1*(y2s-y1s)
    Pkt(0).y=y2s
  Else
    Print "Dieser Sonderfall wird vom Programm nicht bearbeitet.."
    GetKey
    End
  End If
  m1=0.0
  m2=0.0
  For i=1 To 3
    y1s=Abs(Pkt(0).y-Pkt(i).y)*Abs(Pkt(0).x-Pkt(i).x)
    m1=m1+y1s
    m2=m2+Strecke(Pkt(0).y-Pkt(i).y, Pkt(0).x-Pkt(i).x)*y1s
  Next
  K3Pa=m2/m1
  Pkt(0).Nr="Mittelpunkt"
End Function

Sub CWriteS(byVal Farbe As Byte, byVal Wert As Real, byVal w As Integer, byVal n As Integer)
  Dim s As String, sh As Integer, sv As Integer
  sh=HiWord(Color)
  sv=LoWord(Color)
  If w<0 Then
    s=Format(Wert, "0.00000E+000")
  Else
    s=Format(Wert, "-,0." &String(n, "0"))
  End If
  Color Farbe, sh
  Print s+" ",
  Color sv, sh
End Sub

Sub Ausgabe()
  Dim As Integer i
  Color 0, 7
  Cls
  Print Autor
  Print "Geg.Punktnr.","y","x","r","Differenz"
'Berechnung von r mit gleichzeitiger Kontrolle der Berechnung:
  For i=1 To 3
    With Pkt(i)
      Print String(fw-Len(.Nr)-3, " ");.Nr,
      CWriteS(Black, .y, fw, nk)
      CWriteS(Black, .x, fw, nk)
      CWriteS(Green , Strecke(Pkt(0).y-.y, Pkt(0).x-.x), fw, nk)
      CWriteS(LightRed, r-Strecke(Pkt(0).y-.y, Pkt(0).x-.x) , -1, 0)
      Print 
    End With
  Next
  Print "Mittel",
  CWriteS(Green, Pkt(0).y, fw, nk)
  CWriteS(Green, Pkt(0).x, fw, nk)
  Print 
  If dx21*dx32<>0 Then
    Print "1.Berechnung",
    CWriteS(Green, ym1, fw, nk)
    CWriteS(Green, xm1, fw, nk)
    Print !"\nDifferenzen",
    CWriteS(LightRed, Pkt(0).y-ym1, fw+2, nk+2)
    CWriteS(LightRed, Pkt(0).x-xm1, fw, nk+2)
    Print !"\n2.Berechnung",
    CWriteS(Green, ym2, fw, nk)
    CWriteS(Green, xm2, fw, nk)
    Print !"\nDifferenzen",
    CWriteS(LightRed, Pkt(0).y-ym2, fw+2, nk+2)
    CWriteS(LightRed, Pkt(0).x-xm2, fw, nk+2)
    Pkt(0).y=Mittel(Pkt(0).y, ym2)
    Pkt(0).x=Mittel(Pkt(0).x, xm2)
  End If
  Print !"\n\nRadius="; Format(r, "-,0.000"); "  YM="; Format(Pkt(0).y, "-,0.000"); "  XM="; Format(Pkt(0).x, "-,0.000")
  Color 7, 0
End Sub

'Main
  Eingabe()
  r=K3Pa()
  Ausgabe
  Print "Radius=2.350  YM=0.500  XM=1.750 <-- war das Ergebnis vom Pascal-Programm";
  Print Input(1)
End 'Main