home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPPAN.ZIP / PICKF.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-05-10  |  2.6 KB  |  133 lines
  1. {
  2.  
  3.     pickf.pas
  4.     5-10-90
  5.  
  6.     Copyright 1990
  7.     John W. Small
  8.     All rights reserved
  9.  
  10.     PSW / Power SoftWare
  11.     P.O. Box 10072
  12.     McLean, Virginia 22102 8072
  13.     (703) 759-3838
  14.  
  15. }
  16.  
  17. unit pickf;
  18.  
  19. interface
  20.  
  21.     uses dos, pick;
  22.  
  23.     type
  24.  
  25.         PickFile = object(PickList)
  26.             dir : DirStr;
  27.             name : NameStr;
  28.             ext : ExtStr;
  29.             constructor init(path : string);
  30.             procedure   showItem; virtual;
  31.             function    doItem : boolean; virtual;
  32.             destructor  done; virtual;
  33.             end;
  34.  
  35. implementation
  36.  
  37.  
  38.     function strcmp(var str1, str2 : string) : integer;
  39.         var i  : byte;
  40.         begin
  41.             i := 1;
  42.             while (i <= byte(str1[0])) and
  43.                 (i <= byte(str2[0])) and
  44.                 (str1[i] = str2[i]) do
  45.                 inc(i);
  46.             if i <= length(str1) then
  47.                 if i <= length(str2) then
  48.                     if byte(str1[i]) > byte(str2[i]) then
  49.                         strcmp := 1
  50.                     else
  51.                         strcmp := -1
  52.                 else
  53.                     strcmp := -1
  54.             else if i <= length(str2) then
  55.                 strcmp := 1
  56.             else
  57.                 strcmp := 0
  58.         end;
  59.  
  60.     {$F+}
  61.     function DirEntryCompare(var buf1, buf2) : integer; {$F-}
  62.         var de1 : SearchRec absolute buf1;
  63.             de2 : SearchRec absolute buf2;
  64.         begin
  65.             {$V-}
  66.             DirEntryCompare := strcmp(de1.Name,de2.Name)
  67.             {$V+}
  68.         end;
  69.  
  70.     constructor PickFile.init(path : string);
  71.         var DirEntry : SearchRec;
  72.         begin
  73.             PickList.init(sizeof(SearchRec),9,4,10,10,12,path);
  74.             title := FExpand(title);
  75.             FindFirst(title,Directory,DirEntry);
  76.             while DosError = 0 do begin
  77.                 insSort(DirEntry,DirEntryCompare);
  78.                 FindNext(DirEntry)
  79.                 end
  80.         end;
  81.  
  82.     procedure PickFile.showItem;
  83.         var DirEntryPtr : ^SearchRec;
  84.         begin
  85.             DirEntryPtr := currentD;
  86.             if ok then begin
  87.                 if DirEntryPtr^.Attr = Directory then
  88.                     crt.TextAttr := attrs^[PICK_HILITE_ATTR]
  89.                 else
  90.                     crt.TextAttr := attrs^[PICK_NORMAL_ATTR];
  91.                 write(DirEntryPtr^.Name)
  92.                 end
  93.         end;
  94.  
  95.     function  PickFile.doItem : boolean;
  96.         var DirEntry : SearchRec;
  97.         const CurDir:string[1] = '.';
  98.             ParDir:string[2] = '..';
  99.         begin
  100.             get(DirEntry);
  101.             if ok then
  102.                 if DirEntry.Attr = Directory then begin
  103.                     {$V-}
  104.                     if strcmp(DirEntry.name,CurDir) <> 0 then begin
  105.                         FSplit(title,dir,name,ext);
  106.                         if strcmp(DirEntry.name,ParDir)  = 0 then begin
  107.                             if length(dir) > 3 then
  108.                                 dir[0] := char(length(dir)-1);
  109.                             FSplit(dir,dir,name,ext);
  110.                             title := concat(dir,'*.*')
  111.                             end
  112.                         else
  113.                             title := concat(dir,DirEntry.name,'\*.*');
  114.                         clear;
  115.                         init(title)
  116.                         end;
  117.                     doItem := false
  118.                     {$V+}
  119.                     end
  120.                 else
  121.                     doItem := true
  122.             else
  123.                 doItem := false
  124.         end;
  125.  
  126.     destructor PickFile.done;
  127.         begin
  128.             PickList.done
  129.         end;
  130.  
  131.     begin
  132.     end.
  133.