home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / exec.swg / 0023_EXE Menu System.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  22.9 KB  |  611 lines
  1. {
  2. Here is a good scrolling menu bar program written in TP 5.5. The
  3. code is very clean and well commented.
  4. }
  5.  
  6. program exemenu;                                      { version 2.2 }
  7.  
  8.  
  9.  
  10. (****************************************** 1991 J.C. Kessels ****
  11.  
  12. This is freeware. No guarantees whatsoever. You may change it, use it,
  13. copy it, anything you like.
  14.  
  15.  
  16. J.C. Kessels
  17. Philips de Goedelaan 7
  18. 5615 PN  Eindhoven
  19. Netherlands
  20. ********************************************************************)
  21.  
  22.  
  23. {$M 3000,0,0}                     { No heap, or we can't use 'exec'. }
  24.  
  25.  
  26. uses dos;
  27.  
  28.  
  29.  
  30.  
  31. const
  32. (* English version: *)
  33.   StrCopyright = 'EXEMENU v2.2, 1991 J.C. Kessels';{ Name of program. }
  34.   StrBusy      = 'Busy....';                       { Program is busy message. }
  35.   StrHelp      = 'Enter=Start  ESC=Stop';         { Bottom-left help message.}
  36.   StrStart     = 'Busy starting program: ';        { Start a program message. }
  37.   { Wrong DOS version message. }
  38.   StrDos = 'Sorry, this program only works with DOS versions 3.xx and above.';
  39.   { Unrecognised error message. }
  40.   StrError     = 'EXEMENU: unrecognised error caused program termination.';
  41.   StrExit      = 'That''s it, folks!';                   { Exit message. }
  42. (* Dutch version: *)
  43. (*
  44.   StrCopyright = 'EXEMENU v2.2, 1991 J.C. Kessels';  { Naam van het programma.}
  45.   StrHelp      = 'Enter=Start  ESC=Stop';       { Bodem-links hulp boodschap.}
  46.   StrBusy      = 'Bezig....';                     { Ik ben bezig boodschap.}
  47.   { Bij het starten van een programma. }
  48.   StrStart     = 'Bezig met starten van: ';
  49.   { Foutboodschap als de DOS versie niet goed is. }
  50.   StrDos = 'Sorry, dit programma werkt slechts met DOS versie 3.xx en hoger.';
  51.   { Onbekende fout boodschap. }
  52.   StrError     = 'EXEMENU: door onbekende fout voortijdig beëindigd.';
  53.   StrExit      = 'Exemenu is geëindigd.';        { Stop EXEMENU boodschap. }
  54. *)
  55.  
  56.   DirMax = 1000;                    { Number of entries in directory array. }
  57.  
  58. type
  59.   Str90 = string[90];             { We don't need anything longer than this. }
  60.  
  61. var
  62.   VidStore : array[0..3999] of char;                 { Video screen storage. }
  63.   Dir : array[1..DirMax] of record  {The directory is loaded into this array.}
  64.     attr : byte;                                     { 1: directory, 2: file.}
  65.     name : NameStr;                              { Name of file/directory. }
  66.     ext  : ExtStr;                                { Extension of file. }
  67.     end;
  68.   DirTop  : word;                        { Last active entry in Dir array. }
  69.   DirHere : word;                       { Current selection in Dir array. }
  70.   DirPath   : pathstr;                { The path of the Loaded directory. }
  71.   OldPath   : PathStr;      { The current directory at startup of EXEMENU. }
  72.   BasicPath : PathStr;                { The path to the basic interpreter. }
  73.   OldCursor : word;                                  { Saved cursor shape. }
  74.   xy     : word;                                  { Cursor on the screen. }
  75.   colour : byte;                                 { Colour for the screen. }
  76.   vidseg : word;                              { Segment of the screen RAM. }
  77.   regs   : registers;                        { Registers to call the BIOS. }
  78.   Inkey  : word;                                   { The last pressed key. }
  79.   keyflags : byte absolute $0040:$0017;             { BIOS keyboard flags. }
  80.   ExitSave : pointer;                         { Address of exit procedure. }
  81.   ExitMsg  : Str90;                      { Message to display when exiting. }
  82.   DTA  : SearchRec;                             { FindFirst-FindNext buffer. }
  83.  
  84. function Left(s : Str90; width : byte) : Str90;
  85. {Return Width characters from input string. Add trailing spaces if necessary.}
  86. begin
  87. if width > length(s) then Fillchar(s[length(s)+1],width-length(s),32);
  88. s[0] := chr(width);
  89. Left := s;
  90. end;
  91.  
  92. procedure FixupDir;
  93. { Fixup the DirPath string. }
  94. var
  95.   drive : char;
  96.   i, j : word;
  97. begin
  98. i := pos(':',DirPath);                   { Strip the drive from the path. }
  99. if i = 0 then
  100.   begin
  101.   if (length(Dirpath) > 0) and (Dirpath[1] = '\')
  102.     then DirPath := copy(OldPath,1,2) + DirPath
  103.     else if OldPath[length(OldPath)] = '\'
  104.       then DirPath := OldPath + DirPath
  105.       else DirPath := OldPath + '\' + DirPath;
  106.   i := pos(':',DirPath);
  107.   end;
  108. drive := DirPath[1];
  109. delete(DirPath,1,i);
  110.  
  111. while pos('..',DirPath) <> 0 do                    { Remove embedded ".." }
  112.   begin
  113.   i := pos('..',DirPath);
  114.   j := i + 2;
  115.   if i > 1 then dec(i);
  116.   if (i > 1) and (DirPath[i] = '\') then dec(i);
  117.   while (i > 1) and (DirPath[i] <> '\') do dec(i);
  118.   delete(DirPath,i,j-i);
  119.   end;
  120.  
  121. { Remove embedded ".\" }
  122. while pos('.\',DirPath) <> 0 do delete(DirPath,pos('.\',DirPath),2);
  123.  
  124. if pos('\',DirPath) = 0                        { If no subdirectories.... }
  125.   then DirPath := '\'
  126.   else
  127.     begin                          { Else strip filename from the path.... }
  128.     i := pos('.',DirPath);
  129.     if i > 0 then
  130.       begin
  131.       while (i > 0) and (DirPath[i] <> '\') do dec(i);
  132.       if i > 0
  133.         then DirPath := copy(DirPath,1,i)
  134.         else DirPath := '\';
  135.       end;
  136.     if DirPath[length(DirPath)] <> '\'       { maybe add '\' at the end.... }
  137.       then DirPath := DirPath + '\';
  138.     end;
  139.  
  140. DirPath := drive + ':' + DirPath;    { Add the drive back to the directory. }
  141.  
  142. { Translate the Dirpath into all uppercase. }
  143. for i := 1 to length(DirPath) do DirPath[i] := upcase(DirPath[i]);
  144. end;
  145.  
  146. procedure Show(s : Str90);
  147. { Display string "s" at "xy", using "colour". This routine uses DMA into the
  148.   video memory. }
  149. begin
  150. Inline(
  151.   $8E/$06/>VIDSEG/       {mov  es,[>vidseg]   ; Fetch video segment in ES.}
  152.   $8B/$3E/>XY/           {mov  di,[>xy]       ; Fetch video offset in DI.}
  153.   $8A/$26/>COLOUR/       {mov  ah,[>colour]   ; Fetch video colour in AH.}
  154.   $1E/                   {push ds             ; Setup DS to stack segment.}
  155.   $8C/$D1/               {mov  cx,ss}
  156.   $8E/$D9/               {mov  ds,cx}
  157.   $8A/$8E/>S/            {mov  cl,[bp+>s]     ; Fetch string size in CX.}
  158.   $30/$ED/               {xor  ch,ch}
  159.   $8D/$B6/>S+1/          {lea  si,[bp+>s+1]   ; Fetch string address in SI.}
  160.   $E3/$04/               {jcxz l2             ; Skip if zero length.}
  161.                          {l1:}
  162.   $AC/                   {lodsb               ; Fetch character from string.}
  163.   $AB/                   {stosw               ; Show character.}
  164.   $E2/$FC/               {loop l1             ; Next character.}
  165.                          {l2:}
  166.   $1F/                   {pop  ds             ; Restore DS.}
  167.   $89/$3E/>XY);          {mov  [>xy],di       ; Store new XY.}
  168. end;
  169.  
  170. procedure ShowMenu(Message : Str90);
  171. { Display the screen, with borders, a "Message" in line 2, and the loaded
  172.   directory in the rest of the screen. }
  173. var
  174.   i   : word;                         { Work variable. }
  175.   s   : Str90;                        { Work variable. }
  176.   pagetop : word;                     { Top of the page in the Dir array. }
  177.   row     : word;                     { The display row we are busy with. }
  178. begin
  179. xy := 0;                               { First line. }
  180. colour := $13;
  181. if length(StrCopyright) > 76
  182.   then i := 76
  183.   else i := length(StrCopyright);
  184. s[0] := chr((76 - i) div 2);
  185. Fillchar(s[1],ord(s[0]),'═');
  186. Show('╔'+s+'╡');
  187. colour := $1B;
  188. Show(copy(StrCopyright,1,i));
  189. colour := $13;
  190. s[0] := chr(76 - length(s) - length(StrCopyright));
  191. Fillchar(s[1],ord(s[0]),'═');
  192. Show('╞'+s+'╗║ ');
  193.  
  194. colour := $1E;                                 { Second line. }
  195. Show(left(Message,76));
  196.  
  197. colour := $13;                                   { Third line. }
  198. Show(' ║╟──────────────────────────────────────────────────────────────────────────────╢');
  199.  
  200. { Display all the directory entries, using the current cursor position
  201.   to calculate the top-left of the page. }
  202. pagetop := DirHere - DirHere mod 105 + 1;
  203. for i := pagetop to pagetop + 20 do
  204.   begin
  205.   colour := $13;
  206.   Show('║ ');
  207.   colour := $1E;
  208.   row := 0;
  209.   while row <= 84 do
  210.     begin
  211.     if i+row <= DirTop
  212.       then if Dir[i+row].attr = 1
  213.         then Show(left(Dir[i+row].name,14))
  214.         else Show(left(Dir[i+row].name,8) + '.' + left(Dir[i+row].ext,5))
  215.       else Show('              ');
  216.     row := row + 21;
  217.     end;
  218.   colour := $13;
  219.   Show('       ║');
  220.   end;
  221.  
  222. colour := $13;                                      { Last line. }
  223. Show('╚══╡');
  224. colour := $1B;
  225. if length(StrHelp) > 74
  226.   then i := 74
  227.   else i := length(StrHelp);
  228. Show(copy(StrHelp,1,i));
  229. colour := $13;
  230. s[0] := chr(74-i);
  231. Fillchar(s[1],ord(s[0]),'═');
  232. Show('╞'+s+'╝');
  233. end;
  234.  
  235. procedure ShowBar(here : word; onoff : boolean);
  236. { Display (onoff = true) or remove (onoff = false) the cursor bar at the screen
  237.   location that shows the "here" entry in the Dir array. Every entry has a
  238.   fixed location on the screen. }
  239. var
  240.   i : word;
  241. begin
  242. i := Here mod 105 - 1;                { Calculate position on screen. }
  243. xy := 484 + (i div 21) * 28 + (i mod 21) * 160;
  244. if onoff                              { Setup the proper colour. }
  245.   then colour := $70
  246.   else colour := $1E;
  247. if Here <= DirTop                     { Display the Dir entry. }
  248.   then if Dir[Here].attr = 1
  249.     then Show(left(Dir[Here].name,12))  { Directories without a dot. }
  250.     else Show(left(Dir[Here].name,8) + '.' + left(Dir[Here].ext,3))
  251.   else Show('            ');              { Empty entries. }
  252. colour := $1E;                            { Reset the colour. }
  253. end;
  254.  
  255. procedure InitVideo;
  256. { Initialise the video. If not 80x25 then switch to it. Store the screen.
  257.   Hide the cursor. }
  258. var
  259.   i : byte;
  260. begin
  261. regs.ah := $0F;            { If not text mode 3 or 7, then switch to it. }
  262. intr($10,regs);
  263. i := regs.al and $7F;
  264. regs.ah := $03;            { Save current cursor shape. BH is active page. }
  265. intr($10,regs);
  266. OldCursor := regs.cx;
  267. if (i <> 3) and (i <> 7) then
  268.   begin
  269.   regs.al := 3;
  270.   regs.ah := 0;
  271.   intr($10,regs);
  272.   i := 3;
  273.   end;
  274.  
  275. if i <> 7                          { Compute video segment. }
  276.   then vidseg := $B800 + (memw[$0040:$004E] shr 4)
  277.   else vidseg := $B000 + (memw[$0040:$004E] shr 4);
  278.  
  279. move(mem[vidseg:0],VidStore[0],4000);   { Store current screen. }
  280.  
  281. regs.cx := $2000;                        { Hide cursor. }
  282. regs.ah := 1;
  283. intr($10,regs);
  284.  
  285. colour := $1E;                             { Reset attribute. }
  286. xy := 0;                                   { Reset cursor. }
  287. end;
  288.  
  289. procedure ResetVideo;
  290. { Reset the video back to it's original contents. Show the cursor. }
  291. begin
  292. move(VidStore[0],mem[vidseg:0],4000);       { Restore screen. }
  293.  
  294. regs.cx := OldCursor;                       { Reset original cursor chape. }
  295. regs.ah := 1;
  296. intr($10,regs);
  297. end;
  298.  
  299. {$F+}
  300. procedure ExitCode;
  301. { Reset display upon exit. This also works for error exit's. }
  302. begin
  303. ResetVideo;                           { Reset the original display contents. }
  304. if ExitMsg <> '' then writeln(ExitMsg);    { Show exit message. }
  305. ChDir(OldPath);                            { Restore current path. }
  306. ExitProc := ExitSave;        { Reset previous exit procedure. }
  307. end;
  308. {$F-}
  309.  
  310. procedure LoadDir;
  311. { Load the "DirPath" directory into memory. }
  312. var
  313.   i    : word;                                  { Work variable. }
  314.   s    : pathstr;                               { Work variable. }
  315.   name : NameStr;                               { Name of current file. }
  316.   ext  : ExtStr;                                { Extension of current file. }
  317.   attr : byte;                                  { Attribute of current file. }
  318. begin
  319. colour := $1E;                                  { Show "busy" message. }
  320. xy := 164;
  321. Show(left(StrBusy,76));
  322.  
  323. FixupDir;                               { Cleanup the DirPath string. }
  324. DirTop := 0;                            { Reset pointers into the Dir array.}
  325. DirHere := 1;
  326.  
  327. FindFirst(DirPath+'*.*',AnyFile,DTA);                 { Find first file. }
  328. while (DosError = 3) and (length(DirPath) > 3) do     { If path not found....}
  329.   begin
  330.   i := length(DirPath);             { then strip last directory from path. }
  331.   if i > 3 then dec(i);
  332.   while (i > 3) and (DirPath[i] <> '\') do dec(i);
  333.   DirPath := copy(DirPath,1,i);
  334.   FindFirst(DirPath+'*.*',AnyFile,DTA);                 { And try again. }
  335.   end;
  336.  
  337. while DosError = 0 do                                { For all the files. }
  338.   begin
  339.   attr := 0;
  340.   if (DTA.attr and Directory) = Directory
  341.     then
  342.       begin                                      { Setup for directories. }
  343.       name := DTA.name;
  344.       ext := '';
  345.       if DTA.name <> '.' then attr := 1;          { Ignore '.' directory. }
  346.       if DTA.name = '..' then name := '..';
  347.       end
  348.     else
  349.       begin
  350.       for i := 1 to length(DTA.name) do  { Translate filename to lowercase. }
  351.         if DTA.name[i] IN ['A'..'Z'] then
  352.           DTA.name[i] := chr(ord(DTA.name[i])+32);
  353.       i := pos('.',DTA.name);       { Split filename in name and extension. }
  354.       if i > 0
  355.         then
  356.           begin
  357.           name := copy(DTA.name,1,i-1);
  358.           ext  := copy(DTA.name,i+1,length(DTA.name)-i);
  359.           end
  360.         else
  361.           begin
  362.           name := DTA.name;
  363.           ext := '';
  364.           end;
  365.       { Ignore unrecognised extensions. }
  366.       if (ext = 'com') and (DTA.name <> 'command.com') then attr := 2;
  367.       if (ext = 'exe') and (DTA.name <> 'exemenu.exe') then attr := 2;
  368.       if (ext = 'bat') and (DTA.name <> 'autoexec.bat') then attr := 2;
  369.       if (ext = 'bas') and (BasicPath <> '') then attr := 2;
  370.       end;
  371.   { If recognised extension or directory, then load into memory. }
  372.   if attr > 0 then
  373.     begin
  374.     i := 1;
  375.     while (i <= DirTop) and         { Find location where to insert (sort). }
  376.       ((attr > Dir[i].attr) or
  377.       ((attr = Dir[i].attr) and (name > Dir[i].name)) or
  378.       ((attr = Dir[i].attr) and (name = Dir[i].name) and (ext > Dir[i].ext)))
  379.       do inc(i);
  380.     if DirTop < DirMax then inc(DirTop);
  381.     if i < DirTop then              { Move entries up, to create entry. }
  382.       move(Dir[i],Dir[i+1],sizeof(Dir[1]) * (DirTop - i));
  383.     if i <= DirMax then              { Fill the entry. }
  384.       begin
  385.       Dir[i].name := name;
  386.       Dir[i].ext  := ext;
  387.       Dir[i].attr := attr;
  388.       end;
  389.     end;
  390.   FindNext(DTA);                           { Next item. }
  391.   end;
  392.  
  393. { Analyse the results. If nothing found (maybe disk error), and if we are in a
  394.   subdirectory, then at least add the parent directory. }
  395. if (DirTop = 0) and (length(DirPath) > 3) then
  396.   begin
  397.   Dir[1].name := '..';
  398.   Dir[1].ext  := '';
  399.   Dir[1].attr := 1;
  400.   DirTop      := 1;
  401.   end;
  402.  
  403. end;
  404.  
  405. procedure ExecuteProgram;
  406. { Execute the program at "DirHere". }
  407. var
  408.   ProgramPath : pathstr;               { Path to the program to execute. }
  409. begin
  410. { Return from this subroutine if there is no program at the cursor. }
  411. if (DirHere < 1) or (DirHere > DirTop) or (Dir[DirHere].attr <> 2) then exit;
  412.  
  413. colour := $1E;                           { Show "busy" message. }
  414. xy := 164;
  415. Show(left(StrBusy,76));
  416.  
  417. { Setup path to the program. }
  418. ProgramPath := DirPath + Dir[DirHere].name + '.' + Dir[DirHere].ext;
  419.  
  420. FindFirst(ProgramPath,AnyFile,DTA); { Test if the path to the program exists. }
  421. if DosError <> 0 then exit;                       { Exit if error. }
  422. ResetVideo;                                       { Reset the video screen. }
  423. writeln(StrStart,ProgramPath);                    { Show startup message. }
  424.  
  425. ChDir(copy(DirPath,1,length(DirPath)-1));        { Change to the directory. }
  426. SwapVectors;                                     { Start program. }
  427. if Dir[DirHere].ext = 'bat'            { .BAT files trough the COMMAND.COM. }
  428.   then Exec(getenv('COMSPEC'),'/C '+ProgramPath)
  429.   else if Dir[DirHere].ext = 'bas'     { .BAS trough the basic interpreter. }
  430.     then Exec(BasicPath,ProgramPath)
  431.     else Exec(ProgramPath,'');                { Others directly. }
  432. SwapVectors;
  433.  
  434. InitVideo;                                    { Initialise the video. }
  435. ShowMenu(StrBusy);                     { Draw screen with "busy" message. }
  436.  
  437. { Reset keyboard flags. }
  438. keyflags := keyflags and $0F;  {Capslock, Numlock, ScrollLock and Insert off.}
  439. fillchar(regs,sizeof(regs),#0);                   { Clear registers. }
  440. regs.ah := 1;                                     { Activate new setting. }
  441. intr($16,regs);
  442.  
  443. regs.ah := 1;                                    { Clear the keyboard buffer.}
  444. intr($16,regs);
  445. while (regs.flags and fzero) = 0 do
  446.   begin
  447.   regs.ah := 0;
  448.   intr($16,regs);
  449.   regs.ah := 1;
  450.   intr($16,regs);
  451.   end;
  452.  
  453. Inkey := 13;
  454. end;
  455.  
  456. var
  457.   i : word;                                            { Workvariable. }
  458.   s : Str90;                                           { Workvariable. }
  459.   OldHere, OldPageTop : word;         { Determine if cursor has moved. }
  460.  
  461. begin
  462. DirPath := '';                         { No directory loaded right now. }
  463. DirTop := 0;                           { No directory loaded right now. }
  464. ExitMsg := StrError;                   { Reset error message. }
  465. getdir(0,OldPath);                     { Save current directory. }
  466. ExitSave := ExitProc;                  { Setup exit procedure. }
  467. ExitProc := @ExitCode;
  468. InitVideo;                             { Initialise the video. }
  469. ShowMenu(StrBusy);                     { Draw screen with "busy" message. }
  470.  
  471. if lo(DosVersion) < 3 then             { Test DOS version. }
  472.   begin
  473.   ExitMsg := StrDos;
  474.   halt(1);
  475.   end;
  476.  
  477. { Determine what directory to search for programs. Default is the current
  478.   directory. Otherwise the first argument after EXEMENU is used as starting
  479.   path. }
  480. if paramcount = 0
  481.   then DirPath := OldPath
  482.   else DirPath := paramstr(1);
  483.  
  484. { Find the basic interpreter somewhere in the path. If not found, then basic
  485.   programs will not be listed. }
  486. BasicPath := Fsearch('GWBASIC.EXE',GetEnv('PATH'));
  487. if BasicPath = '' then BasicPath := Fsearch('GWBASIC.COM',GetEnv('PATH'));
  488. if BasicPath = '' then BasicPath := Fsearch('BASIC.EXE',GetEnv('PATH'));
  489. if BasicPath = '' then BasicPath := Fsearch('BASIC.COM',GetEnv('PATH'));
  490. if BasicPath = '' then BasicPath := Fsearch('BASICA.EXE',GetEnv('PATH'));
  491. if BasicPath = '' then BasicPath := Fsearch('BASICA.COM',GetEnv('PATH'));
  492. if BasicPath <> '' then BasicPath := FExpand(BasicPath);
  493.  
  494. LoadDir;                               { Load the directory into memory. }
  495. ShowMenu(DirPath);                     { Display the directory. }
  496. ShowBar(DirHere,true);                 { Highlight the current choice. }
  497.  
  498. { The main loop, exited only when the user presses ESC. }
  499. repeat
  500.   { Wait for a key to be pressed. Place the scancode in the Inkey variable. }
  501.   regs.ah := 0;
  502.   intr($16,regs);
  503.   Inkey := regs.ax;
  504.  
  505.   if lo(Inkey) = 13 then               { Process ENTER key. }
  506.     begin
  507.     ShowBar(DirHere,false);            { Remove cursor bar. }
  508.     s := '';                           { No item stored. }
  509.     { If cursor points to a program....}
  510.     if DirHere <= DirTop then if Dir[DirHere].attr = 2
  511.       then
  512.         begin
  513.         { Store the item to execute, so we can move the cursor back to it. }
  514.         s := Dir[DirHere].name + '.' + Dir[DirHere].ext;
  515.         ExecuteProgram;                { Then execute the program....}
  516.         end
  517.       else if Dir[DirHere].name <> '..'   { Else goto the directory....}
  518.         then DirPath := fexpand(DirPath+Dir[DirHere].name) + '\'
  519.         else
  520.           begin                           { Or goto the parent directory. }
  521.           i := length(DirPath) - 1;
  522.           while (i >= 1) and (DirPath[i] <> '\') do dec(i);
  523.           {Store the directory we just left, so we can move the cursor to it.}
  524.           s := copy(DirPath,i+1,length(DirPath)-i-1);
  525.           if i > 0
  526.             then DirPath := copy(DirPath,1,i)
  527.             else DirPath := '\';
  528.           end;
  529.     LoadDir;                              { Reload the directory. }
  530.     { If an item was stored, then find it, and move the cursor to it. }
  531.     if s <> '' then
  532.       begin
  533.       DirHere := 1;
  534.       if pos('.',s) = 0
  535.         then while (DirHere < DirTop) and (Dir[DirHere].name <> s) do
  536.           inc(DirHere)
  537.         else while (DirHere < DirTop) and
  538.           (Dir[DirHere].name + '.' + Dir[DirHere].ext <> s) do inc(DirHere);
  539.       if (DirHere <= DirTop) and (
  540.           ((pos('.',s) = 0) and
  541.            (Dir[DirHere].name <> s)) or
  542.           ((pos('.',s) > 0) and
  543.            (Dir[DirHere].name + '.' + Dir[DirHere].ext <> s)) )
  544.         then DirHere := 1;
  545.       end;
  546.     ShowMenu(DirPath);                    { Show the menu. }
  547.     ShowBar(DirHere,true);                { Show cursor bar. }
  548.     end;
  549.  
  550.   { Process cursor movement keys. }
  551.   OldHere := DirHere; {Remember current cursor, to determine if it has moved.}
  552.   if (Inkey = $4800) and (DirHere > 1) then dec(DirHere);        { arrow-up.}
  553.   if (Inkey = $5000) and (DirHere < DirTop) then inc(DirHere);   {arrow-down.}
  554.   if (Inkey = $4D00) or (lo(Inkey) = 9) then             {arrow-right or tab.}
  555.     if DirHere + 21 <= DirTop
  556.       then DirHere := DirHere + 21
  557.       else DirHere := DirTop;
  558.   if (Inkey = $4B00) or (Inkey = $0F00) then    { arrow-left or shift-tab. }
  559.     if DirHere > 21
  560.       then DirHere := DirHere - 21
  561.       else DirHere := 1;
  562.   if (Inkey = $5100) and (DirHere < DirTop) then                   { pgdn. }
  563.     if DirTop > 105
  564.       then if DirHere + 105 < DirTop
  565.         then DirHere := DirHere + 105
  566.         else DirHere := DirTop
  567.       else if (DirHere - 1) mod 21 = 20
  568.         then if DirHere + 21 <= DirTop
  569.           then DirHere := DirHere + 21
  570.           else DirHere := DirTop
  571.         else if DirHere - (DirHere - 1) mod 21 + 20 < DirTop
  572.           then DirHere := DirHere - (DirHere - 1) mod 21 + 20
  573.           else DirHere := DirTop;
  574.   if (Inkey = $4900) and (DirHere > 1) then                        { pgup. }
  575.     if DirTop > 105
  576.       then if DirHere > 105
  577.         then DirHere := DirHere - 105
  578.         else DirHere := 1
  579.       else if (DirHere - 1) mod 21 = 0
  580.         then if DirHere > 21
  581.           then DirHere := DirHere - 21
  582.           else DirHere := 1
  583.         else DirHere := DirHere - (DirHere - 1) mod 21;
  584.   if Inkey = $4700 then DirHere := 1;                             { home. }
  585.   if Inkey = $4F00 then DirHere := DirTop;                         { end. }
  586.   if lo(Inkey) > 31 then                      {Process a character inkey. }
  587.     begin
  588.     i := 1;
  589.     while (i <= DirTop) and (Dir[i].name[1] <> chr(lo(Inkey))) do inc(i);
  590.     if i <= DirTop then DirHere := i;
  591.     end;
  592.   if DirHere = 0 then DirHere := 1;           { Correct for empty list. }
  593.   { If the cursor has moved off the screen, then redraw the menu. }
  594.   if OldHere - OldHere mod 105 + 1 <> DirHere - DirHere mod 105 + 1 then
  595.     begin
  596.     ShowBar(OldHere,false);
  597.     ShowMenu(DirPath);
  598.     ShowBar(DirHere,true);
  599.     OldHere := DirHere;
  600.     end;
  601.   if OldHere <> DirHere then    { If the cursor has moved, then redraw it. }
  602.     begin
  603.     ShowBar(OldHere,false);
  604.     ShowBar(DirHere,true);
  605.     end;
  606.  
  607. until lo(Inkey) = 27;                             { Until ESC key pressed. }
  608.  
  609. ExitMsg := StrExit;                                   { Exit with message. }
  610. end.
  611.