program graphmenu;

{ Jos Dickmann (c) 1997 for public-domain }
{ Need for this demo the driver EGAVGA.BGI and for the font LITT.CHR }

uses crt,graph,dos;


const
  max_files =500;   { Max.number of files }


var
  ch                  : char;
  p,pp,q,qq,x,xx,y,yy : integer;
  number              : integer;
  s                   : string;

  filename            : string[18];
  extensie            : string[4];
  files               : array[1..max_files] of string[12];
  search              : searchrec;
  path                : string;
  page_down           : word;


procedure FILL_BAR(x,y,xx,yy :integer;color,raster :byte);

const
  soort :array[0..27] of fillpatterntype =
                   (($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff),
                    (0,$fb,$fb,$fb,0,$df,$df,$df),
                    (0,$10,$28,$44,$28,$10,0,0),
                    ($22,0,$88,0,$22,0,$88,0),
                    ($cc,$33,$cc,$33,$cc,$33,$cc,$33),
                    ($aa,$55,$aa,$55,$aa,$55,$aa,$55),
                    ($94,$84,$48,$30,0,$c1,$22,$14),
                    ($aa,$aa,$aa,$aa,$aa,$aa,$aa,$aa),
                    ($ff,0,$ff,0,$ff,0,$ff,0),
                    ($ff,$1,$7d,$45,$5d,$41,$7f,0),
                    ($01,$82,$44,$28,$10,$20,$40,$80),
                    (0,$3c,$42,$42,$42,$42,$3c,0),
                    (0,$7e,$7e,$7e,$7e,$7e,$7e,0),
                    ($81,$42,$24,$18,$18,$24,$42,$81),
                    (0,$ec,$2a,$2a,$2a,$aa,$ec,0),
                    (0,$08,$18,$3f,$3f,$18,$08,0),
                    (0,0,$7e,$42,$7e,$42,$7e,$42),
                    ($80,$7f,$41,$41,$41,$41,$41,$7f),
                    (0,$5d,$3e,$6b,$7f,$63,$36,$5d),
                    (0,0,$04,$08,$90,$a0,$c0,$f0),
                    ($92,$24,$49,$92,$24,$49,$92,$24),
                    ($b1,$22,$14,$14,$22,$91,$48,$24),
                    ($18,$3c,$3c,$7e,$7e,$3c,$3c,$18),
                    ($e7,$c3,$81,$18,$18,$81,$c3,$e7),
                    ($2,$91,$68,$8,$10,$16,$89,$40),
                    ($ff,$81,$81,$81,$81,$81,$81,$ff),
                    (0,0,$81,$81,$42,$24,$18,$18),
                    ($c3,$42,$5a,$7e,$7e,$5a,$42,$c3));
begin
  if raster < 28 then begin
    setfillpattern(soort[raster],color);
    setfillstyle(12,color);
    bar(x,y,xx,yy);
  end;
end;


procedure WRITE_TEXT(x,y :integer;text :string;bg,vg,soort,size :byte);

begin
  settextstyle(soort,0,size);
  setcolor(bg);outtextxy(x,y,text);
  setcolor(vg);outtextxy(x+1,y+1,text);
  settextstyle(0,0,0);
end;

procedure search_files;{******************************************************}

begin
  for p :=1 to max_files do files[p] :='';
  number :=1;
  findfirst(path+'*'+extensie,0,search);
  files[number] :=search.name;

  q :=length(files[number]);          { Files Without Extensies }
  for qq :=1 to q do begin            { Try the Procedure FSPLIT }
    s :=copy(files[number],qq,1);
    if s ='.' then begin
      files[number] :=copy(files[number],1,qq-1);
    end;
  end;

  while doserror =0 do begin
    inc(number);
    findnext(search);
    files[number] :=search.name;

    q :=length(files[number]);
    for qq :=1 to q do begin
      s :=copy(files[number],qq,1);
      if s ='.' then begin
        files[number] :=copy(files[number],1,qq-1);
      end;
    end;
  end;
  files[number] :='';
  dec(number);
end;

procedure file_menu;{******************************************************}

label start,start1;

