Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
{ FILTER.PAS                Copyright (c) TrSek alias Zdeno Sekerak }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
procedure clear_pod;
var i:integer;
begin
 for i:=1 to max_viet do podmien[i]:=0;
end;
 
function vyber_pod:byte;
var i,x:integer;
    prvy:boolean;
    pomoc:array[1..2,1..40] of byte;
    oxw1,oxw2,oyw1,oyw2:integer;
begin
 oxw1:=xw1;oxw2:=xw2;oyw1:=yw1;oyw2:=yw2;
 twindow(1,1,80,25);
 for i:=1 to poc_pod*5 do pomoc[i,1]:=get_znak(i,24,pomoc[i,2]);
 farba(pnzalu,fnzalu);gotoxy(4,24);write('  ');
 for i:=1 to poc_pod do write(podmienky[i],'  ');
 x:=1;prvy:=true;ch:=#10;
 
 repeat
  if not(prvy) then ch:=readkey;
  farba(pnzalu,fnzalu);
  gotoxy(x*4+2,24);write(podmienky[x]);
  hlaska('',-2);
  twindow(1,1,80,25);
 
     if not(prvy) and (ch=#0) then begin
        ch:=readkey;
        case ch of
         #77: begin                      { sipka vpravo }
              x:=x+1;if x>poc_pod then x:=1;
              end;
         #75: begin                      { sipka vlavo }
              x:=x-1;if x<1 then x:=poc_pod;
              end;
         end;
        end;
 
  farba(pvzalu,fvzalu);
  gotoxy(x*4+2,24);write(podmienky[x]);
  hlaska(text_podmienky[x],-1);
  twindow(1,1,80,25);
  prvy:=false;
 until (ch=#13);
 
 for i:=1 to poc_pod*5 do put_znak(i,24,pomoc[i,2],pomoc[i,1]);
 hlaska('',-2);
 owindow(oxw1,oyw1,oxw2,oyw2);
 vyber_pod:=x
end;
 
function make_filter:integer;
var     v,i,akt:integer;
         f_base:array[1..max_viet] of string;
           okok:boolean;
       sub_find:SearchRec;
begin
 for i:=1 to max_viet do f_base[i]:=base[i];           { podmienky odloz }
 
 if s_exist('temp'+k_index,0) then prikaz('del temp'+k_index);
 prikaz('copy '+subor+k_index+' '+subor+'1'+k_index+' >nul');
 clear_all_index;
 opendbase(subor);
 
 akt:=0;
 for v:=1 to spoc do begin
     cit_vety(subor,v);
     i:=1;
     okok:=true;
     while ((formular[i].pol<>0) and (i<max_viet)) do begin
      if podmien[formular[i].pol]<>0 then
         case podmien[formular[i].pol] of
          1: if not( f_base[formular[i].pol] =  base[formular[i].pol]) then okok:=false;
          2: if pos( strs(f_base[formular[i].pol],false) ,base[formular[i].pol]) =0 then okok:=false;
          3: if not(pos( strs(f_base[formular[i].pol],false) ,base[formular[i].pol]) =0) then okok:=false;
          4: if not( f_base[formular[i].pol] >  base[formular[i].pol]) then okok:=false;
          5: if not( f_base[formular[i].pol] <  base[formular[i].pol]) then okok:=false;
          6: if not( f_base[formular[i].pol] >= base[formular[i].pol]) then okok:=false;
          7: if not( f_base[formular[i].pol] <= base[formular[i].pol]) then okok:=false;
         end;
         inc(i);
       end;
   if okok then begin
      inc(akt);indexy[akt]:=fyzvet;
      if v>=max_ind then begin
         put_all_index('temp');
         akt:=0;
         end;
      end;
   end;
 
 put_all_index('temp');
 if s_exist('temp'+k_index,1) then begin
     make_filter:=1;
     prikaz('copy temp'+k_index+' '+subor+k_index+' >nul');
     prikaz('del temp'+k_index);
     put_index('filter',1,1);
     end
    else begin
     make_filter:=0;
     if s_exist('filter'+k_index,0) then prikaz('del filter'+k_index);
     end;
end;