home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 12 / algorith / stuff2.inc < prev    next >
Encoding:
Text File  |  1989-08-27  |  2.0 KB  |  91 lines
  1. function auch_gemeint(w1,w2:smittel) : boolean;
  2. begin
  3.   resetfenster;
  4.   textcolor(white+blink);
  5.   fenster(2,22,79,23);
  6.   textcolor(white);
  7.   clrscr;
  8.   writeln('Meinen Sie mit  >',w1,'<');
  9.   write  ('den Feldinhalt  >',w2,'<  j/n ?  ');
  10.   textcolor(white);
  11.   read(kbd,ant);
  12.   while ant=chr(27) do begin
  13.     hilfe(9);
  14.     read(kbd,ant);
  15.   end;
  16.   if ant in ['j','J'] then
  17.     auch_gemeint:=true
  18.   else
  19.     auch_gemeint:=false;
  20.   resetfenster;
  21.   fenster(2,22,79,23);
  22. end;
  23.  
  24.  
  25. function enthalten_in(var w1, w2: smittel) : boolean;
  26.  
  27. var i,u : integer;
  28.     wh1,wh2,whh2 : smittel;
  29.     bb:boolean;
  30.  
  31. begin
  32.   if length(w1)>0 then begin
  33.     enthalten_in:=false;
  34.     bb:=true;
  35.     wh1:=w1;
  36.     w1:='';
  37.     u:=0;
  38.     for i:=1 to length(wh1) do
  39.       w1:=w1+upcase(wh1[i]);
  40.     wh2:=w2;
  41.     w2:='';
  42.     for i:=1 to length(wh2) do
  43.       w2:=w2+upcase(wh2[i]);
  44.     if w1=w2 then begin
  45.       enthalten_in:=true;
  46.       w1:=wh2;
  47.       bb:=false;
  48.     end
  49.     else begin
  50.       whh2:=w2;
  51.       while (w2<>'') and bb and scanning do begin
  52.         if whh2=w1 then bb:=false;
  53.         if (length(w2)=length(w1))
  54.            or ( (length(w2)>length(w1))
  55.                  and (w2[length(w1)+1]=' ') ) then
  56.           whh2:=copy(w2,1,length(w1))
  57.         else whh2:='';
  58.         u:=pos(' ',w2);
  59.         if u>0 then
  60.           w2:=copy(w2,u+1,length(w2)-u)
  61.         else
  62.           w2:='';
  63.         if whh2=w1 then bb:=false;
  64.        end;
  65.        if not bb and scanning then
  66.          if auch_gemeint(wh1,wh2) then begin
  67.            enthalten_in:=true;
  68.            w1:=wh2;
  69.          end;
  70.      end;
  71.      if bb then
  72.        w1:=wh1;
  73.    end
  74.  else
  75.    enthalten_in:=false;
  76. end;
  77.  
  78.  
  79. procedure feld_mit_inhalt_ausgeben(z:integer);
  80.  begin
  81.   if zeile=12 then begin read; zeile:=1; end;
  82.   writeln(feldnamen[karte^.kartentyp,z],': ',karte^.inhalt[z]);
  83.   zeile:=zeile+1;
  84.  end;
  85.  
  86. procedure feld_mit_inhalt_ausdrucken(z:integer);
  87.  begin
  88.   writeln(lst,feldnamen[karte^.kartentyp,z],': ',karte^.inhalt[z]);
  89.   feld_mit_inhalt_ausgeben(z);
  90.  end;
  91.