#include "vbcompat.bi"
#include "inputln.bi" 'http://ytwinky.freebasic.de/freebasic/inputln.bi
#define auf ,
#define von
#define nach ,
'+----------------------------------------------------------------------------------+
'|   Header: Bestimmen der Übergabeparameter                                        |
'|   AnzeigeCheck:|Il1 sind Alt-0124, Großes i, kleines L, Eins „ä”ö�üáߎę֚Üñ±¸©ø°|
Const Author="Geradenschnitt-einfach2D.Bas v017f (c)2007 ytwinky, MD"'              |
'|           (Tastenkombination: keine)                                             |
'|                                                                                  |
'|   Zweck : Schnittpunkt zweier Geraden - ganz einfacher Fall 2D                   |
'+----------------------------------------------------------------------------------+
Type Real As Double
Type Punkt
  As Real x, y
End Type
Declare Function Align(Stellen As Integer, Wert As Real) As String
Declare Function Strecke(von Pa As Punkt nach Pe As Punkt) As Real
Declare Sub DrawScreen()
Declare Function GsEinfach(P() As Punkt) As Punkt

Const Res800x600=19, Schwarz=0, Blau=1, Gruen=2, Rot=4, Lila=5, Brau=6, Weiss=7, Hell=8, Gelb=14
Const KoorFormat="###########.000", vk=14, Esc=!"\27", Bel=!"\7"
Dim As Punkt P(5)
Dim As Integer i
Dim s As String
Dim Shared As Real m1, m2
Screen Res800x600
Color Schwarz auf Weiss
Cls
DrawScreen()
Print "Koordinaten-Eingabe(Abbruch mit Esc):"
For i=1 To 4
  s=InputLn("Rechtswert von P" &i &"(y):", "D")
  If s=Esc Then End 'Möglichkeit zum Abbruch..
  P(i).y=Cast(Real, s)
  P(i).x=Cast(Real, InputLn("Hochwert von P" &i &"(x):", "D"))
Next
Cls
Print Author
DrawScreen()
P(0)=GsEinfach(P())
For i=1 To 4
  Print "P" &i &Align(vk, P(i).y) &Align(vk, P(i).x)
Next

Print !"\nm1=" &Format(m1, "+#.00000") &", m2=" &Format(m2, "+#.00000") &" (Steigungen der Geraden)"
Print !"\ns1-2=" &Align(vk, Strecke(P(1), P(2))) &!"\ns1-s=" &Align(vk, Strecke(P(1), P(0)))
Print "s2-s=" &Align(vk, Strecke(P(2), P(0))) &!"\n\ns3-4=" &Align(vk, Strecke(P(3), P(4)))
Print "s3-s=" &Align(vk, Strecke(P(3), P(0))) &!"\ns4-s=" &Align(vk, Strecke(P(4), P(0)))
Print !"\nSchnittpunkt-Koordinaten:\ny=" &Format(P(0).y, KoorFormat) &"  x=" &Format(P(0).x, KoorFormat)
Print "Eniki..";
GetKey
End

Function GsEinfach(P() As Punkt) As Punkt
  m1=(P(2).x-P(1).x)
  m2=(P(4).x-P(3).x)
  If m1<>0 And m2<>0 Then
    m1=(P(2).y-P(1).y)/m1
    m2=(P(4).y-P(3).y)/m2
    If m1=m2 Then
      Print !"Die Geraden schneiden sich nicht..\nm1=" &Format(m1, "+#.00000") &!"\nm2=" &Format(m2, "+#.00000")
      GetKey
      End
    Else
      P(0).x=P(1).x+((P(1).y-P(3).y)-m2*(P(1).x-P(3).x))/(m2-m1)
      P(0).y=P(1).y+m1*(P(0).x-P(1).x)
      Return P(0)
    End If
  End If
  Print !"Schnittpunktberechnung nicht m”glich..\nm1=" &Format(m1, "+#.00000") &!"\nm2=" &Format(m2, "+#.00000")
  Sleep
  End
End Function

Data 30, 170, 150, 50, 30, 50, 150, 170
Sub DrawScreen()
  Static As Integer Radius=3, Move=400, Done=0, i
  Static s As String
  Static As Punkt P(5)
  If Not Done Then
    For i=1 To 4
      Read P(i).y, P(i).x
    Next
    Done=1=1
  End If
  P(5)=GsEinfach(P())
  For i=1 To 5 'gute Idee, ein Array zu verwenden ^^
    Circle (Move+P(i).y, P(i).x), Radius, Weiss,,,, F 'Ps
    Circle (Move+P(i).y, P(i).x), Radius, Rot 'Ps
    PSet (Move+P(i).y, P(i).x), Schwarz
  Next
  'x-Achse mit Pfeil
  Line(Move, 20)-(Move, 200), Schwarz
  Line(Move, 20)-(Move-5, 30), Schwarz
  Line(Move, 20)-(Move+5, 30), Schwarz
  Draw String (Move-14, 29), "X"
  'y-Achse mit Pfeil
  Line (Move-10, 190)-(Move+200, 190), Schwarz
  Line (Move+200, 190)-(Move+190, 185), Schwarz
  Line (Move+200, 190)-(Move+190, 195), Schwarz
  Draw String(Move+184, 195), "Y"
  Draw String(Move-9, 190), "0"
  
  Line (Move+P(1).y, P(1).x)-(Move+P(5).y, P(5).x), Hell+Schwarz
  Line (Move+P(5).y, P(5).x)-(Move+P(2).y, P(2).x), Hell+Schwarz
  Line (Move+P(3).y, P(3).x)-(Move+P(5).y, P(5).x), Hell+Schwarz
  Line (Move+P(5).y, P(5).x)-(Move+P(4).y, P(4).x), Hell+Schwarz
  
  For i=1 To 5 'gute Idee, ein Array zu verwenden ^^
    If i=5 Then s="Schnittpunkt" Else s="P" &i
    Circle(Move+P(i).y, P(i).x), Radius, Weiss,,,, F 'Ps
    Circle(Move+P(i).y, P(i).x), Radius, Rot 'Ps
    PSet(Move+P(i).y, P(i).x), Schwarz
    Draw String(Move+P(i).y+IIF(i=1 Or i=3, -21, 8), P(i).x-7), s
  Next
  
End Sub

Function Strecke(von Pa As Punkt nach Pe As Punkt) As Real
  Return Sqr((Pe.y-Pa.y)*(Pe.y-Pa.y)+(Pe.x-Pa.x)*(Pe.x-Pa.x))
End Function

Function Align(Stellen As Integer, Wert As Real) As String
  Dim As String s=Format(Wert, KoorFormat)
  Return Space(Stellen-Len(s)) &s
End Function