home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue44 / HTMLmove / Dirnav.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-05-04  |  3.4 KB  |  132 lines
  1. {*******************************************************
  2.                 DirNav Component
  3.  
  4. This unit contains the code for the DirNav component.
  5.  
  6. This component implements one property,
  7.   Enabled -- if tru the component is enabled.
  8.  
  9. Three events,
  10.   BeforeNavigate -- code to execute before navigating directories.
  11.   AfterNavigate -- code to execute after navigating directories.
  12.   OnRecurse -- code to execute every time directory changes.
  13.  
  14. I tried to add an Application.ProcessMessages line in the OnRecurse
  15. method but it is too slow. Add this line to your own OnRecurse
  16. methods if you need it to break out of the loop.
  17.  
  18.                 Paul Warren
  19.        HomeGrown Software Development
  20.      (c) 1995 Langley British Columbia.
  21.               (604) 530-9097
  22.        e-mail:  hg_soft@uniserve.com
  23.   Home page: http://haven.uniserve.com/~hg_soft
  24.  
  25. ********************************************************}
  26.  
  27. unit DirNav;
  28.  
  29. {$S-,W-,R-}
  30. {$C PRELOAD}
  31.  
  32. interface
  33.  
  34. uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls, Forms, Menus,
  35.   Graphics, StdCtrls;
  36.  
  37. type
  38.   TDirNavigator = class(TComponent)
  39.   private
  40.     { Private declarations }
  41.     FEnabled: Boolean;
  42.     FBeforeNavigate: TNotifyEvent;
  43.     FAfterNavigate: TNotifyEvent;
  44.     FOnRecurse: TNotifyEvent;
  45.     procedure SetBeforeNavigate(Value: TNotifyEvent);
  46.     procedure SetAfterNavigate(Value: TNotifyEvent);
  47.     procedure SetOnRecurse(Value: TNotifyEvent);
  48.   protected
  49.     { Protected declarations }
  50.   public
  51.     { Public declarations }
  52.     constructor Create(AOwner: TComponent); override;
  53.     procedure Navigate;
  54.   published
  55.     { Published declarations }
  56.     property Enabled: Boolean read FEnabled write FEnabled default True;
  57.     property BeforeNavigate: TNotifyEvent read FBeforeNavigate write SetBeforeNavigate;
  58.     property AfterNavigate: TNotifyEvent read FAfterNavigate write SetAfterNavigate;
  59.     property OnRecurse: TNotifyEvent read FOnRecurse write SetOnRecurse;
  60.   end;
  61.  
  62. procedure Register;
  63.  
  64. implementation
  65.  
  66. {$IFDEF WIN32}
  67.   {$R DIRNAV.D32}
  68. {$ELSE}
  69.   {$R DIRNAV.D16}
  70. {$ENDIF}
  71.  
  72. { TDirNavigator }
  73. constructor TDirNavigator.Create(AOwner: TComponent);
  74. begin
  75.   inherited Create(AOwner);
  76.   FEnabled := True;
  77. end;
  78.  
  79. procedure TDirNavigator.SetBeforeNavigate(Value: TNotifyEvent);
  80. begin
  81.   FBeforeNavigate := Value;
  82. end;
  83.  
  84. procedure TDirNavigator.SetAfterNavigate(Value: TNotifyEvent);
  85. begin
  86.   FAfterNavigate := Value;
  87. end;
  88.  
  89. procedure TDirNavigator.SetOnRecurse(Value: TNotifyEvent);
  90. begin
  91.   FOnRecurse := Value;
  92. end;
  93.  
  94. procedure TDirNavigator.Navigate;
  95.  
  96.   procedure ReadDirectory;
  97.   var
  98.     IsFileEntry: boolean;
  99.     Sr: TSearchRec;
  100.     DosError: integer;
  101.   begin
  102.     if FEnabled then
  103.     begin
  104.       if Assigned(FOnRecurse) then FOnRecurse(Self);
  105.       DosError := FindFirst('*.*', faDirectory, Sr);
  106.       while DosError = 0 do with Sr do
  107.       begin
  108.         IsFileEntry := Name[1] <> '.';
  109.         if IsFileEntry and (Attr and faDirectory <> 0) then
  110.         begin
  111.           ChDir(Name);
  112.           ReadDirectory;
  113.           ChDir('..');
  114.         end;
  115.         DosError := FindNext(Sr);
  116.       end;
  117.     end;
  118.   end;
  119.  
  120. begin
  121.   if Assigned(FBeforeNavigate) then FBeforeNavigate(Self);
  122.   ReadDirectory;
  123.   if Assigned(FAfterNavigate) then FAfterNavigate(Self);
  124. end;
  125.  
  126. procedure Register;
  127. begin
  128.   RegisterComponents('HomeGrown', [TDirNavigator]);
  129. end;
  130.  
  131. end.
  132.