begin
  search_files;    { answer = files[number] }

  page_down :=0;
  pp :=1;
  q :=number;
  if number >30 then q :=30;

  start1:

  x :=285;y :=138;
  for p :=1+(pp-1) to q+(pp-1) do begin
    write_text(x,y,files[p],0,11,2,5);
    inc(y,13);
    if y >265 then begin y :=138;inc(x,80);end;
  end;

  xx :=285;yy :=138;
  fill_bar(xx-2,yy+3,xx+65,yy+15,0,0);
  write_text(xx,yy,files[pp],0,14,2,5);

  start:

  repeat
    ch :=readkey;
  until ch in[#27,#13,#80,#72,#77,#75,#81,#73];

  { ESCAPE }
  if ch =#27 then begin
    closegraph;
    halt;
    exit;
  end;

  { ENTER }
  if ch =#13 then begin
    filename :=files[pp];
    fill_bar(285,295,400,320,8,20);

    settextstyle(2,0,6);
    setcolor(14);outtextxy(285,295,filename);
    setcolor(6);outtextxy(286,296,filename);

    goto start;
  end;

  { DOWN }
  if (ch =#80) and (yy <250) and (pp <number) then begin
    fill_bar(xx-2,yy+3,xx+65,yy+15,9,0);
    write_text(xx,yy,files[pp],0,11,2,5);
    inc(pp);
    inc(yy,13);
    fill_bar(xx-2,yy+3,xx+65,yy+15,0,0);
    write_text(xx,yy,files[pp],0,14,2,5);
    goto start;
  end;

  { UP }
  if (ch =#72) and (yy >138) then begin
    fill_bar(xx-2,yy+3,xx+65,yy+15,9,0);
    write_text(xx,yy,files[pp],0,11,2,5);
    dec(pp);
    dec(yy,13);
    fill_bar(xx-2,yy+3,xx+65,yy+15,0,0);
    write_text(xx,yy,files[pp],0,14,2,5);
    goto start;
  end;

  { TO RIGHT }
  if (ch =#77) and (xx <400) and (pp+9 <number) then begin
    fill_bar(xx-2,yy+3,xx+65,yy+15,9,0);
    write_text(xx,yy,files[pp],0,11,2,5);
    inc(pp,10);
    inc(xx,80);
    fill_bar(xx-2,yy+3,xx+65,yy+15,0,0);
    write_text(xx,yy,files[pp],0,14,2,5);
    goto start;
  end;

  { TO LEFT }
  if (ch =#75) and (xx >285) then begin
    fill_bar(xx-2,yy+3,xx+65,yy+15,9,0);
    write_text(xx,yy,files[pp],0,11,2,5);
    dec(pp,10);
    dec(xx,80);
    fill_bar(xx-2,yy+3,xx+65,yy+15,0,0);
    write_text(xx,yy,files[pp],0,14,2,5);
    goto start;
  end;

  { PAGE DOWN }
  if (ch =#81) and (number >page_down+30) then begin
    fill_bar(277,135,515,275,9,0);
    pp :=page_down+31;
    inc(page_down,30);
    goto start1;
  end;

  { PAGE UP }
  if (ch =#73) and (page_down >0) then begin
    fill_bar(277,135,515,275,9,0);
    pp :=page_down-29;
    dec(page_down,30);
    goto start1;
  end;

  goto start;
end;

procedure screen;{*********************************************************}

begin
  fill_bar(0,0,639,479,8,20);
  fill_bar(280,138,532,292,0,0);      { shadow window }

  { WINDOW }
  fill_bar(270,128,522,282,7,0);
  setcolor(15);
  line(270,128,522,128);line(522,128,522,282);
  line(276,134,276,276);line(276,276,516,276);
  setcolor(8);
  line(270,128,270,282);line(270,282,522,282);
  line(276,134,516,134);line(516,134,516,276);
  fill_bar(277,135,515,275,9,0);

  setcolor(11);
  outtextxy(250,400,'ARROW KEYS / PAGEUP / PAGEDOWN = SCROLL');
  outtextxy(270,415,'ENTER = OK / ESCAPE = EXIT PROGRAM');
end;

begin
  x :=vga;
  y :=vgahi;          { 640 x 480 x 16 }
  initgraph(x,y,'f:\tp\bgi');
  path :='f:\';          { example 'TOOLS\'  }
  extensie :='.*';    { example '.PCX' }
  screen;
  file_menu;
end.