program tkagraf;                {Auswertung von Thermospannungsmessungen,}
                                {die mit TKMGRAF3 durchgef�hrt wurden}
uses  dos,crt,graph;


const mxhi=120;myhi=120;hh1=15;hh2=15;myh=35;

var US,tem1,tem2,ur,dt : real;
    b1,b2,b11,b35,b36,b37: char;
    name: string;
    tex:Text;
    i,l,anz,imax,b3,b5,b6:integer;
    f : text;
    z0,z1,z2,z3,z4,z5: real;
    utmin,utmax,ust,dTmin,dTmax,Tmin,Tmax:real;

var graphdriver,graphmode:integer;
    mx,my,mym,xp,yp,x0,y0,j,find:integer;
    r,dx,dy,xl,yl,invdifx:real;
    xmin,xmax,x,y,ymin,ymax,difx,dify,invdify,deltax,deltay:real;
    strxmin,strxmax,strymin,strymax,strr,sanz,strzahl:string;
    sxmin,sxmax,xr,yr,symin,symax,rr:real;
    word1,word2,word3,word4,word5,wordx,wordy:string;
    xmindef,xmaxdef,ymindef,ymaxdef:real;
    xmintxt,xmaxtxt,ymintxt,ymaxtxt,maxpix,nks,ischrift:integer;

procedure ig;
 begin
 initgraph(graphdriver,graphmode,'c:\sprachen\tp\bgi');
 end;

function kor(t_m1,t_m2:real):real;
 var ergebnis:real;
begin
if b6=1 then ergebnis:=0 else begin
 ergebnis:=z0*(t_m1-t_m2);
 ergebnis:=ergebnis+z1*(sqr(t_m1)-sqr(t_m2))/2;
 ergebnis:=ergebnis+z2*(t_m1*sqr(t_m1)-t_m2*sqr(t_m2))/3;
 ergebnis:=ergebnis+z3*(sqr(t_m1*t_m1)-sqr(t_m2*t_m2))/4;
 ergebnis:=ergebnis+z4*(t_m1*sqr(t_m1*t_m1)-t_m2*sqr(t_m2*t_m2))/5 ;
 ergebnis:=ergebnis+z5*(sqr(t_m1*t_m1*t_m1)-sqr(t_m2*t_m2*t_m2))/6 ;
end;
 kor:=ergebnis;
end;

function komma(xxx:real):integer;
var il:integer;
begin
il:=0;
while xxx<1 do begin
xxx:=xxx*10;inc(il);end;
komma:=il;
end;

function bedingung:boolean;
var bed:boolean;
begin
bed:=true;
if b37='n' then begin
if ((utmax<abs(us))and(utmax<>0)) then bed:=false;
if (utmin>abs(us)) then bed:=false;
if (dTmin>abs(tem1-tem2)) then bed:=false;
if ((dTmax<abs(tem1-tem2))and(dTmax<>0)) then bed:=false;
if ((2*Tmax<(tem1+tem2))and(Tmax<>0)) then bed:=false;
if (2*Tmin>(tem1+tem2)) then bed:=false;
end;
bedingung:=bed;
end;

begin
repeat
 clrscr;
 writeln('Programm zur Auswertung von Thermospannungsmeáwerten, die mit');
 writeln('Hilfe des Programms tkmgraf3 aufgenommen wurden.');
 rr:=0;
 writeln('Eingabe des Namen der Datei, in der sich die Meáwerte befinden, die');
 write('ausgewertet werden sollen (mit Extension): ');
 readln(name);
 write('Probennummer: ');readln(word1);
 write('Schichtdicke in nm: ');readln(word2);
 write('Meádatum: ');readln(word3);
 write('Meástrom in mA: ');readln(word4);
 writeln('Geben Sie die šberschrift der Grafik ein! (max. eine Zeile!)');
 readln(word5);
 write('Auswertung relative Thermokraft (1) / absolute Thermokraft (2) ');
 readln(b6);
 write('Autografik? (j/n) ');readln(b35);
   if b35='n' then begin
   write('Tmin[K] : ');readln(xmindef);
   write('Tmax[K] : ');readln(xmaxdef);
   write('Smin[æV/K] : ');readln(ymindef);
   write('Smax[æV/K] : ');readln(ymaxdef);
   end;
 write ('Gitter mitzeichnen? (j/n) ');readln(b36);
 write('Alle Meáwerte auswerten? (j/n) ');readln(b37);
