Delphi & Pascal (česká wiki)
{ PR_ZAL.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Funkcionalita prepoctu zaluzii. Sluzi na kumulovanie zaluzii s } { rovnakymi rozmermi tak, aby sa ulahcila a zlacnila ich vyroba. } { } { Datum:19.06.1995 http://www.trsek.com } function ctrl_akt:boolean; begin if (mem[0:$417] and 4) > 0 then ctrl_akt:=true else ctrl_akt:=false; end; procedure stav_riad(plocha,pocet:double); begin twindow(53,23,78,24); farba(pozalu,fozalu); write(' Plocha =',plocha/10000:7:3,' poc=',pocet:3:0); twindow(53,23-poc_fzal,78,22); end; function prepocet(sirka,vyska:real):real; begin if (sirka=0) or (vyska=0) then begin prepocet:=0;end else if sirka*vyska<5000 then prepocet:=5000.0 else prepocet:=sirka*vyska; end; function proc_zaluz(kolka:string;olist:boolean;var in_plocha,in_pocet:double):LongInt; const subor='zaluzie.dat'; var err:integer; i,ir,x,poc:integer; ch:char; prv:boolean; index:array[1..vcisla] of integer; fza:file of tzaluz; zaluz:tzaluz; prva,akt,zani,pred:longint; begin prva:=vali(kolka);akt:=prva; twindow(53,23-poc_fzal,78,22); farba(pozalu,16); clrscr; farba(pomest,fomest); assign(fza,subor); {$I-} reset(fza); err:=ioresult; if err<>0 then begin rewrite(fza); err:=ioresult; end; {$I+} if err<>0 then begin hlaska('Chyba z pisu na disk. Pracovně disk chraneně proti z pisu.',0);exit;end; farba(pnmest,fnmest);ir:=1; in_plocha:=0;in_pocet:=0; if prva=0 then begin prva:=filesize(fza);akt:=prva; zaluz.pred:=0;zaluz.zani:=0;zaluz.farba:=nothing(farba_sir); zaluz.sirka:=0;zaluz.vyska:=0;zaluz.del:=false; seek(fza,akt);write(fza,zaluz); end else begin seek(fza,akt);read(fza,zaluz);akt:=zaluz.zani; while (zaluz.zani<>0) do begin if not(zaluz.del) then begin if ( ir<=poc_fzal ) then begin { vypisuj len prvych osem } gotoxy(2,ir);write(zaluz.sirka:6:2,' x ',zaluz.vyska:6:2,' ',zaluz.farba:farba_sir); end; in_plocha := in_plocha + prepocet(zaluz.sirka,zaluz.vyska); in_pocet:=in_pocet+1;inc(ir); end; seek(fza,akt); read(fza,zaluz); akt:=zaluz.zani; end; stav_riad(in_plocha,in_pocet); end; proc_zaluz:=prva; if olist then begin close(fza);owindow(xw1,yw1,xw2,yw2);exit;end; poc:=i;i:=1;ch:=#1;x:=0;prv:=true;ch:=#13; akt:=prva; repeat if not(prv) then begin ch:=readkey; if ctrl_akt then ch:=#27; end; if (ch=#0) or prv then begin farba(pnmest,fnmest); gotoxy(2,i);write(zaluz.sirka:6:2,' x ',zaluz.vyska:6:2,' ',zaluz.farba:farba_sir); if not(prv) then ch:=readkey; prv:=false; case ch of #83:begin { DEL } in_plocha := in_plocha - prepocet(zaluz.sirka,zaluz.vyska); in_pocet:=in_pocet-1; zaluz.del:=true;farba(pozalu,16);delline; zani:=zaluz.zani;pred:=zaluz.pred; zaluz.pred:=0;zaluz.zani:=0; seek(fza,akt);write(fza,zaluz); akt:=zani; if akt=0 then akt:=pred; if pred=0 then proc_zaluz:=zani; if akt=0 then proc_zaluz:=0; if pred<>0 then begin seek(fza,pred);read(fza,zaluz); zaluz.zani:=zani; seek(fza,pred);write(fza,zaluz); end; if zani<>0 then begin seek(fza,zani);read(fza,zaluz); zaluz.pred:=pred; seek(fza,zani);write(fza,zaluz); end; end; #72:begin x:=x-1; { sipka hore } if x<1 then begin x:=3;i:=i-1; if (i<1) then begin if (zaluz.pred<>0) then begin gotoxy(1,1);farba(pozalu,16);insline;i:=1; akt:=zaluz.pred; end else begin i:=1;prv:=true;ch:=#27;end; end else akt:=zaluz.pred; end; end; #80:begin x:=x+1;if x>3 then { sipka dole } if zaluz.farba=nothing(farba_sir) then begin hlaska(' Ňalej nem"§eç najprv vyplĺ farbu',70); twindow(53,23-poc_fzal,78,22); x:=3; end else begin x:=1;i:=i+1; if i>poc_fzal then begin gotoxy(1,1);farba(pozalu,16);delline;i:=poc_fzal;end; if zaluz.zani=0 then begin zaluz.zani:=filesize(fza); seek(fza,akt);write(fza,zaluz); zaluz.pred:=akt; akt:=zaluz.zani; zaluz.zani:=0; zaluz.sirka:=0; zaluz.vyska:=0; zaluz.farba:=nothing(farba_sir); zaluz.del:=false; seek(fza,akt);write(fza,zaluz); in_pocet:=in_pocet+1; end else akt:=zaluz.zani; end; end; else begin { if x=1 then zaluz.sirka:=valr(tread( 2,i,6,strr(zaluz.sirka,6),#0,ch)); if x=2 then zaluz.vyska:=valr(tread(11,i,6,strr(zaluz.vyska,6),#0,ch)); if x=3 then begin zaluz.farba:=tread(20,i,farba_sir,zaluz.farba,#0,ch); twindow(53,16,78,23); end; } ch:=#80;prv:=true; end; end; if not(prv) then ch:=#0; end; seek(fza,akt);read(fza,zaluz); { najprv odcita od globalou } in_plocha := in_plocha - prepocet(zaluz.sirka,zaluz.vyska); in_pocet:=in_pocet-1; farba(pnmest,fnmest); gotoxy(2,i);write(zaluz.sirka:6:2,' x ',zaluz.vyska:6:2,' ',zaluz.farba:farba_sir); farba(pvmest,fvmest); if x=1 then begin gotoxy( 2,i);write(zaluz.sirka:6:2);gotoxy( 2,i);end; if x=2 then begin gotoxy(11,i);write(zaluz.vyska:6:2);gotoxy(11,i);end; if x=3 then begin gotoxy(20,i);write(zaluz.farba:farba_sir);gotoxy(20,i);end; if (ch in ['0'..'9','A'..'z','-','+','.',#32,#13]) then begin if x=1 then zaluz.sirka:=valr(tread( 2,i,6,'','',#13,ch)); if x=2 then zaluz.vyska:=valr(tread(11,i,6,'','',#13,ch)); { bud hada cislo zaluzie alebo ciselnik } if x=3 then zaluz.farba:=tread(20,i,farba_sir,'','',#13,ch); ch:=#80;prv:=true; farba(pvmest,fvmest); if x=1 then begin gotoxy( 2,i);write(zaluz.sirka:6:2);gotoxy( 2,i);end; if x=2 then begin gotoxy(11,i);write(zaluz.vyska:6:2);gotoxy(11,i);end; if x=3 then begin gotoxy(20,i);write(zaluz.farba:farba_sir);gotoxy(20,i);end; end; { potom pricita ku globalom } in_plocha := in_plocha + prepocet(zaluz.sirka,zaluz.vyska); in_pocet:=in_pocet+1; stav_riad(in_plocha,in_pocet); seek(fza,akt);write(fza,zaluz); until (ch in [#27,#9]); close(fza); farba(pnmest,fnmest); gotoxy(2,i);write(zaluz.sirka:6:2,' x ',zaluz.vyska:6:2,' ',zaluz.farba:farba_sir); owindow(xw1,yw1,xw2,yw2); end;