home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 12 / algorith / stuff1.inc < prev    next >
Encoding:
Text File  |  1989-09-29  |  11.0 KB  |  349 lines
  1.  
  2.  
  3. procedure fenster(x1,y1,x2,y2:integer);
  4. var i:integer;
  5.  begin
  6.   gotoxy(x1-1,y1-1);write(chr(201));
  7.   gotoxy(x2+1,y1-1);write(chr(187));
  8.   gotoxy(x1-1,y2+1);write(chr(200));
  9.   gotoxy(x2+1,y2+1);write(chr(188));
  10.   for i:=x1 to x2 do begin
  11.                       gotoxy(i,y1-1); write(chr(205));
  12.                       gotoxy(i,y2+1); write(chr(205));
  13.                      end;
  14.   for i:=y1 to y2 do begin
  15.                       gotoxy(x1-1,i); write(chr(186));
  16.                       gotoxy(x2+1,i); write(chr(186));
  17.                      end;
  18.    window(x1,y1,x2,y2);
  19.    xxx1:=x1;yyy1:=y1;xxx2:=x2;yyy2:=y2;
  20.  end;
  21.  
  22. procedure resetfenster;
  23.  begin
  24.   window(1,1,80,25);
  25.   xxx1:=1;xxx2:=80;yyy1:=1;yyy2:=25;
  26.  end;
  27.  
  28. function hga:boolean;
  29.  begin
  30.   if mem[0:$0463]<>180 then hga:=false else hga:=true;
  31.  end;
  32.  
  33. procedure hilfe(kontext:integer);
  34. var einlesen:string[255];
  35. var x1,x2,y1,y2,zzz:integer;
  36.  begin
  37.   ccx:=wherex; ccy:=wherey;
  38.   x1:=xxx1;x2:=xxx2;y1:=yyy1;y2:=yyy2;
  39.   resetfenster;
  40.   if hga then move(bildschirm_hga,speichere_bild_help,4000)
  41.          else move(bildschirm_cga,speichere_bild_help,4000);
  42.   fenster(2,2,79,23);
  43.   clrscr; einlesen:='';
  44.   assign(textdatei,'karthelp.txt');
  45.   (*$i- *) reset(textdatei); (*$i+ *)
  46.   if ioresult<>0 then
  47.     writeln('Fehler beim Lesen der Datei "KARTHELP.TXT" ')
  48.   else
  49.    begin
  50.     while not(eof(textdatei)) and (einlesen[1]<>chr(kontext+48)) do
  51.      readln(textdatei,einlesen);
  52.      einlesen:=''; zzz:=0;
  53.     while not(eof(textdatei)) and (einlesen[1]<>chr(kontext+49)) do
  54.      begin
  55.       writeln(' ',einlesen);
  56.       zzz:=zzz+1; if zzz=21 then repeat until keypressed;
  57.       readln(textdatei,einlesen);
  58.      end;
  59.     close(textdatei);
  60.    end;
  61.   ant:='°';
  62.   while ant<>chr(27) do read(kbd,ant);
  63.   ant:='°';
  64.   if hga then move(speichere_bild_help,bildschirm_hga,4000)
  65.          else move(speichere_bild_help,bildschirm_cga,4000);
  66.   resetfenster;
  67.   if x2<>80 then fenster(x1,y1,x2,y2);
  68.   gotoxy(ccx,ccy);
  69.  end;
  70.  
  71.  
  72. procedure weissaufschwarz;
  73.  begin textcolor(white);textbackground(black); end;
  74.  
  75. procedure schwarzaufweiss;
  76.  begin textcolor(black);textbackground(white); end;
  77.  
  78. procedure my_readln(var eingabe:sriesig;laenge,helpmen:integer);
  79.  var bst:char; x,y,i:integer;
  80.   begin
  81.    eingabe:='';
  82.    x:=wherex; y:=wherey;
  83.    read(kbd,bst);
  84.    while bst=chr(27) do begin hilfe(helpmen); read(kbd,bst); end;
  85.    if bst<>chr(13) then
  86.    begin
  87.     write('':laenge);
  88.     gotoxy(x,y);
  89.     repeat
  90.      if (bst=chr(8)) and (length(eingabe)>0) then
  91.       begin
  92.        x:=x-1;
  93.        eingabe:=copy(eingabe,1,length(eingabe)-1);
  94.        gotoxy(x,y);write(' ');gotoxy(x,y);
  95.       end
  96.      else if (bst<>chr(8)) and (length(eingabe)<laenge) then
  97.       begin
  98.        eingabe:=eingabe+bst;
  99.        gotoxy(x,y);write(bst);x:=x+1;
  100.       end else for i:=1 to 5 do begin sound(440+i*40); delay(50); nosound; end;
  101.      read(kbd,bst);
  102.      while bst=chr(27) do begin hilfe(helpmen);read(kbd,bst); end;
  103.     until bst=chr(13);
  104.    end;
  105.    writeln;
  106.   end;
  107.  
  108.  
  109. procedure neuesformular;
  110.  begin
  111.   fenster(47,12,79,23);
  112.   weissaufschwarz;
  113.   clrscr;
  114. (* sofern vorhanden, gib schon definierte formulare aus *)
  115.   if not(letzter_typ in [nix,voll]) then
  116.    for kt:=a to letzter_typ do
  117.     begin
  118.      clrscr;
  119.      writeln('     F o r m u l a r < ',chr(64+ord(kt)),' >');
  120.      for u:=1 to 5 do
  121.       begin
  122.        writeln;
  123.        write(' Name von Feld ',u,':  ');
  124.        schwarzaufweiss;writeln(feldnamen[kt,u]);weissaufschwarz;
  125.       end;
  126.      read(kbd,ant); while ant=chr(27) do begin hilfe(4); read(kbd,ant); end;
  127.     end;
  128.    if letzter_typ=voll then begin
  129.                               writeln; writeln;
  130.                               writeln(' Keine neuen Formulare möglich !!!');
  131.                               read(kbd,ant);
  132.                               while ant=chr(27) do
  133.                                begin hilfe(4); read(kbd,ant); end;
  134.                              end
  135.                        else  begin
  136.                               letzter_typ:=succ(letzter_typ);
  137.                               clrscr;
  138. (* lies die feldnamen fuer das neue Formular ein *)
  139.                               writeln(' Eingabe für Formular <',
  140.                                chr(64+ord(letzter_typ)),'>');
  141.                               gotoxy(1,3);
  142.                               for u:=1 to 5 do
  143.                                begin
  144.                                 write(' Name für Feld ',u,': ');
  145.                                 schwarzaufweiss;
  146.                                 write('':12);gotoxy(wherex-12,wherey);
  147.                                 my_readln(eingabe,12,4);
  148.                                 weissaufschwarz;
  149.                                 feldnamen[letzter_typ,u]:=eingabe;
  150.                                 writeln;
  151.                                end;
  152.                              end;
  153.      resetfenster;
  154.    end;
  155.  
  156.  
  157.  
  158. procedure neuekarteikarte;
  159.  begin
  160.   schwarzaufweiss;
  161.   clrscr;
  162.   fenster(10,3,70,22);
  163.   weissaufschwarz;
  164.   clrscr;
  165. (* noetig fuer bubble-sort *)
  166.   kartanz:=kartanz+1;
  167. (* suche die letzte karte in der liste; dies ist notwendig, *)
  168. (* da die karten ja umsortiert werden koennen *)
  169.   letzte_karte:=erste_karte;
  170.   while letzte_karte^.naechste<>nil do letzte_karte:=letzte_karte^.naechste;
  171.   new(karte);
  172.   karte^.naechste:=nil;
  173.   if erste_karte=nil then erste_karte:=karte
  174.                      else letzte_karte^.naechste:=karte;
  175.   writeln('              Erstellen einer neuen Karteikarte');
  176.   gotoxy(1,3); write(' Formular für diese Karte: ');
  177.   read(kbd,ant);
  178.   while ant=chr(27) do begin hilfe(5); read(kbd,ant); end;
  179. (* wandele char in kartentyp um *)
  180.   u:=ord(upcase(ant)); kt:=nix; for z:=65 to u do kt:=succ(kt);
  181.   karte^.kartentyp:=kt; writeln;
  182. (* lies die feldinhalte der neuen karteikarte ein *)
  183.   for u:=1 to 4 do begin
  184.                     write(feldnamen[kt,u],': ');
  185.                     schwarzaufweiss;
  186.                     write('':40); gotoxy(wherex-40,wherey);
  187.                     my_readln(eingabe,40,5);
  188.                     karte^.inhalt[u]:=eingabe;
  189.                     weissaufschwarz;
  190.                    end;
  191.   writeln;
  192. (* lies die 7 textzeilen der neuen karte ein *)
  193.   writeln(feldnamen[kt,5],': ');
  194.   for u:=1 to 7 do begin
  195.                     write(' ');
  196.                     schwarzaufweiss;
  197.                     write('':55);
  198.                     gotoxy(wherex-55,wherey);
  199.                     my_readln(karte^.inhalt5[u],55,5);
  200.                     weissaufschwarz;
  201.                    end;
  202.    resetfenster;
  203.  end;
  204.  
  205.  
  206. procedure editiere_karteikarte(karte:kartenzeiger);
  207.  begin
  208.   schwarzaufweiss;
  209.   resetfenster;
  210.   fenster(10,3,70,22);
  211.   clrscr;
  212.   weissaufschwarz;
  213. repeat
  214.   clrscr;
  215.   writeln('              Editieren einer Karteikarte');
  216.   gotoxy(1,3); writeln(' Formular für diese Karte: ',
  217.                       chr(64+ord(karte^.kartentyp)));
  218.   for u:=1 to 4 do begin
  219.                     write(feldnamen[karte^.kartentyp,u],': ');
  220.                     schwarzaufweiss;
  221.                     write('':40); gotoxy(wherex-40,wherey);
  222.                     write(karte^.inhalt[u]);
  223.                     weissaufschwarz;
  224.                     writeln;
  225.                    end;
  226.   writeln;
  227.   writeln(feldnamen[karte^.kartentyp,5],': ');
  228.   for u:=1 to 7 do begin
  229.                     write(' ');
  230.                     schwarzaufweiss;
  231.                     write('':55);
  232.                     gotoxy(wherex-55,wherey);
  233.                     weissaufschwarz;
  234.                     writeln(karte^.inhalt5[u]);
  235.                    end;
  236.     gotoxy(28,3);
  237.     read(kbd,ant);
  238.     while ant=chr(27) do begin hilfe(2) ; read(kbd,ant) end;
  239.     writeln;
  240.     if ant<>chr(13) then
  241.      begin
  242.        u:=ord(upcase(ant)); kt:=nix; for z:=65 to u do kt:=succ(kt);
  243.        karte^.kartentyp:=kt;
  244.       end;
  245.  until ant=chr(13);
  246.  
  247.     for u:=1 to 4 do begin
  248.                     write(feldnamen[karte^.kartentyp,u],': ');
  249.                     schwarzaufweiss;
  250.                     my_readln(eingabe,40,2);
  251.                     if eingabe<>'' then
  252.                      karte^.inhalt[u]:=eingabe;
  253.                     weissaufschwarz;
  254.                    end;
  255.   writeln;
  256.   writeln(feldnamen[karte^.kartentyp,5],': ');
  257.   for u:=1 to 7 do begin
  258.                     weissaufschwarz;
  259.                     write(' ');
  260.                     schwarzaufweiss;
  261.                     my_readln(eingabe,55,2);
  262.                     if eingabe<>'' then
  263.                      karte^.inhalt5[u]:=eingabe;
  264.                    end;
  265.    resetfenster;
  266.  end;
  267.  
  268.  
  269.  
  270. procedure karten_abspeichern;
  271. var x,y:integer;
  272. begin
  273. if kartanz>0 then
  274.  begin
  275.   fenster(47,14,79,16);
  276.   clrscr;write('Abspeichern der Datei: ');
  277.   x:=wherex;y:=wherey;
  278.   write(datnam);gotoxy(x,y);
  279.   my_readln(eingabe,8,6);if eingabe<>''then datnam:=eingabe;
  280.   if datnam<>'' then
  281.    begin
  282.     assign(formulardatei,datnam+'.frm');
  283.     (*$i- *) rewrite(formulardatei); (*$i+ *)
  284.     if ioresult<>0 then
  285.      begin
  286.       writeln; writeln(' Fehler beim Schreiben der Datei: ');writeln;
  287.       write('          ');schwarzaufweiss;
  288.       write(datnam);weissaufschwarz;
  289.       read(kbd,ant); while ant=chr(27) do begin hilfe(6); read(kbd,ant) end;
  290.      end
  291.     else
  292.      begin
  293. (* unter der variablen hformular werden die formulare und der zeiger *)
  294. (* auf das letzte formular vor dem abspeichern auf diskette zusammengefasst *)
  295.       hformular.k1:=feldnamen;
  296.       hformular.k2:=letzter_typ;
  297.       write(formulardatei,hformular); close(formulardatei);
  298.       assign(kartendatei,datnam+'.krt'); rewrite(kartendatei);
  299.       karte:=erste_karte;
  300.       while karte<>nil do begin
  301.                          write(kartendatei,karte^);
  302.                          karte:=karte^.naechste;
  303.                         end;
  304.       close(kartendatei);
  305.       end;
  306.    end;
  307.   resetfenster;
  308.  end;
  309. end;
  310.  
  311. procedure karten_laden;
  312.  begin
  313. (* loesche zuerst schon vorhandene karten *)
  314.   karte:=erste_karte;
  315.   while karte<>nil do begin dispose(karte); karte:=karte^.naechste; end;
  316.   fenster(47,14,79,16);clrscr;datnam:='';
  317.   write('Laden der Datei: '); my_readln(eingabe,8,7); datnam:=eingabe;
  318.   if datnam<>'' then
  319.    begin
  320.     assign(formulardatei,datnam+'.frm');
  321.     (*$i- *) reset(formulardatei);  (*$i+ *)
  322.     if ioresult<>0 then
  323.      begin
  324.       writeln; writeln(' Fehler beim Lesen der Datei: ');writeln;
  325.       write('          ');schwarzaufweiss;
  326.       write(datnam);weissaufschwarz;
  327.       read(kbd,ant); while ant=chr(27) do begin hilfe(6); read(kbd,ant) end;
  328.      end
  329.     else
  330.      begin
  331.       read(formulardatei,hformular);
  332.       feldnamen:=hformular.k1; letzter_typ:=hformular.k2;
  333.       close(formulardatei);
  334.       assign(kartendatei,datnam+'.krt'); reset(kartendatei);
  335.       new(karte); karte^.naechste:=nil; erste_karte:=karte; vorgaenger:=nil;
  336.       kartanz:=0;
  337.       while not eof(kartendatei) do
  338.        begin
  339.         kartanz:=kartanz+1;
  340.         read(kartendatei,karte^);
  341.         if vorgaenger<>nil then vorgaenger^.naechste:=karte;
  342.         vorgaenger:=karte; new(karte); karte^.naechste:=nil;
  343.        end;
  344.      dispose(karte); close(kartendatei);
  345.     end;
  346.    end;
  347.   resetfenster;
  348.  end;
  349.