Delphi & Pascal (česká wiki)
{ 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;