var s:array[0..1]of char;
w:array[0..1]of double;
a,b,c,p,q,h:
double;
drv,modus,i :
integer;
{***************************************************************************}
{*********
Berchnung der Gleichung a²+b²=c²
**************}
{***************************************************************************}
procedure pytha;
begin
if(((s[0]='b') and (s[1]=('c'))) or
((s[0]=('c')) and (s[1]=('b'))))
then a:=sqrt(c*c-b*b);
if(((s[0]=('a')) and (s[1]=('c')))
or
((s[0]=('c')) and (s[1]=('a'))))
then b:=sqrt(c*c-a*a);
if(((s[0]=('a')) and (s[1]=('b')))
or
((s[0]=('b')) and (s[1]=('a'))))
then c:=sqrt(a*a+b*b);
p:=a*a/c; q:=b*b/c;
h:=sqrt(p*q);
end;
{***************************************************************************}
{*********
Berchnung der Gleichung h²=p*q
**************}
{***************************************************************************}
procedure hoehen;
begin
if(((s[0]=('h')) and (s[1]=('q')))
or
((s[0]=('q')) and (s[1]=('h'))))
then p:=(h*h/q);
if(((s[0]=('h')) and (s[1]=('p')))
or
((s[0]=('p')) and (s[1]=('h'))))
then q:=(h*h/p);
if(((s[0]=('p')) and (s[1]=('q')))
or
((s[0]=('q')) and (s[1]=('p'))))
then h:=sqrt(q*p);
c:=p+q;
b:=sqrt(q*c); a:=sqrt(p*c);
end;
{***************************************************************************}
{*********
Berchnung der Gleichung a²=p*c
**************}
{***************************************************************************}
procedure kath1;
begin
if(((s[0]=('p')) and (s[1]=('c')))
or
((s[0]=('c')) and (s[1]=('p'))))
then a:=sqrt(c*p);
if(((s[0]=('p')) and (s[1]=('a')))
or
((s[0]=('a')) and (s[1]=('p'))))
then c:=(a*a)/p;
b:=sqrt(c*c-a*a); q:=b*b/c;
h:=sqrt(p*q);
end;
{***************************************************************************}
{*********
Berchnung der Gleichung b²=q*c
**************}
{***************************************************************************}
procedure kath2;
begin
if(((s[0]=('q')) and (s[1]=('c')))
or
((s[0]=('c')) and (s[1]=('q'))))
then b:=sqrt(c*q);
if(((s[0]=('q')) and (s[1]=('b')))
or
((s[0]=('b')) and (s[1]=('q'))))
then c:=(b*b)/q;
a:=sqrt(c*c-b*b); p:=a*a/c;
h:=sqrt(p*q);
end;
begin
a:=1; b:=1;
c:=10000; p:=1; q:=1;
h:=1;
clrscr;
{*Bildschirm löschen*}
{**************************** Eingabe
*************************************}
textbackground(7); textcolor(0); clrscr;
{*Bildschirm löschen*}
writeln('
Berechnung zum rechtwinkligen Dreieck');
writeln;
writeln(' Aus zwei beliebigen Längen
des rechtwinkligen Dreiecks werden die');
writeln(' restlichen Längenangaben
berechnet. (C) 1996 by Dave Sun');
writeln(' Als Seiten:');
writeln(' * Katheten
: a und b');
writeln(' * Hypotenuse
: c');
writeln(' * Hypotenusenabschnitte
: p und q');
writeln(' * Höhe
: h');writeln;
textcolor(1);
for i:=0 to 1 do
begin
write('Seite eingeben:');
readln(s[i]);
drv:=0;
if((s[i]<>('a')) and
(s[i]<>('b')) and
(s[i]<>('c'))
and (s[i]<>('h')) and
(s[i]<>('p'))
and (s[i]<>('q'))) then begin
i:=i-1;
drv:=1;
end;
if(drv=0) then begin
write('Wert
für ',s[i],' eingeben:');
readln(w[i]);
end;end;
{********************* Einlesen der
Werte absolut *************************}
if(s[0]=('a')) then a:=w[0];
if(s[1]=('a')) then a:=w[1];
if(s[0]=('b')) then b:=w[0];
if(s[1]=('b')) then b:=w[1];
if(s[0]=('c')) then c:=w[0];
if(s[1]=('c')) then c:=w[1];
if(s[0]=('p')) then p:=w[0];
if(s[1]=('p')) then p:=w[1];
if(s[0]=('q')) then q:=w[0];
if(s[1]=('q')) then q:=w[1];
if(s[0]=('h')) then h:=w[0];
if(s[1]=('h')) then h:=w[1];
if(((s[0]=('a')) and (s[1]=('h')))
or
((s[0]=('h')) and
(s[1]=('a')))) then begin
p:=sqrt(a*a-h*h);
{*1.Sonderfall ****************}
s[0]:=('a');w[0]:=a;
{*Umlenkung auf KathetenSatz 1*}
s[1]:=('p');w[1]:=p;
{******************************}
end;
if(((s[0]=('b')) and (s[1]=('h')))
or
((s[0]=('h')) and
(s[1]=('b')))) then begin
q:=sqrt(b*b-h*h);
{*2.Sonderfall ****************}
s[0]:=('b');w[0]:=b;
{*Umlenkung auf KathetenSatz 2*}
s[1]:=('q');w[1]:=q;
{******************************}
end;
if(((s[0]=('c')) and (s[1]=('h')))
or
((s[0]=('h')) and
(s[1]=('c')))) then begin
q:=c/2 + sqrt(((c/2)*(c/2))-h*h);
{*3.Sonderfall (könnte auch p sein)*}
s[0]:=('q');w[0]:=q;
{*Umlenkung auf KathetenSatz 2*}
s[1]:=('c');w[1]:=c;
{******************************}
end;
if(((s[0]=('a')) and (s[1]=('q')))
or
((s[0]=('q')) and
(s[1]=('a')))) then begin
p:= -q/2+sqrt(((q/2)*(q/2))+a*a);
{*4.Sonderfall (-sqrt keine sinnvolle Lsg.*}
s[0]:=('p');w[0]:=p;
{*Umlenkung auf KathetenSatz 1*}
s[1]:=('a');w[1]:=a;
{******************************}
end;
if(((s[0]=('b')) and (s[1]=('p')))
or
((s[0]=('p')) and
(s[1]=('b')))) then begin
q:= -p/2+sqrt(((p/2)*(p/2))+b*b); {*5.Sonderfall*}
s[0]:=('q');w[0]:=q;
{*Umlenkung auf KathetenSatz 2*}
s[1]:=('b');w[1]:=b;
{******************************}
end;
if(((c<=a) or (c<=b))) then begin
writeln('Dreieck
existiert nicht!!');halt;end;
if(((s[0]=('a')) and (s[1]=('b')))
or
((s[0]=('b')) and
(s[1]=('a'))) or
((s[0]=('a')) and
(s[1]=('c'))) or
((s[0]=('c')) and
(s[1]=('a'))) or
((s[0]=('b')) and
(s[1]=('c'))) or
((s[0]=('c')) and
(s[1]=('b')))) then pytha;
if(((s[0]=('h')) and (s[1]=('p')))
or
((s[0]=('p')) and
(s[1]=('h'))) or
((s[0]=('h')) and
(s[1]=('q'))) or
((s[0]=('q')) and
(s[1]=('h'))) or
((s[0]=('p')) and
(s[1]=('q'))) or
((s[0]=('q')) and
(s[1]=('p')))) then hoehen;
if(((s[0]=('p')) and (s[1]=('c')))
or
((s[0]=('c')) and
(s[1]=('p'))) or
((s[0]=('a')) and
(s[1]=('p'))) or
((s[0]=('p')) and
(s[1]=('a')))) then kath1;
if(((s[0]=('q')) and (s[1]=('c')))
or
((s[0]=('c')) and
(s[1]=('q'))) or
((s[0]=('b')) and
(s[1]=('q'))) or
((s[0]=('q')) and
(s[1]=('b')))) then kath2;
textcolor(4);writeln;
writeln('Der Wert für die Seite
a beträgt: ',a:4:2);
writeln('Der Wert für die Seite
b beträgt: ',b:4:2);
writeln('Der Wert für die Seite
c beträgt: ',c:4:2);
writeln('Der Wert für die Seite
p beträgt: ',p:4:2);
writeln('Der Wert für die Seite
q beträgt: ',q:4:2);
writeln('Der Wert für die Seite
h beträgt: ',h:4:2);
s[0]:=readkey;
{****************************************************************************}
drv:=9; modus:=2;
initgraph(drv,modus,'C:\TP\BGI');
{*Init Graph und FehlerBehandlung*}
drv:=graphresult;
if(drv<>grOk) then begin writeln(grapherrormsg(drv));halt;end;
setcolor(12);
if(c>h) then w[0]:=(479/(c));
if(c<h) then w[0]:=(479/(h));
line(0,trunc(h*w[0]),trunc((q*w[0])),0);
{**** b-Seite ****}
line(trunc(q*w[0]),0,479,trunc(h*w[0]));
{**** a-Seite ****}
line(0,trunc(h*w[0]),479,trunc(h*w[0]));
SetLineStyle(DottedLn,0,NormWidth);
line(trunc(q*w[0]),0,trunc(q*w[0]),trunc(h*w[0]));
setcolor(14);
outtextxy(trunc((q*w[0]/2)),trunc(h*w[0]/2),'b');
outtextxy(trunc((q*w[0]+(p*w[0])/2)),trunc(h*w[0]/2),'a');
outtextxy(trunc(c*w[0]/2),trunc(h*w[0]),'c');
setcolor(9);
outtextxy(trunc((q*w[0]/2)),trunc(h*w[0]),'q');
outtextxy(trunc((q*w[0]+(p*w[0])/2)),trunc(h*w[0]),'p');
outtextxy(trunc(q*w[0]),trunc(h*w[0]/2),'h');
s[0]:=readkey;
closegraph;
textbackground(0); textcolor(7); clrscr;
{*Bildschirm löschen*}
end.
{***************************************************************************}
{ Herleitung der Formel für geg: h &
c // Formeln:= a²+b²=c²; a²=h²+p²;
}
{ b²=q²+h²; p=c-q; ->
****** [h²+(c-q)²] + [h²+q²] = c² *******************}
{ (p=c/2 + û(c/2)²-h²)
}
{***************************************************************************}