program tkrgrafs;                {Auswertung des Widerstandes}
                                {von Dateien im tkm-Format}
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,b36: char;
    Name,name2: string;
    tex,tex2:Text;
    i,l,anz,imax,b3,b4,b5:integer;
var graphdriver,graphmode:integer;
    mx,my,xp,yp,x0,y0,j,find,nr,anzs:integer;
    r,dx,dy,xl,yl,invdifx:real;
    xmin,xmax,x,y,ymin,ymax,difx,dify,invdify,deltax,deltay:real;
    strzahl:string;
    xr,yr,symin,symax,rr,r273,xmins,xmaxs,ymins,ymaxs:real;
    word1,word2,word3,word4,word5:string;
    xmintxt,xmaxtxt,ymintxt,ymaxtxt,maxpix,nks,ischrift:integer;

procedure ig;
 begin
 initgraph(graphdriver,graphmode,'c:\sprachen\tp\bgi');
 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;

begin
repeat
 clrscr;
 writeln('Programm zur Auswertung des Widerstandes von Dateien im tkm-Format.');
 rr:=0;
 writeln('Eingabe des Namen der Datei, in der sich die Meáwerte befinden, die');
 write('ausgewertet werden sollen (ohne Extension): ');
 readln(name);name:=name+'.tkm';
 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('Sind alle Eingaben richtig? (j/n) ');readln(b11);
until b11='j';
repeat
repeat
clrscr;
writeln;
writeln(' Nr                X-Achse                  Y-Achse');
writeln;writeln;
writeln('  1                T in K                  R in Ohm');
writeln;
writeln('  2             1000/T in 1/K             ln(R/R273)');
writeln;
writeln('  3             1000/T in 1/K              R in Ohm');
writeln;
writeln('  4                T in K                   R273/R');
writeln;
writeln('  5                T in K                 ln(R273/R)');
writeln;
writeln('  6             1000/T in 1/K               R273/R');
writeln;
writeln('  7             1000/T in 1/K             ln(R273/R)');
writeln;
writeln('  0                          Programmende');
writeln;writeln;
write('W„hlen Sie eine Nummer! Nr=');readln(nr);
until ((0<=nr)and(nr<=7));
if nr<>0 then begin
 write ('Gitter mitzeichnen? (j/n) ');readln(b36);
for b3:=1 to 2 do begin
 assign(tex,name);
 reset(tex);
 for i:=1 to 10 do begin
 if not eof(tex) then begin
readln(tex,anz);
readln(tex,tem1);
readln(tex,tem2);
readln(tex,us);
readln(tex,dt);
readln(tex,rr);
 end;end;
xmin:=(tem1+tem2)/2;xmax:=xmin;
ymin:=rr;ymax:=rr;

while (not eof(tex)) do begin
  for i:=1 to 10 do begin
  if not eof(tex) then begin
  readln(tex,anz);
  readln(tex,tem1);
  readln(tex,tem2);
  readln(tex,us);
  readln(tex,dt);
  readln(tex,rr);
  end;end;
if ((nr=1)or(nr=3)) then begin
  if rr<ymin then ymin:=rr;
  if rr>ymax then ymax:=rr;end;
if ((nr=2)or (nr=4)or(nr=5)or(nr=6)or(nr=7)) then begin
  if xmin>=273 then begin
    if (tem1+tem2)/2<xmin then begin xmin:=(tem1+tem2)/2;ymin:=rr;end;end;
  if xmin<273 then begin
    if ((tem1+tem2)/2>xmin)and((tem1+tem2)/2<273) then begin
    xmin:=(tem1+tem2)/2;ymin:=rr;end;end;
  if xmax>273 then begin
    if ((tem1+tem2)/2<xmax)and((tem1+tem2)/2>273) then begin
    xmax:=(tem1+tem2)/2;ymax:=rr;end;end;
  if xmax<=273 then begin
    if (tem1+tem2)/2>xmax then begin
    xmax:=(tem1+tem2)/2;ymax:=rr;end;end;
 end;

 end;

