Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
{ 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;