home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nicol / sti_dir / sti_dir.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  10.9 KB  |  385 lines
  1. Unit STI_DIR;
  2. {$I-}
  3. interface
  4.  
  5. uses
  6.   Crt,Dos,STI_SCRF,STI_STRN;
  7.  
  8. Var
  9.   Drive       : string[3];
  10.   Search,
  11.   Path        : string;
  12.  
  13. function STI_SelectFile(X1,Y1,X2,Y2,Tcol,Pcol,Bcol,TTCol : byte; Border,Mask : string) : string;
  14.  
  15.  
  16. implementation
  17.  
  18. const
  19.   MAXDIR   =   512;
  20.  
  21. type
  22.   FileBuffer = record
  23.              Name : string[13];
  24.            end;
  25.   BigBuffer  = array[1..MAXDIR] of FileBuffer;
  26.  
  27. var
  28.   Handle      : WindowSave;
  29.   CurrentDir  : ^BigBuffer;
  30.   DirCount    : Word;
  31.  
  32. {---------------------------------------------------------------------------}
  33.  
  34. procedure GetFiles;                         { get the file in this dir      }
  35.  
  36. var
  37.   F : SearchRec;                            { used to find files            }
  38.  
  39. begin
  40.   for DirCount := 1 to MAXDIR do            { loop over buffer              }
  41.     begin
  42.       CurrentDir^[DirCount].Name := '';     { null the name                 }
  43.     end;
  44.   DirCount := 1;                            { reset dircount                }
  45.   FindFirst(Drive+Path+Search, AnyFile, F); { find any file                 }
  46.   While((DosError = 0) and (DirCount < MAXDIR)) do  { loop over names       }
  47.     begin
  48.       CurrentDir^[DirCount].Name :=  F.Name;{ this is the file name         }
  49.       if F.Attr = 16 then
  50.         CurrentDir^[DirCount].Name :=
  51.     CurrentDir^[DirCount].Name + '\';   { add a \ if it's a directory   }
  52.       FindNext(F);                          { get the next file             }
  53.       Inc(DirCount);                        { increment dircount            }
  54.     end;
  55.   Dec(DirCount);                            { dircount is always too big    }
  56. end;
  57.  
  58. {---------------------------------------------------------------------------}
  59.  
  60. procedure SortFiles(L,R : Integer);         { quicksort the files           }
  61.  
  62. var
  63.   I,J  : integer;
  64.   X,Y  : FileBuffer;
  65.  
  66. begin
  67.   I := L; J := R;
  68.   X.Name := CurrentDir^[(L+R) div 2].Name;
  69.   repeat
  70.     while CurrentDir^[I].Name < X.Name do Inc(I);
  71.     while X.Name < CurrentDir^[J].Name do Dec(J);
  72.     if I <= J then
  73.     begin
  74.       Y.Name        := CurrentDir^[I].Name;
  75.       CurrentDir^[I].Name       := CurrentDir^[J].Name;
  76.       CurrentDir^[J].Name       := Y.Name;
  77.       Inc(I);
  78.       Dec(J);
  79.     end;
  80.   until I > J;
  81.   if L < J then SortFiles(L,J);
  82.   if I < R then SortFiles(I,R);
  83. end;
  84.  
  85. {---------------------------------------------------------------------------}
  86.  
  87. procedure Reset_Colors;
  88.  
  89. begin
  90.   TextColor(White);
  91.   TextReverse(NoReverse);
  92. end;
  93.  
  94. {---------------------------------------------------------------------------}
  95.  
  96. procedure PrintFiles(X1,Y1,X2,Y2,Tcol,Start : Word);
  97.  
  98. var
  99.   Loop1,Loop2 : Byte;
  100.   Count       : Word;
  101.  
  102. begin
  103.   Reset_Colors;
  104.   GotoXY(X1+2,Y1+1);
  105.   TextColor(TCol);
  106.   Write(MakeStr((X2-X1)-4,32));
  107.   GotoXY(X1+2,Y1+1);
  108.   Write(Copy('Path : '+Drive+Path+Search,1,(X2-X1)-4));
  109.   Count := 0;
  110.   for Loop2 := 1 to (Y2-Y1)-2 do
  111.     begin
  112.       for Loop1 := 1 to (X2-X1) div 15 do
  113.         begin
  114.           GotoXY(X1+((Loop1-1) * 15)+2,Y1+Loop2+1);
  115.           Write(Copy(CurrentDir^[Start+Count].Name+'               ',1,13));
  116.           if(Start+Count) <= DirCount then
  117.             Inc(Count);
  118.         end;
  119.     end;
  120. end;
  121.  
  122. {---------------------------------------------------------------------------}
  123.  
  124. function ValidDrive(InString : string) : boolean;
  125.  
  126. begin
  127.   InString := UpCaseStr(InString);
  128.   ValidDrive := ((InString[2] = ':') and (InString[1] in ['A'..'Z'])) or
  129.                   (InString = '');
  130. end;
  131.  
  132. {---------------------------------------------------------------------------}
  133.  
  134. function Select_File_Key(X1,Y1,X2,Y2,Tcol,Pcol : byte) : string;
  135.  
  136. var
  137.   X,Y    : integer;
  138.   Loop,
  139.   Select : word;
  140.   Page   : word;
  141.   inch   : char;
  142.   Dummy  : string;
  143.  
  144. begin
  145.   HiddenCursor;
  146.   X := X1+2; Y := Y1+2;
  147.   Select := 1;
  148.   Page   := 0;
  149.   inch := #0;
  150.   GetFiles;
  151.   if Dircount > 1 then SortFiles(1,DirCount);
  152.   if DirCount >= 1 then
  153.     PrintFiles(X1,Y1,X2,Y2,Tcol,1)
  154.   else
  155.     begin
  156.       Reset_Colors;
  157.       for Loop := Y1+1 to Y2-1 do
  158.         begin
  159.           gotoxy(X1+1,Loop);
  160.           write(MakeStr((X2-X1)-1,32));
  161.         end;
  162.       TextColor(TCol);
  163.       GotoXY(X1+2,Y1+1);
  164.       Write('No Files');
  165.     end;
  166.   repeat
  167.     begin
  168.       Reset_Colors;
  169.       TextColor(PCol);
  170.       GotoXY(X,Y);
  171.       Write(Copy(CurrentDir^[Select+Page].Name+'              ',1,13));
  172.       repeat until KeyPressed;
  173.       inch := ReadKey;
  174.       Reset_Colors;
  175.       TextColor(TCol);
  176.       GotoXY(X,Y);
  177.       Write(Copy(CurrentDir^[Select+Page].Name+'              ',1,13));
  178.       case UpCase(inch) of
  179.         #70  : begin
  180.          GotoXY(X1+2,Y1+1); Write(MakeStr((X2-X1)-4,32));
  181.          GotoXy(X1+2,Y1+1); Write('File : ');
  182.                  Readln(Dummy);
  183.          GotoXY(X1+2,Y1+1); Write(MakeStr((X2-X1)-4,32));
  184.                  Select_File_Key := UpCaseStr(Dummy);
  185.                  Exit;
  186.                end;
  187.         #27  : begin
  188.                  Select_File_Key := '';
  189.                  Exit;
  190.                end;
  191.     #68  : begin
  192.                  Dummy := 'QQQQ';
  193.                  while not(ValidDrive(Dummy)) do
  194.                    begin
  195.                GotoXY(X1+2,Y1+1); Write(MakeStr((X2-X1)-4,32));
  196.              GotoXy(X1+2,Y1+1); Write('Drive : ');
  197.                      Readln(Dummy);
  198.              GotoXY(X1+2,Y1+1); Write(MakeStr((X2-X1)-4,32));
  199.                      Dummy := UpCaseStr(Dummy);
  200.                    end;
  201.                  if Dummy <> '' then
  202.                    Drive := Dummy;
  203.          Path := '\';
  204.          GetFiles;
  205.          if DirCount > 1 then SortFiles(1,DirCount);
  206.          if DirCount >= 1 then
  207.                     PrintFiles(X1,Y1,X2,Y2,Tcol,1)
  208.                  else
  209.                    begin
  210.                      Reset_Colors;
  211.                      for Loop := Y1+1 to Y2-1 do
  212.                        begin
  213.                          gotoxy(X1+1,Loop);
  214.                          write(MakeStr((X2-X1)-1,32));
  215.                        end;
  216.                      TextColor(TCol);
  217.                      GotoXY(X1+2,Y1+1);
  218.                      Write('No Files');
  219.                    end;
  220.          Select := 1;
  221.          X := X1+2;
  222.          Y := Y1+2;
  223.          Page := 0;
  224.            end;
  225.         #80  : begin
  226.          GotoXY(X1+2,Y1+1); Write(MakeStr((X2-X1)-4,32));
  227.          GotoXy(X1+2,Y1+1); Write('Path : ');
  228.                  Readln(Dummy);
  229.          GotoXY(X1+2,Y1+1); Write(MakeStr((X2-X1)-4,32));
  230.          if Dummy <> '' then
  231.                    Path := UpCaseStr(Dummy);
  232.          GetFiles;
  233.          if DirCount > 1 then SortFiles(1,DirCount);
  234.          if DirCount >= 1 then
  235.                     PrintFiles(X1,Y1,X2,Y2,Tcol,1)
  236.                  else
  237.                    begin
  238.                      Reset_Colors;
  239.                      for Loop := Y1+1 to Y2-1 do
  240.                        begin
  241.                          gotoxy(X1+1,Loop);
  242.                          write(MakeStr((X2-X1)-1,32));
  243.                        end;
  244.                      TextColor(TCol);
  245.                      GotoXY(X1+2,Y1+1);
  246.                      Write('No Files');
  247.                    end;
  248.          Select := 1;
  249.          X := X1+2;
  250.          Y := Y1+2;
  251.          Page := 0;
  252.            end;
  253.         #77  : begin
  254.          GotoXY(X1+2,Y1+1); Write(MakeStr((X2-X1)-4,32));
  255.          GotoXy(X1+2,Y1+1); Write('Mask : ');
  256.                  Readln(Dummy);
  257.          GotoXY(X1+2,Y1+1); Write(MakeStr((X2-X1)-4,32));
  258.          if Dummy <> '' then
  259.                    Search := UpCaseStr(Dummy);
  260.          GetFiles;
  261.          if DirCount > 1 then SortFiles(1,DirCount);
  262.          if DirCount >= 1 then
  263.                     PrintFiles(X1,Y1,X2,Y2,Tcol,1)
  264.                  else
  265.                    begin
  266.                      Reset_Colors;
  267.                      for Loop := Y1+1 to Y2-1 do
  268.                        begin
  269.                          gotoxy(X1+1,Loop);
  270.                          write(MakeStr((X2-X1)-1,32));
  271.                        end;
  272.                      TextColor(TCol);
  273.                      GotoXY(X1+2,Y1+1);
  274.                      Write('No Files');
  275.                    end;
  276.          Select := 1;
  277.          X := X1+2;
  278.          Y := Y1+2;
  279.          Page := 0;
  280.            end;
  281.     #8   : begin                            {<-}
  282.                  Dec(X,15);
  283.                  if X < X1+2 then
  284.                    begin
  285.                      Inc(X,15);
  286.                    end
  287.                  else
  288.                    if Select + Page > 1 then
  289.                      Dec(Select);
  290.            end;
  291.     #10  : begin                            {down}
  292.                  Inc(Y);
  293.                  if (Y > Y2-1) then
  294.                    begin
  295.                      if (Page+Select+((X2-X1) div 15)) < DirCount then
  296.                        begin
  297.                          Page := Page + ((X2-X1) div 15);
  298.                          PrintFiles(X1,Y1,X2,Y2,Tcol,Page+1);
  299.                          Dec(Y);
  300.                        end
  301.                      else
  302.                        Dec(Y);
  303.                    end
  304.                  else
  305.                    if (Page + Select + ((X2-X1) div 15)) <= DirCount then
  306.                      Inc(Select,((X2-X1) div 15))
  307.                    else
  308.                      Dec(Y);
  309.            end;
  310.     #11  : begin                            {up}
  311.                  Dec(Y);
  312.                  if (Y < Y1+2) then
  313.                    begin
  314.                      if Page > 0 then
  315.                        begin
  316.                          Inc(Y);
  317.                          Page := Page - ((X2-X1) div 15);
  318.                          PrintFiles(X1,Y1,X2,Y2,Tcol,Page+1);
  319.                        end
  320.                      else
  321.                        Inc(Y);
  322.                    end
  323.                  else
  324.                    if (Page + Select) > 1 then
  325.                      Dec(Select,((X2-X1) div 15));
  326.            end;
  327.     #12  : begin                            {->}
  328.                  Inc(X,15);
  329.                  if X+15 > X2-2 then
  330.                    begin
  331.                      Dec(X,15);
  332.                    end
  333.                  else
  334.                    if Select + Page < DirCount then
  335.                      Inc(Select)
  336.                    else
  337.                      Dec(X,15);
  338.            end;
  339.       end;{case}
  340.     end;
  341.   until inch = #13;
  342.   Select_File_Key := CurrentDir^[Select+Page].Name;
  343. end;
  344.  
  345. {---------------------------------------------------------------------------}
  346.  
  347. function STI_SelectFile(X1,Y1,X2,Y2,Tcol,Pcol,Bcol,TTcol : byte; Border,Mask : string) : string;
  348.  
  349. var
  350.   SS,OldPath : string;
  351.  
  352. begin
  353.   Search := Mask;
  354.   MakeWindow(Handle,X1,Y1,X2,Y2,Tcol,Bcol,TTCol,Border,'Directory');
  355.   SS := Select_File_Key(X1,Y1,X2,Y2,Tcol,Pcol);
  356.   while pos('\',SS) <> 0 do
  357.     begin
  358.       if pos('..',SS)<>0 then
  359.     begin
  360.       Path := OldPath;
  361.     end else
  362.       if pos('.',SS)<>0 then
  363.     begin
  364.     end else
  365.     begin
  366.       OldPath := Path;
  367.       Path := Path + SS;
  368.     end;
  369.       SS := Select_File_Key(X1,Y1,X2,Y2,Tcol,Pcol);
  370.     end;
  371.   STI_SelectFile := Drive+Path+SS;
  372.   DisposeWindow(Handle);
  373. end;
  374.  
  375. {--------------------------------------------------------------------------}
  376.  
  377. begin { program body }
  378.   New(CurrentDir);
  379.   DirCount := 1;
  380.   Drive := '';
  381.   Path := '';
  382.   DirCount := 0;
  383. end.
  384.  
  385.