{ FARBA.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Definovanie farebneho rozlozenia.                                 }
{                                                                   }
{ Datum:19.06.1995                            http://www.trsek.com  }
 
function dfarba(var nazov:string;vyber:boolean;hlada:string):string;
var err:integer;
   i,ir,x,poc:integer;
    ch:char;
    index:array[1..vcisla] of integer;
    pfarba:tfarba;
    x1,y1,x2,y2:integer;
    reg:registers;
begin
  x1:=xw1;y1:=yw1;x2:=xw2;y2:=yw2;
  assign(ffa,'farba');
  {$I-}
  reset(ffa);
  err:=ioresult;
  if err<>0 then begin
     rewrite(ffa);
     err:=ioresult;
     end;
  {$I+}
  if err<>0 then begin
     open_win(10,10,70,14,'DISK ERROR',RED);
     hlaska('Chyba zapisu na disk. Pracovny disk chraneny proti zapisu.',0);
     end;
 
  for i:=1 to filesize(ffa) do begin
      seek(ffa,i-1);
      read(ffa,pfarba);
      if not(pfarba.del) then
         if hlada=pfarba.typ_far then begin
            dfarba:=pfarba.typ_far;
            close(ffa);exit;
           end;
      end;
 
  owindow(1,1,80,25);
  for i:=2 to 41 do
   for y:=2 to 23 do begin
      gotoxy(i,y);
      reg.ah:=8;
      reg.bh:=0;
      intr($10,reg);
      strana[1,i,y]:=reg.ah;
      strana[2,i,y]:=reg.al;
      end;
 
  okno(4,2,41,23,'Cislo      Farba ','ESC-Opusti ENTER-Vyber Pohyb-Sipkami',pomest);
 
  farba(pnmest,fnmest);ir:=1;
  for i:=1 to vcisla do index[i]:=0;
  for i:=1 to filesize(ffa) do begin
      seek(ffa,i-1);
      read(ffa,pfarba);
      if not(pfarba.del) then
         if ir<19 then begin
            index[ir]:=i;
            gotoxy(2,ir);write(pfarba.typ_far:6,'    ');
            ir:=ir+1;
            end;
      end;
 
  poc:=i;
  if vyber then i:=ir-1
           else i:=ir;
  if i<1 then i:=1;
  ch:=#1;x:=1;ir:=0;err:=1;
 
  repeat
   if err in [1,2] then begin if err in [1] then err:=0; end
                   else ch:=readkey;
 
   if (ch=#0) or (err=2) then begin
      farba(pnmest,fnmest);
      gotoxy(2,i);write(pfarba.typ_far:6);
      if err=2 then err:=0
               else ch:=readkey;
      case ch of
        #83:begin
            pfarba.del:=not(pfarba.del);
            if pfarba.del then hlaska(' Oznaceny na vymazanie. ',70)
                          else hlaska(' Vymazanie zrusene. ',70);
            seek(ffa,index[i+ir]-1);write(ffa,pfarba);
            end;
        #72:begin
                  i:=i-1;if i<1 then begin gotoxy(1,1);insline;i:=1;ir:=ir-1;end;
                  if ir<0 then begin ir:=0;delline;end;
            end;
        #80:begin
               if pfarba.nazov=nothing(sizeof(pfarba.nazov)-1) then
                  hlaska(' Dalej nemozes najprv vypln nazov farby',70)
                  else begin
                       i:=i+1;
                       if i>19 then begin gotoxy(1,1);delline;i:=19;ir:=ir+1;end;
                       if index[i+ir]=0 then begin
                          index[i+ir]:=filesize(ffa)+1;
                          pfarba.typ_far:=filesize(ffa)+1;
                          pfarba.nazov:=nothing(sizeof(pfarba.nazov));
                          pfarba.del:=false;
                          end;
                        end;
                       end;
        else pfarba.nazov:=tread(6,i,sizeof(pfarba.nazov)-1,pfarba.nazov,#13,#13);
        end;
      ch:=#0;
     end;
 
     if (index[i+ir]<=filesize(ffa)) and (index[i+ir]<>0) then begin
        seek(ffa,index[i+ir]-1);read(ffa,pfarba);
        end
        else begin
         if pfarba.nazov<>nothing(sizeof(pfarba.nazov)-1) then
            begin
            pfarba.typ_far:=filesize(ffa)+1;
            pfarba.del:=false;
            pfarba.nazov:=nothing(sizeof(pfarba.nazov)-1);
           end
           else index[i+ir]:=filesize(ffa)+1;
         end;
 
     farba(pnmest,fnmest);
     gotoxy(2,i);write(pfarba.typ_far:3,'-',pfarba.nazov);
     if pfarba.del then write(' DEL')
                  else write('    ');
     farba(pvmest,fvmest);gotoxy(6,i);write(pfarba.nazov);gotoxy(6,i);
 
     if (not(vyber) and (ch in ['A'..'z',#32,#13])) or (vyber and (i+ir>poc) and (ch in ['A'..'z',#32,#13])) then begin
        pfarba.nazov:=tread(6,i,sizeof(pfarba.nazov)-1,pfarba.nazov,#13,ch);
        err:=2;ch:=#80;
        farba(pvmest,fvmest);gotoxy(6,i);write(pfarba.nazov);gotoxy(6,i);
       end;
 
     if not(pfarba.nazov=nothing(sizeof(pfarba.nazov)-1)) then begin
        seek(ffa,index[i+ir]-1);write(ffa,pfarba);
        end;
     nazov:=pfarba.nazov;
   until ((ch=#27) or ((ch=#13)) );  {(vyber and (ch=#13))}
   close(ffa);
   dfarba:=pfarba.typ_far;
 
  owindow(1,1,80,25);
  for i:=2 to 41 do
  for y:=2 to 23 do begin
      gotoxy(i,y);
      reg.ah:=$9;
      reg.bh:=0;
      reg.al:=strana[2,i,y];
      reg.bl:=strana[1,i,y];
      reg.cx:=1;
      intr($10,reg);
     end;
   owindow(x1,y1,x2,y2);
end;