Chip 1999 September/Chip_1999-09_cd.bin/internet/Jeremy/tp/downloads/lists.pas

Pascal/Delphi Source File | 1999-08-03 | 5.1 KB | 219 lines

Unit Lists;
interface

type PSeznam = ^TSeznam;
     TSeznam = record
               Name: string[80];
               Prikaz: word;
               Text: string[80];
               nasl: PSeznam;
               pred: PSeznam;
               end;

procedure LreadItems(LName: string; LPrikaz: word; LText: string);
function ListBox(x,y: byte; LTitle: string; LMax: byte): word;

implementation
 uses crt, savewind, okna, vstupy;

 var zs, ps, ks, q: PSeznam;
     LSelect, LNormal: byte;
     LWidth: byte;
     LBuf: pbuf;
     JePrvni: boolean;

 const pr_NoCom = 0;

procedure LReadItems(LName: string; LPrikaz: word; Ltext: string);
begin
     if Jeprvni then
      begin
           new(zs);
           zs^.pred:=nil;
           zs^.nasl:=nil;
           zs^.name:=LName;
           zs^.prikaz:=LPrikaz;
           zs^.text:=LText;
           ks:=zs;
           JePrvni:=False;
      end
     else
      begin
           new(q);
           q^.Name:=LName;
           q^.Prikaz:=LPrikaz;
           q^.Text:=LText;
           ks^.nasl:=q;
           q^.pred:=ks;
           q^.nasl:=nil;
           ks:=q;
      end;
end;

procedure ListNul;
begin
     LWidth:=0;
     JePrvni:=true;
     if zs=nil then exit;
     while zs^.nasl<>nil do
      begin
           ps:=zs;
           zs:=zs^.nasl;
           dispose(ps);
      end;
     Dispose(zs);
end;

procedure LWidthLn;
var Q: byte;
begin
     Q:=0;
     ps:=zs;
     if ps=nil then exit;
     while ps^.nasl<>nil do
      begin
           if Length(ps^.name)>Q then Q:=Length(ps^.name);
           ps:=ps^.nasl;
      end;
     if Length(ps^.name)>Q then Q:=Length(ps^.name);
     LWidth:=Q;
end;

function ListBox(x,y: byte; LTitle: string; LMax: byte): word;
var
   pos: byte;
   p, kv, zv: PSeznam;
   key: char;
begin
     if zs=nil then
      begin
           ListBox:=pr_NoCom;
           ListNul;
           exit;
      end;
     LWidthLn;
     savewin(x-1,y-1,x+LWidth+1,y+Lmax, LBuf);
     wframe(x,y,x+LWidth,y+LMax-1);
     gotoxy(x+(LWidth div 2)-(Length(LTitle) div 2)-1,y-1);
     textattr:=wcTitle;
     write(' ',LTitle,' ');

     window(x,y,x+LWidth,y+LMax-1);
     textattr:=LNormal;
     clrscr;

     p:=zs;
     pos:=1;
     gotoxy(1, pos);
     write(p^.name);
     window(1,1,80,25);

     textattr:=wcText;
     gotoxy(4,23); write(infoln(p^.text));
     window(x,y,x+LWidth,y+LMax-1);
     textattr:=LNormal;

     kv:=p;
     while (P^.nasl<>nil) and (pos<Lmax) do
      begin
           p:=p^.nasl;
           inc(pos);
           gotoxy(1,pos);
           write(p^.name);
           kv:=p;
      end;
     pos:=1;
     zv:=zs;
     p:=zv;
     gotoxy(1, pos);
     Textattr:=LSelect;
     ClrEol;
     write(p^.name);
     Textattr:=LNormal;

     repeat
           key:=GetLegalKey([CR, ESC, Up, Down]);
           gotoxy(1, pos);
           ClrEol;
           write(p^.name);
           case key of
           Down:
                begin
                     if p=kv then
                      begin
                           if p<>ks then
                            begin
                                 zv:=zv^.nasl;
                                 kv:=kv^.nasl;
                                 p:=kv;
                                 gotoxy(1,1);
                                 DelLine;
                            end;
                      end
                     else
                      begin
                           p:=p^.nasl;
                           inc(pos);
                      end;
                end;
           Up:
              begin
                   if p=zv then
                    begin
                         if p<>zs then
                          begin
                               zv:=zv^.pred;
                               kv:=kv^.pred;
                               p:=zv;
                               gotoxy(1,1);
                               InsLine;
                          end;
                    end
                   else
                    begin
                         p:=p^.pred;
                         dec(pos);
                    end;
              end;
           end; {case}

           gotoxy(1, pos);
           TextAttr:=LSelect;
           ClrEol;
           write(p^.name);
           textattr:=LNormal;

           window(1,1,80,25);
           textattr:=wcText;
           gotoxy(4,23); write(infoln(p^.text));
           textattr:=LNormal;
           window(x,y,x+LWidth,y+LMax-1);

     until key in [CR, ESC];

     if key=ESC then ListBox:=pr_NoCom
      else
          ListBox:=p^.prikaz;

     window(1,1,80,25);
     Restorewin(x-1,y-1,x+LWidth+1,y+Lmax, LBuf);
     ListNul;
end;

var b: byte absolute $0000:$0449;

BEGIN
     if b<>7 then
      begin
           LSelect:=16*blue+white;
           LNormal:=16*lightgray+darkgray;
      end
     else
      begin
           LSelect:=16*black+white;
           LNormal:=16*lightgray+black;
      end;
     LWidth:=0;
     JePrvni:=true;
END.