end;
if nr=1 then begin
ymin:=0;ymax:=ymax+0.1*abs(ymax);
xmin:=0;xmax:=300;end;
if ((nr=2)or (nr=4)or(nr=5)or(nr=6)or(nr=7)) then begin
if xmin<xmax then r273:=ymin+(273-xmin)*(ymax-ymin)/(xmax-xmin)
else r273:=ymin;
xmin:=0;xmax:=40;ymin:=-1;ymax:=4;end;
if nr=3 then begin
ymin:=0;ymax:=ymax+0.1*abs(ymax);
xmin:=0;xmax:=40;end;
if nr=4 then begin
xmin:=0;xmax:=300;ymin:=0;ymax:=1.2;
end;
if nr=5 then begin
xmin:=0;xmax:=300;ymin:=-4;ymax:=1;
end;
if nr=6 then begin
xmin:=0;xmax:=40;ymin:=0;ymax:=1.2;
end;
if nr=7 then begin
xmin:=0;xmax:=40;ymin:=-4;ymax:=1;
end;
graphdriver:=detect;ig;
mx:=getmaxx-20;my:=getmaxy-50;
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 begin
if ((nr=1)or(nr=4)or(nr=5)) then outtextxy(x0,my+hh1,'T[K]');
if ((nr=2)or(nr=3)or(nr=6)or(nr=7)) then outtextxy(x0,my+hh1,'1000/T[1/K]');
end;
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 ((nr=1)or(nr=3)) then outtextxy(mxhi-hh1,y0,'R[Ohm]');
if nr=2 then outtextxy(mxhi-hh1,y0,'ln R/R273');
if ((nr=4)or(nr=6)) then outtextxy(mxhi-hh1,y0,'R273/R');
if ((nr=5)or(nr=7)) then outtextxy(mxhi-hh1,y0,'ln R273/R');
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
    for i:=1 to 10 do begin
    if not eof(tex) then begin
    readln(tex,anz);
    readln(tex,tem1);
    readln(tex,tem2);
    readln(tex,us);
    readln(tex,dt);
    readln(tex,rr);
    end;end;
if nr=1 then begin
    x:=(tem1+tem2)/2;
    y:=rr;end;                                         { Zeichnen der }
if nr=2 then begin
    x:=(tem1+tem2)/2;x:=1000/x;
    y:=rr/r273;y:=ln(y);end;
if nr=3 then begin
    x:=(tem1+tem2)/2;x:=1000/x;
    y:=rr;end;
if nr=4 then begin
    x:=(tem1+tem2)/2;
    y:=r273/rr;end;
if nr=5 then begin
    x:=(tem1+tem2)/2;
    y:=r273/rr;y:=ln(y);end;
if nr=6 then begin
    x:=(tem1+tem2)/2;x:=1000/x;
    y:=r273/rr;end;
if nr=7 then begin
    x:=(tem1+tem2)/2;x:=1000/x;
    y:=r273/rr;y:=ln(y);end;
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);
    if not eof(tex) then circle(xp,yp,2);
end;end;

settextjustify(lefttext,centertext);
 settextstyle(0,horizdir,0);
outtextxy(15,75,'Probennr.: ');
outtextxy(150,75,word1);
outtextxy(round(mx/2),75,'Schichtdicke/nm: ');
outtextxy(round(mx/2+200),75,word2);
outtextxy(15,45,'Meádatum: ');
outtextxy(150,45,word3);
outtextxy(round(mx/2),45,'Meástrom/mA: ');
outtextxy(round(mx/2+200),45,word4);
outtextxy(15,15,word5);

close(tex);
readln;
closegraph;
end;
if nr<>0 then begin
write('Grafik als X-Y-Datei abspeichern ? (j/n) ');readln(b36);
if b36='j' then begin
write('Dateiname: ');readln(name2);
assign(tex2,name2);rewrite(tex2);
write('Alle Punkte abspeichern ? (j/n) ');readln(b36);
if b36='n' then begin
write('Xmin : ');readln(xmins);
write('Xmax : ');readln(xmaxs);
write('Ymin : ');readln(ymins);
write('Ymax : ');readln(ymaxs);
end;
anzs:=0;
reset(tex);
while not eof(tex) do begin
    for i:=1 to 10 do begin
    if not eof(tex) then begin
    readln(tex,anz);
    readln(tex,tem1);
    readln(tex,tem2);
    readln(tex,us);
    readln(tex,dt);
    readln(tex,rr);
    end;end;
if nr=1 then begin
    x:=(tem1+tem2)/2;
    y:=rr;end;
if nr=2 then begin
    x:=(tem1+tem2)/2;x:=1000/x;
    y:=rr/r273;y:=ln(y);end;
if nr=3 then begin
    x:=(tem1+tem2)/2;x:=1000/x;
    y:=rr;end;
if nr=4 then begin
    x:=(tem1+tem2)/2;
    y:=r273/rr;end;
if nr=5 then begin
    x:=(tem1+tem2)/2;
    y:=r273/rr;y:=ln(y);end;
if nr=6 then begin
    x:=(tem1+tem2)/2;x:=1000/x;
    y:=r273/rr;end;
if nr=7 then begin
    x:=(tem1+tem2)/2;x:=1000/x;
    y:=r273/rr;y:=ln(y);end;
if b36='n' then begin
if((xmins<=x)and(x<=xmaxs)and(ymins<=y)and(y<=ymaxs)) then begin
writeln(tex2,x);writeln(tex2,y);inc(anzs);end;end else begin
writeln(tex2,x);writeln(tex2,y);inc(anzs);end;
end;
writeln('Es wurden ',anzs,' Wertepaare gespeichert.');readln;
close(tex);
close(tex2);
end;
end;
until nr=0;
writeln;
writeln('Programmende.');
readln;
end.