Delphi & Pascal (česká wiki)
{ FORMUL.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Pre pracu s formularmi vo formate stanovenom v T602. } { } { Datum:19.06.1995 http://www.trsek.com } function find(s:string):integer; begin find:=0; for i:=1 to max_viet do begin if (formular[i].pol<>0) then if ( hlavy[formular[i].pol].nazov[1]=s[1] ) then if ( strs(hlavy[formular[i].pol].nazov,true)=s ) then begin find:=formular[i].pol;i:=max_viet;end; end; end; function form_find(s:string):integer; begin form_find:=0; for i:=1 to max_viet do begin if (formular[i].pol<>0) then if ( hlavy[formular[i].pol].nazov[1]=s[1] ) then if ( strs(hlavy[formular[i].pol].nazov,true)=s ) then begin form_find:=i;i:=max_viet;end; end; end; function view_frm(meno:string):integer; var f:text; i,i1,x,y,p:integer; s,sprem:string; prem:boolean; pom:formul; begin for x:=1 to max_viet do begin formular[x].x:=0;formular[x].y:=0; formular[x].pol:=0;formular[x].rkluc:=' '; end; assign(f,meno+k_form); {$I-} reset(f); {$I+} if IOResult<>0 then begin hlaska(' Neexistuje subor s formularom '+meno+k_form,0); view_frm:=0; exit; end; s:='@'; while ( not(eof(f)) and (s[1]='@')) do readln(f,s); gotoxy(1,1);prem:=false;y:=1;p:=0;sprem:=''; while ( not(eof(f)) and (y<23) ) do begin writeln; for x:=1 to length(s) do if prem then begin if s[x]<>')' then sprem:=sprem+s[x] else begin prem:=false;i:=0; while ( (i<=max_viet) and (formular[p].pol=0) ) do begin i:=i+1; formular[p].pol:=i; for i1:=1 to length(sprem) do if hlavy[i].nazov[i1]<>sprem[i1] then formular[p].pol:=0; end; sprem:=''; end; end else begin if s[x] in ['A'..'Z'] then formular[p+1].rkluc:=s[x]; if copy(s,x,3)='$(:' then begin prem:=true;x:=x+2;p:=p+1; formular[p].x:=x-2; formular[p].y:=y; end else begin gotoxy(x,y);write(s[x]);end; end; readln(f,s);prem:=false;sprem:='';y:=y+1; while (s[1]='@') do readln(f,s); end; close(f); view_frm:=1; assign(f,poradie); { Ak existuje subor poradie nacita ho } {$I-} reset(f); {$I+} if IOResult<>0 then exit; x:=1; while not(eof(f)) do begin readln(f,s);x:=x+1; y:=form_find(s); if (y<>0) and (formular[x].pol<>0) then begin pom.x:=formular[x].x; pom.y:=formular[x].y; pom.pol:=formular[x].pol; pom.rkluc:=formular[x].rkluc; formular[x].x:=formular[y].x; formular[x].y:=formular[y].y; formular[x].pol:=formular[y].pol; formular[x].rkluc:=formular[y].rkluc; formular[y].x:=pom.x; formular[y].y:=pom.y; formular[y].pol:=pom.pol; formular[y].rkluc:=pom.rkluc; end; end; close(f); end; procedure view_pol(pol:integer); var s:string; begin gotoxy(formular[pol].x,formular[pol].y); if hlavy[formular[pol].pol].typep='D' then write(ask_date(base[formular[pol].pol])) else write(base[formular[pol].pol]); gotoxy(formular[pol].x,formular[pol].y); end; function realy_find(s:string):integer; begin realy_find:=0; for i:=1 to max_viet do begin if ( hlavy[i].nazov[1]=s[1] ) then if ( strs(hlavy[i].nazov,true)=s ) then begin realy_find:=i;i:=max_viet;end; end; end; procedure quick_view_all(var c_plocha,c_pocet:double;p_zal:boolean); var i:integer; begin i:=1; for i:=1 to max_viet do if (formular[i].pol<>0) then begin gotoxy(formular[i].x,formular[i].y); if hlavy[formular[i].pol].typep='D' then write(ask_date(base[formular[i].pol])) else write(base[formular[i].pol]); end; if p_zal then i:=proc_zaluz(base[realy_find('ZALUZIA')],true,c_plocha,c_pocet); end;