home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / menu / overdriv / dir.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  7.7 KB  |  203 lines
  1. UNIT DIR;
  2. INTERFACE
  3.  USES IOSTUFF,GETLINE,DOS,CRT;
  4.  PROCEDURE ShowDir;             {Shows the path and file directory}
  5.  PROCEDURE ChangePath;          {Lets user change path. Used with PickFile}
  6.  FUNCTION  PickFile:AnyStr;     {Pick a file with point and shoot bar cursor}
  7.  
  8. IMPLEMENTATION
  9.  
  10. CONST
  11.    MaxNoFiles = 120;             {Max files that can be displayed }
  12.  
  13.    Color1F    = Magenta;         { Foreground color - Border }
  14.    Color1B    = Black;           { Background color - Border }
  15.    Color2F    = Cyan;            { Foreground color - Files }
  16.    Color2B    = Black;           { Background color - Files }
  17.    Color3F    = Black;           { Foreground color - Bar cursor }
  18.    Color3B    = LightGray;       { Background color - Bar cursor }
  19.  
  20. TYPE
  21.    FileName = String [12];
  22.  
  23. VAR
  24.    DirFile  : Array[1..MaxNoFiles] of FileName;  {File names stored here}
  25.    NoFiles  : Integer;   {Number of files in directory}
  26.    PathNm   : AnyStr;    {Current path name e.g. c:\tp4}
  27.  
  28. {================================================================}
  29. PROCEDURE WriteFile(FN:Integer);
  30. {                                                                }
  31. { Utility routine to write a file name at the proper row,column. }
  32. {                                                                }
  33. VAR
  34.    R,C  : Integer;
  35. BEGIN
  36.    R := (FN + 5) div 6 + 3;
  37.    C := ((FN - 1) mod 6) * 13 + 3;
  38.    WriteSt(DirFile[FN],C,R);
  39. END;
  40.  
  41. {======================================================================}
  42. PROCEDURE ShowDir;
  43. {                                                                }
  44. { This procedure displays a directory of the current drive.      }
  45. {                                                                }
  46. VAR
  47.   Regs                 : Registers;
  48.   DirInfo              : SearchRec;
  49.   SaveAttr             : Byte;
  50. LABEL  GetOut;
  51. BEGIN
  52.   SaveAttr := TextAttr;
  53.   SetColor(Color1F,Color1B);         { Set Border Colors }
  54.   ClrScr;                            { Clear the display window }
  55.   Border(1,3,80,24,'');              { Draw Border }
  56.   SetColor(Color2F,Color2B);         { Set File Display Colors }
  57.   GetDir(0,Pathnm);                  { Get the current path }
  58.   GoToXY(2,2);Write(' Path: ',Pathnm);    { Write it }
  59.   FindFirst('*.*',Archive,DirInfo);  { Get the first file name }
  60.   NoFiles := 1;
  61.   While DosError = 0 do
  62.   Begin
  63.     DirFile[NoFiles] := DirInfo.Name;   { Get the rest of the file names}
  64.     WriteFile(NoFiles);                 { Store em and write em out }
  65.     FindNext(DirInfo);
  66.     NoFiles := NoFiles+1;
  67.     If NoFiles = MaxNoFiles+1 then GoTo GetOut; { Don't increment past array }
  68.   End;
  69. GetOut:
  70.   NoFiles := NoFiles-1;
  71.   TextAttr := SaveAttr;
  72. END;
  73.  
  74. {======================================================================}
  75. PROCEDURE ChangePath;
  76. {                                                                }
  77. { This procedure lets the user enter a new path name then        }
  78. { displays a directory of that path.  Used by Pickfile.          }
  79. { Can be called directly from a program but it must be proceded  }
  80. { by a call to SHOWDIR to display the files in the current path. }
  81.  
  82. VAR
  83.       TempPathnm : AnyStr;
  84.       NoError    : Boolean;
  85.       Dummy      : Char;
  86.       SaveAttr   : Byte;
  87. BEGIN
  88.    SaveAttr := TextAttr;
  89.    SetColor(Color2F,Color2B);
  90.    Repeat                   { Repeat until we get a good path }
  91.       NoError := True;
  92.       TempPathnm := GetStr(9,2,40,Pathnm);  { User enters the new Path }
  93.       If (TempPathnm <> '') and (TempPathnm <> Pathnm) then
  94.        Begin
  95.             Pathnm := TempPathnm;
  96.            {$I-}ChDir(Pathnm){$I+};        { Try to change directories }
  97.            If IOresult <> 0 Then Begin     { Whoops. Bad Path }
  98.               WriteSt('Path Error.  Hit any key to continue',1,25);
  99.               Dummy := ReadKey;
  100.               GoToXY(1,25);Clreol;
  101.               NoError := False;
  102.             End;
  103.        End;
  104.   Until NoError;
  105.   GetDir(0,Pathnm);                        { Got a good Path }
  106.   WriteSt(' Path: '+Pathnm,2,2);           { Write it out }
  107.   ShowDir;                                 { display the files }
  108.   TextAttr := SaveAttr;
  109.   END;
  110.  
  111. {======================================================================}
  112. FUNCTION PickFile:AnyStr;
  113. {                                                                }
  114. { This Function allows you to pick a file from the current       }
  115. { directory using a point and shoot (lotus 123) bar cursor.      }
  116. { You can also change the path or logged drive in the function.  }
  117. { If you hit the Esc. key a nul file name ('') is returned.      }
  118. { Only the first 120 files in the directory are displayed.       }
  119. { The function could handle more files if the array were         }
  120. { increased and scrolling logic were added.  This would be lots  }
  121. { more code for not much more utility.                           }
  122. {                                                                }
  123. CONST
  124.    LeftArrow  = #75;      { Keys recognized }
  125.    RightArrow = #77;
  126.    UpArrow    = #72;
  127.    DownArrow  = #80;
  128.    HomeKey    = #71;      { Jumps to first file }
  129.    EndKey     = #79;      { Jumps to last file }
  130.    EnterKey   = #13;      { Selects file under cursor }
  131.    EscKey     = #27;      { Aborts with nul file name }
  132.    F2         = #60;      { Allows user to change path }
  133.  
  134. VAR
  135.    ExitPickFile : Boolean;    { Exit switch }
  136.    FunctKey     : Boolean;    { true if key is a function key }
  137.    PCh          : Char;       { Key read in }
  138.    FN,LFN       : Integer;    { Current File number, Last File Number }
  139.    SaveAttr     : Byte;
  140. BEGIN
  141.    SaveAttr := TextAttr;
  142.    ExitPickFile := False;
  143.    SetColor(Color1F,Color1B);
  144.    ClrScr;
  145.    ShowDir;                   { Display the file names }
  146.  
  147.    SetColor(Color2F,Color2B);
  148.    WriteSt('Hit enter to select, Esc to abort',1,25);
  149.    WriteSt('F2 to change path',63,2);
  150.    FN := 1;                   { Set the current file number }
  151.    LFN := 1;
  152.    HideCursor;
  153.                               { Big keystroke loop until enter or esc. }
  154. Repeat
  155.    SetColor(Color2F,Color2B);
  156.    WriteFile(LFN);            { Repair the last reverse video file name }
  157.    SetColor(Color3F,Color3B);
  158.    WriteFile(FN);             { Write the new file name in reverse video }
  159.    SetColor(Color2F,Color2B);
  160.    LFN := FN;                 { Set Last file number to current file number }
  161.                      { Read a keystroke }
  162.    PCh := Readkey;
  163.    If PCh <> #0 then FunctKey := False else
  164.    Begin
  165.      FunctKey := True;
  166.      PCh := ReadKey;
  167.    End;
  168.                      { Handle function keys }
  169.    If FunctKey then Case PCh of
  170.  
  171.    UpArrow    : If FN > 6 then FN := FN-6 else Beep;
  172.    DownArrow  : If FN+6 <= NoFiles then FN := FN+6 else Beep;
  173.    RightArrow : If FN < NoFiles then FN := FN+1 else Beep;
  174.    LeftArrow  : If FN > 1 then FN := FN-1 else Beep;
  175.    HomeKey    : FN := 1;
  176.    EndKey     : FN := NoFiles;
  177.    F2         : Begin
  178.                   ChangePath;           { Change Path }
  179.                   HideCursor;           { Repair and reset }
  180.                   SetColor(Color2F,Color2B);
  181.                   WriteSt('F2 to change path',63,2);
  182.                   WriteSt('Hit enter to select, Esc to abort',1,25);
  183.                   FN := 1;              { Go back to first file }
  184.                 End;
  185.    End; {function keys}
  186.                      { Handle non function keys }
  187.    If not FunctKey then Case PCh of
  188.  
  189.    EnterKey : ExitPickFile := true;    { normal exit }
  190.    EscKey   : Begin                    { abort exit  }
  191.                PickFile := '';
  192.                TextAttr := SaveAttr;
  193.                Exit;
  194.               End;
  195.    End; {non function keys}
  196.  
  197. Until ExitPickFile;
  198.  
  199.  PickFile := DirFile[FN];           { Set the function to the selected file }
  200.  TextAttr := SaveAttr;
  201. End;
  202.  
  203. END.