if b37='n' then begin
writeln('Wenn die maximalen Werte unbeschr„nkt sind, dann "0" eingeben!');
 write('Minimale Thermospannung Uthmin/æV: ');readln(utmin);
 write('Maximale Thermospannung Uthmax/æV: ');readln(utmax);
 write('Minimale Temperaturdifferenz dTmin/K: ');readln(dTmin);
 write('Maximale Temperaturdifferenz dTmax/K: ');readln(dTmax);
 write('Minimale mittlere Temperatur Tmin/K: ');readln(Tmin);
 write('Maximale mittlere Temperatur Tmax/K: ');readln(Tmax);
end;
{ writeln('Geben Sie die vermutete St”rspannung Us an, von der die gemessene');
 writeln('Thermospannung �berlagert wird!');
 write('Us/æV: ');readln(ust); }
 ust:=0;
 write('Sind alle Eingaben richtig? (j/n) ');readln(b11);
until b11='j';
if b6=2 then begin
 assign(f,'c:\daten\th_delta.txt');
 reset(f);
 readln(f,z0);
 readln(f,z1);
 readln(f,z2);
 readln(f,z3);
 readln(f,z4);
 readln(f,z5);
 close(f);
end;
for b3:=1 to 2 do begin
 assign(tex,name);
 reset(tex);
repeat
readln(tex,anz);
readln(tex,tem1);
readln(tex,tem2);
readln(tex,us);us:=us-ust-kor(tem1,tem2);
readln(tex,dt);
readln(tex,rr);
if bedingung=true then begin
xmin:=(tem1+tem2)/2;xmax:=xmin;
if b3=1 then begin ymin:=us/(tem1-tem2);ymax:=ymin;end;
if b3=2 then begin ymin:=(tem1-tem2);ymax:=ymin;end;
end;
until bedingung=true;
while (not eof(tex)) do begin
  readln(tex,anz);
  readln(tex,tem1);
  readln(tex,tem2);
  readln(tex,us);us:=us-ust-kor(tem1,tem2);
  readln(tex,dt);
  readln(tex,rr);
if bedingung=true then begin
  if (tem1+tem2)/2<xmin then xmin:=(tem1+tem2)/2;
  if (tem1+tem2)/2>xmax then xmax:=(tem1+tem2)/2;
 if b3=1 then begin
  if us/(tem1-tem2)<ymin then ymin:=us/(tem1-tem2);
  if us/(tem1-tem2)>ymax then ymax:=us/(tem1-tem2);
 end;
 if b3=2 then begin
  if (tem1-tem2)<ymin then ymin:=(tem1-tem2);
  if (tem1-tem2)>ymax then ymax:=(tem1-tem2);
 end;end;
end;
xmin:=xmin-0.1*abs(xmax-xmin);xmax:=xmax+0.1*abs(xmax-xmin);
ymin:=ymin-0.1*abs(ymax-ymin);ymax:=ymax+0.1*abs(ymax-ymin);
if ((b35='n')and(b3=1)) then begin
xmin:=xmindef;xmax:=xmaxdef;ymin:=ymindef;ymax:=ymaxdef;end;
if ((b35='n')and(b3=2)) then begin
xmin:=xmindef;xmax:=xmaxdef;end;
graphdriver:=detect;ig;
mx:=getmaxx-20;my:=getmaxy-50;
mym:=round(myh*(my-myhi)/100)+myhi;
for i:=mxhi to mx do begin putpixel(i,myhi,1);
                           putpixel(i,my,1);end;
for i:=myhi to my do begin putpixel(mxhi,i,1);
                           putpixel(mx,i,1);end;

dx:=(xmax-xmin);
if dx>0 then begin
r:=1;
    if dx>=100 then begin
           while dx>=100 do begin
                            dx:=dx/10;
                            r:=r*10;
                            end;                           {Ermittlung des}
                     end;                                  {X-Rasters}
    while dx<10 do begin
                   dx:=dx*10;
                   r:=r/10;
                   end;
    if dx>50 then deltax:=10*r
    else if dx>20 then deltax:=5*r
    else deltax:=2*r;
    nks:=komma(deltax);
    settextstyle(0,horizdir,0);
    settextjustify(centertext,righttext);
    invdifx:=(mx-mxhi)/(xmax-xmin);
    x:=int(xmin/deltax)*deltax;
    ischrift:=0;
    for j:=12 downto -1 do begin
    xr:=x+j*deltax;
    xl:=mxhi+(-xmin+x+j*deltax)*invdifx;
    x0:=round(xl);
    if (x0>=mxhi) and (x0<=mx) then begin
    inc(ischrift);
if ischrift<>2 then begin
str(xr:0:nks,strzahl);
outtextxy(x0,my+hh1,strzahl);
end else
outtextxy(x0,my+hh1,'T[K]');
if b36='j' then maxpix:=myhi else maxpix:=my-6;
    for i:=maxpix to my+6 do begin
    putpixel(x0,i,8);
    end;
    end;
    end;
x0:=round(mxhi-xmin*invdifx);
if (x0>=mxhi) and(x0<=mx) then begin
    for i:=myhi to my do begin
    putpixel(x0,i,4);
    end;
    end;
end;
{+++++++++++++++++++++++++++++}

xl:=mxhi+(-xmin+x+j*deltax)*invdifx;
dy:=ymax-ymin;
if dy>0 then begin
r:=1;
    if dy>=100 then begin
           while dy>=100 do begin
                            dy:=dy/10;
                            r:=r*10;
                            end;                           {Ermittlung des}
                     end;                                  {Y-Rasters}
    while dy<10 do begin
                   dy:=dy*10;
                   r:=r/10;
                   end;
    if dy>50 then deltay:=10*r
    else if dy>20 then deltay:=5*r
    else deltay:=2*r;
        nks:=komma(deltay);
        settextstyle(0,horizdir,0);                              
        settextjustify(righttext,centertext);
    y:=int(ymax/deltay)*deltay;
invdify:=(my-myhi)/(ymax-ymin);
    ischrift:=0;
    for j:=-1 to 12 do begin
    yr:=y-j*deltay;
    yl:=myhi+(ymax-y+j*deltay)*invdify;
    y0:=round(yl);
if((y0>=myhi)and(y0<=my)) then begin
    inc(ischrift);
    if ischrift<>2 then begin
str(yr:0:nks,strzahl);
outtextxy(mxhi-hh1,y0,strzahl);
end else begin
if b3=1 then outtextxy(mxhi-hh1,y0,'S[æV/K]');
if b3=2 then outtextxy(mxhi-hh1,y0,'T1-T2[K]');
end;
if b36='j' then maxpix:=mx else maxpix:=mxhi+6;
    for i:=mxhi-6 to maxpix do begin                    
    putpixel(i,y0,8);
    end;
    end;
    end;

y0:=round(myhi+ymax*invdify);
if (y0>=myhi) and (y0<=my) then begin
    for i:=mxhi to mx do begin
    putpixel(i,y0,4);
    end; 
    end;
end;

reset(tex);
while not eof(tex) do begin
    readln(tex,anz);
    readln(tex,tem1);
    readln(tex,tem2);
    readln(tex,us);us:=us-ust-kor(tem1,tem2);
    readln(tex,dt);
    readln(tex,rr);
    x:=(tem1+tem2)/2;
if bedingung=true then begin
  if b3=1 then y:=us/(tem1-tem2);                     { Zeichnen der }
  if b3=2 then y:=(tem1-tem2);
if((xmin<x)and(x<xmax)and(ymin<y)and(y<ymax)) then begin
    x:=mxhi+(x-xmin)*invdifx;xp:=round(x);                { Meáwerte }
    y:=myhi+(ymax-y)*invdify;yp:=round(y);
    circle(xp,yp,2);
end;
    end;
end;

settextjustify(lefttext,centertext);
 settextstyle(0,horizdir,0);
outtextxy(15,75,'Probennr.: ');
outtextxy(130,75,word1);
outtextxy(round(mx/2),75,'Schichtdicke/nm: ');
outtextxy(round(mx/2+180),75,word2);
outtextxy(15,45,'Meádatum: ');
outtextxy(130,45,word3);
outtextxy(round(mx/2),45,'Meástrom/mA: ');
outtextxy(round(mx/2+180),45,word4);
if b6=1 then outtextxy(15,15,'Relative Thermokraft')
else outtextxy(15,15,'Absolute Thermokraft');
outtextxy(215,15,word5);

close(tex);
readln;
closegraph;
end;
writeln;
writeln('Programmende.');
readln;
end.