home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap02 / howto01 / delphi10 / drwsutl2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-10-14  |  42.8 KB  |  1,197 lines
  1. unit Drwsutl2;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ShellAPI, FileCtrl ;
  8.  
  9. type
  10.   TFileWorkBench = class( TComponent )
  11.   public
  12.     GlobalError        : Integer;  { This is used by FMXUCopyFile for er code }
  13.     GlobalErrorType    : Integer;  { This holds the Operation code            }
  14.     function ForceTrailingBackSlash( const TheFileName : String ) : String;
  15.     function StripNonRootTrailingBackSlash(
  16.               const TheFileName : String ) : String;
  17.     procedure GetFileAttributes( TheFile : String; var IsDirectory , IsArchive ,
  18.                 IsVolumeID , IsHidden , IsReadOnly , IsSysFile : Boolean );
  19.     procedure FMXUCopyFile(const FileName, DestName: String);
  20.     function CopyFile( TargetPath ,
  21.                DestinationPath : String ) : Boolean;
  22.     procedure ChangeTheDirectory( NewPath : String );
  23.     procedure ChangeTheDriveAndDirectory( NewDrive : Integer );
  24.     procedure CopyTheFile( OldPath , NewPath : String );
  25.     procedure MoveTheFile( OldPath , NewPath : String );
  26.     procedure DeleteTheFile( ThePath : String );
  27.     procedure RenameTheFile( OldPath , NewName : String );
  28.     procedure CreateNewDirectory( NewPath : String );
  29.     procedure RemoveDirectory( ThePath : String );
  30.   end;
  31.   TFileIconPanel = class( TPanel )
  32.   private
  33.     { Private declarations }
  34.     FHighlightColor : TColor;                 { This holds bright edge bevel }
  35.     FShadowColor    : TColor;                 { This holds dark edge bevel   }
  36.     procedure TheClick( Sender : TObject );   { This holds override click    }
  37.   protected                                   { event method procedure.      }
  38.     { Protected declarations }
  39.     procedure Paint; override;                { This allows custom painting  }
  40.   public
  41.     { Public declarations }
  42.     FTheIcon : TIcon;                         { This is the display icon    }
  43.     FTheName : String;                        { This is the filename        }
  44.     FTheLabel : TLabel;                       { This is the display label   }
  45.     Selected : Boolean;                       { This holds selection status }
  46.     constructor Create(AOwner : TComponent); override; { override create    }
  47.     procedure Initialize( PanelX              ,             { Left          }
  48.                           PanelY              ,             { Top           }
  49.                           PanelWidth          ,             { Width         }
  50.                           PanelHeight         ,             { Height        }
  51.                           PanelBevelWidth     ,             { Bevel Width   }
  52.                           LabelFontSize         : Integer;  { Font size     }
  53.                           PanelColor          ,             { Main color    }
  54.                           PanelHighlightColor ,             { Bright color  }
  55.                           PanelShadowColor    ,             { Dark color    }
  56.                           LabelTextColor        : TColor;   { Text color    }
  57.                           TheFilename         ,             { Filename      }
  58.                           LabelFontName         : String;   { Font name     }
  59.                           LabelFontStyle        : TFontStyles;  { Font style}
  60.                           ExtraData             : Integer       );  { Drive }
  61.     destructor Destroy; override;             { override destroy to free    }
  62.   end;
  63.   TFileIconPanelScrollBox = class( TScrollBox )
  64.   public
  65.     { Public methods and data }
  66.     TheFWB              : TFileWorkBench; { Used for file manipulation         }
  67.     IconsNeedRefreshing : Boolean;                   { Flag to redo display    }
  68.     TheIconSize        : Integer;   { Holds Individual Icon size               }
  69.     TheIconSpacing     : Integer;   { Holds total icon footprint               }
  70.     MaxIconsInARow     : Integer;   { Set for screen size.                     }
  71.     TheStoredHandle    : HWnd;
  72.     procedure Update;                                { Called to reset display }
  73.     constructor Create( AOwner : TComponent ); override;  { Override inherited }
  74.     procedure ClearTheFIPs;                          { Clears the FIPs safely  }
  75.     procedure AddDriveIcons( var XCounter , YCounter : Integer ); { Add drives }
  76.     procedure GetColorsForFileIcon( TheFile : String;
  77.                var BC , HC , SC , TC : TColor );
  78.     procedure GetIconsForEntireDirectory( TargetPath  : String );
  79.     function GetNextSelection( SourceDirectory : String;
  80.               var CurrentItem : Integer ) : String;
  81.   end;
  82.  
  83.   { This procedure spaces out the bitbtn components on a tpanel }
  84.   procedure SpacePanelButtons( WhichPanel : TPanel );
  85.   procedure GetIconForFile( TheName : String; var TheIcon : TIcon );
  86.  
  87. implementation
  88. uses DRWSUTL1;
  89. {$R DRWSUTL2.RES}                 { Import custom resource file }
  90.  
  91. { This procedure gets an icon for a file using FindExecutable  }
  92. { and ExtractIcon. (assumes file/dir is passed)                }
  93. procedure GetIconForFile( TheName : String; var TheIcon : TIcon );
  94. var TheExt           : String; { File extension holder }
  95.     TheOtherPChar  ,           { Windows ASCIIZ string }
  96.     TheResultPChar ,           { Windows ASCIIZ string }
  97.     ThePChar         : PChar;  { Windows ASCIIZ string }
  98. begin
  99.   { Check for directory and if so get directory icon from RES file }
  100.   if (( FileGetAttr( TheName ) and faDirectory ) = faDirectory ) then
  101.   begin
  102.     { Set up the PChar to communicate with Windows }
  103.     GetMem( TheOtherPChar , 255 );
  104.     { Convert Pascal-style string to ASCIIZ Pchar }
  105.     StrPCopy( TheOtherPChar , 'DIRECTORY' );
  106.     { Use API call to return icon handle of Icon Resource in FILECTRL.RES }
  107.     TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  108.     { Release memory from PChar }
  109.     FreeMem( TheOtherPChar , 255 );
  110.     { Leave }
  111.     exit;
  112.   end;
  113.   { Assume archive file; get its extension }
  114.   TheExt := Uppercase( ExtractFileExt( TheName ));
  115.   { If not an executable/image file then use FindExecutable to get icon }
  116.   if (( TheExt <> '.EXE' ) and ( TheExt <> '.BAT' ) and
  117.       ( TheExt <> '.PIF' ) and ( TheExt <> '.COM' )) then
  118.   begin
  119.     { Grab three chunks of memory }
  120.     GetMem( TheOtherPChar , 255 );
  121.     GetMem( TheResultPChar , 255 );
  122.     GetMem( ThePChar , 255 );
  123.     { Set up the name and its directory in Windows string formats }
  124.     StrPCopy( ThePChar, TheName );
  125.     StrPCopy( TheOtherPChar , ExtractFilePath( TheName ));
  126.     { Use FindExecutable API call to get path and name of owning file }
  127.     if FindExecutable( ThePChar , TheOtherPChar , TheResultPChar ) > 31 then
  128.     begin
  129.       { If get a result of 32 or more then try to get first icon of owner }
  130.       { Using ExtractIcon API call; 0 indicates first icon.               }
  131.       TheIcon.Handle := ExtractIcon( hInstance , TheResultPchar , 0 );
  132.       { If a handle is 0 then no icon in owner, get default icon from RES file }
  133.       if TheIcon.Handle = 0 then
  134.       begin
  135.         GetMem( TheOtherPChar , 255 );
  136.         StrPCopy( TheOtherPChar , 'NOICON' );
  137.         TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  138.         FreeMem( TheOtherPChar , 255 );
  139.         exit;
  140.       end;
  141.     end
  142.     else
  143.     { if no assigned executable, then get default icon from RES file }
  144.     begin
  145.       GetMem( TheOtherPChar , 255 );
  146.       StrPCopy( TheOtherPChar , 'NOICON' );
  147.       TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  148.       FreeMem( TheOtherPChar , 255 );
  149.       exit;
  150.     end;
  151.     FreeMem( TheOtherPChar , 255 );
  152.     FreeMem( TheResultPChar , 255 );
  153.     FreeMem( ThePChar , 255 );
  154.   end
  155.   else
  156.   { Assume Windows Executable file, so get icon from it with ExtractIcon API }
  157.   begin
  158.     GetMem( ThePChar , 255 );
  159.     StrPCopy( ThePChar , TheName );
  160.     { If no icons in file then get default icon (note use FFFF for -1) }
  161.     if ExtractIcon( hInstance , ThePchar , 65535 ) = 0 then
  162.     begin
  163.       Freemem( ThePChar , 255 );
  164.       GetMem( TheOtherPChar , 255 );
  165.       StrPCopy( TheOtherPChar , 'NOICON' );
  166.       TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  167.       FreeMem( TheOtherPChar , 255 );
  168.       exit;
  169.     end
  170.     else
  171.     begin
  172.       { Try to get first icon for file }
  173.       TheIcon.Handle := ExtractIcon( hInstance , ThePChar , 0 );
  174.       FreeMem( ThePChar , 255 );
  175.       { If handle is 0 invalid icon format so use default from RES file }
  176.       if TheIcon.Handle = 0 then
  177.       begin
  178.         GetMem( TheOtherPChar , 255 );
  179.         StrPCopy( TheOtherPChar , 'NOICON' );
  180.         TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  181.         FreeMem( TheOtherPChar , 255 );
  182.         exit;
  183.       end;
  184.     end;
  185.   end;
  186. end;
  187.  
  188. { This procedure spaces out the bitbtn components on a tpanel }
  189. procedure SpacePanelButtons( WhichPanel : TPanel );
  190. var TheCalculatedSpacing     ,            { Holds primary spacing }
  191.     TheFullCalculatedSpacing   : Integer; { Holds full spacing    }
  192.     Counter_1                  : Integer; { Loop counter          }
  193.     TotalIBs                   : Integer; { Gets total buttons    }
  194. begin
  195.   { Set up spacing values }
  196.   TotalIBs := WhichPanel.ControlCount;
  197.   TheCalculatedSpacing := (( WhichPanel.Width - 6 - ( TotalIbs * 49 ))
  198.    div ( TotalIbs + 1 ));
  199.   TheFullCalculatedSpacing := TheCalculatedSpacing + 49;
  200.   { Loop through all imported buttons and set their Left values }
  201.   for Counter_1 := 1 to WhichPanel.ControlCount do
  202.   begin
  203.     if Counter_1 = 1 then
  204.     begin
  205.       TBitBtn( WhichPanel.Controls[ Counter_1 - 1 ] ).Left := 3 +
  206.        TheCalculatedSpacing;
  207.     end
  208.     else
  209.     begin
  210.       TBitBtn( WhichPanel.Controls[ Counter_1 - 1 ] ).Left := 3 +
  211.        (( Counter_1 - 1 ) * TheFullCalculatedSpacing ) + TheCalculatedSpacing;
  212.     end;
  213.   end;
  214. end;
  215.  
  216. { This procedure does a fully error-trapped change directory }
  217. procedure TFileWorkBench.ChangeTheDirectory( NewPath : String );
  218. var CurrentDirectory : String;
  219. begin
  220.   if NewPath = '..' then
  221.   begin { Back up one level }
  222.     { Find the current directory }
  223.     GetDir( 0 , CurrentDirectory );
  224.     { Use EFP to move up one level }
  225.     CurrentDirectory := ExtractFilePath( CurrentDirectory );
  226.     { Strip trailing \ if not root }
  227.     CurrentDirectory := StripNonRootTrailingBackSlash( CurrentDirectory );
  228.     { Try the change to the new drive }
  229.     ChDir( CurrentDirectory );
  230.   end
  231.   else
  232.   begin { Change to explicit path }
  233.     { Get target directory path }
  234.     CurrentDirectory := NewPath;
  235.     { Strip trailing \ if not root }
  236.     CurrentDirectory := StripNonRootTrailingBackSlash( CurrentDirectory );
  237.     { Try the change to the new drive }
  238.     ChDir( CurrentDirectory );
  239.   end;
  240. end;
  241.  
  242. { This procedure does a fully error-trapped change directory }
  243. procedure TFileWorkBench.ChangeTheDriveAndDirectory( NewDrive : Integer );
  244. var CurrentDirectory : String;
  245. begin
  246.   { Find the working directory on new drive }
  247.   GetDir( NewDrive , CurrentDirectory );
  248.   { Try the change to the new drive }
  249.   ChDir( CurrentDirectory );
  250. end;
  251.  
  252. { This procedure copies a single file with error trapping }
  253. procedure TFileWorkBench.CopyTheFile( OldPath , NewPath : String );
  254. var AResult : Boolean; { Internal data flag }
  255. begin
  256.   { If Copyfile returns false an error occurred }
  257.   AResult := CopyFile( OldPath , NewPath +
  258.    ExtractFileName( OldPath ));
  259. end;
  260.  
  261. { This procedure moves a file by copying and delete it }
  262. procedure TFileWorkBench.MoveTheFile( OldPath , NewPath : String );
  263. var AResult : Boolean; { Internal data flag }
  264.     TheFile : File;    { Use to get errors  }
  265. begin
  266.   { If Copyfile returns false an error occurred }
  267.   AResult := CopyFile( OldPath , NewPath +
  268.     ExtractFileName( OldPath ));
  269.   { After valid copying, delete source file }
  270.   if AResult then
  271.   begin
  272.     DeleteFile( OldPath );
  273.   end;
  274. end;
  275.  
  276. { This procedure safely deletes a single file }
  277. procedure TFileWorkBench.DeleteTheFile( ThePath : String );
  278. begin
  279.   DeleteFile( ThePath );
  280. end;
  281.  
  282. { This procedure renames a file with full error trapping }
  283. procedure TFileWorkBench.RenameTheFile( OldPath , NewName : String );
  284. begin
  285.   RenameFile( OldPath , NewName );
  286. end;
  287.  
  288. { This procedure creates a new directory with full error trapping }
  289. procedure TFileWorkBench.CreateNewDirectory( NewPath : String );
  290. begin
  291.   Mkdir( NewPath );
  292. end;
  293.  
  294. { This procedure remove a directory with full error trapping }
  295. procedure TFileWorkBench.RemoveDirectory( ThePath : String );
  296. begin
  297.   Rmdir( ThePath );
  298. end;
  299.  
  300. { This is a generic copy routine taken from Delphi sample code }
  301. { It has been edited to return viable error codes!             }
  302. procedure TFileWorkBench.FMXUCopyFile(const FileName, DestName: String);
  303. var
  304.   CopyBuffer: Pointer; { buffer for copying }
  305.   BytesCopied: Longint;
  306.   TheAttr : Integer;
  307.   Source, Dest: Integer; { handles }
  308. const
  309.   ChunkSize: Longint = 8192; { copy in 8K chunks }
  310. begin
  311.   GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
  312.   Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
  313.   if Source < 0 then
  314.   begin  { error creating source file }
  315.     GlobalErrorType := 1;
  316.     GlobalError := -IOResult;
  317.     if GlobalError = 0 then GlobalError := -157;
  318.     FreeMem( CopyBuffer, ChunkSize );
  319.     exit;
  320.   end;
  321.   Dest := FileCreate(DestName); { create output file; overwrite existing }
  322.   if Dest < 0 then
  323.   begin  { error creating destination file }
  324.     FileClose( Source );
  325.     GlobalErrorType := 2;
  326.     GlobalError := -IOResult;
  327.     if GlobalError = 0 then GlobalError := -159;
  328.     FreeMem( CopyBuffer , ChunkSize );
  329.     exit;
  330.   end;
  331.   {$I-}
  332.   repeat
  333.     BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk}
  334.     if BytesCopied > 0 then { if we read anything... }
  335.     FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
  336.   until BytesCopied < ChunkSize; { until we run out of chunks }
  337.   {$I+}
  338.   GlobalError := -IOResult;  { get any error code which happens during copying }
  339.   FileClose(Dest); { close the destination file }
  340.   FileClose(Source); { close the source file }
  341.   FreeMem(CopyBuffer, ChunkSize); { free the buffer }
  342. end;
  343.  
  344. { This function calls the sample Copy code and handles errors }
  345. function TFileWorkBench.CopyFile( TargetPath ,
  346.           DestinationPath : String ) : Boolean;
  347. begin
  348.   { Set global error value to no error }
  349.   GlobalError := 0;
  350.   { Call the sample procedure to do the copy }
  351.   FMXUCopyFile( TargetPath, DestinationPath );
  352.   { If no error return true else return false }
  353.   if GlobalError < 0 then CopyFile := false else
  354.    CopyFile := true;
  355. end;
  356.  
  357. { This procedure sets the imported booleans to the file's attributes }
  358. procedure TFileWorkBench.GetFileAttributes( TheFile : String; var IsDirectory ,
  359.            IsArchive , IsVolumeID , IsHidden , IsReadOnly ,
  360.             IsSysFile : Boolean );
  361. var TheResult : Integer; { Traps for error code on VolumeID }
  362. begin
  363.   { Clear the imported flags for default }
  364.   IsDirectory := false;
  365.   IsArchive := false;
  366.   IsVolumeID := false;
  367.   IsHidden := False;
  368.   IsReadOnly := false;
  369.   IsSysFile := false;
  370.   { Make the Dos call }
  371.   TheResult := FileGetAttr( TheFile );
  372.   if TheResult < 0 then
  373.   begin
  374.     { Volume ID returns -2 (?) }
  375.     IsVolumeID := true;
  376.     { It has no other properties }
  377.     exit;
  378.   end;
  379.   { Use AND test to set all other properties }
  380.   if (( TheResult and faDirectory ) = faDirectory ) then IsDirectory := true;
  381.   if (( TheResult and faArchive ) = faArchive ) then IsArchive := true;
  382.   if (( TheResult and faVolumeID ) = faVolumeID ) then IsVolumeID := true;
  383.   if (( TheResult and faReadOnly ) = faReadOnly ) then IsReadOnly := true;
  384.   if (( TheResult and faHidden ) = faHidden ) then IsHidden := true;
  385.   if (( TheResult and faSysFile ) = faSysFile ) then IsSysFile := true;
  386. end;
  387.  
  388. { This function makes sure a pathname has a trailing \ }
  389. function TFileWorkBench.ForceTrailingBackSlash(
  390.           const TheFileName : String ) : String;
  391. var TempString : String;  { Used to hold function result }
  392. begin
  393.   { If no trailing \ add one (root will already have one.) }
  394.   if TheFileName[ Length( TheFileName ) ] <> '\' then
  395.    TempString := TheFileName + '\' else TempString := TheFileName;
  396.   { Return modified or non-modified string }
  397.   ForceTrailingBackslash := TempString;
  398. end;
  399.  
  400. { This function makes sure a non-root dir has no trailing \ }
  401. function TFileWorkBench.StripNonRootTrailingBackSlash(
  402.           const TheFileName : String ) : String;
  403. var TempString : String ; { Used to hold function result }
  404. begin
  405.   { Default is no change }
  406.   TempString := TheFileName;
  407.   { If not root then }
  408.   if Length( TheFileName ) > 3 then
  409.   begin
  410.     { If has a trailing backslash remove it }
  411.     if TheFileName[ Length( TheFileName )] = '\' then
  412.     begin
  413.       TempString := Copy( TheFileName , 1 ,
  414.        Length( TheFileName ) - 1 );
  415.     end;
  416.   end;
  417.   { Export the final result }
  418.   StripNonRootTrailingBackSlash := TempString;
  419. end;
  420.  
  421. { Create method for FIP                                }
  422. constructor TFileIconPanel.Create( AOwner : TComponent );
  423. begin
  424.   { call inherited -- VITAL! }
  425.   inherited Create( AOwner );
  426.   { create icon and label components, making self owner/displayer }
  427.   FTheIcon := TIcon.Create;
  428.   FTheLabel := TLabel.Create( Self );
  429.   FThelabel.Parent := Self;
  430.   { Set own and labels mouse methods to stored methods }
  431.   OnClick := TheClick;
  432.   FTheLabel.OnClick := TheClick;
  433.   { Set alignment and autosize properties of the label }
  434.   FTheLabel.Autosize := false;
  435.   FTheLabel.Alignment := taCenter;
  436.   { Set selected to false }
  437.   Selected := false;
  438. end;
  439.  
  440. { Initialization method for FIP                                         }
  441. procedure TFileIconPanel.Initialize( PanelX              ,
  442.                                      PanelY              ,
  443.                                      PanelWidth          ,
  444.                                      PanelHeight         ,
  445.                                      PanelBevelWidth     ,
  446.                                      LabelFontSize         : Integer;
  447.                                      PanelColor          ,
  448.                                      PanelHighlightColor ,
  449.                                      PanelShadowColor    ,
  450.                                      LabelTextColor        : TColor;
  451.                                      TheFilename         ,
  452.                                      LabelFontName         : String;
  453.                                      LabelFontStyle        : TFontStyles;
  454.                                      ExtraData             : Integer );
  455.  
  456. var TheLabelHeight ,             { Holder for label pixel height }
  457.     TheLabelWidth    : Integer;  { Holder for label pixel width  }
  458.     TheOtherPChar    : PChar;    { Windows ASCIIZ string         }
  459. begin
  460.   { Set the basic properties based on imported parameters }
  461.   Left := PanelX;
  462.   Top := PanelY;
  463.   Width := PanelWidth;
  464.   Height := PanelHeight;
  465.   Color := PanelColor;
  466.   BevelWidth := PanelBevelWidth;
  467.   FHighlightColor := PanelHighlightColor;
  468.   FShadowColor := PanelShadowColor;
  469.   FTheName := TheFilename;
  470.   { If the ExtraData field is non-0 then a drive is being sent in }
  471.   if ExtraData <> 0 then
  472.   begin
  473.     { Use the data field value to determine which icon to get from RES file }
  474.     case ExtraData of
  475.       1 : begin
  476.             GetMem( TheOtherPChar , 255 );
  477.             StrPCopy( TheOtherPChar , 'FLOPPY35' );
  478.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  479.             FreeMem( TheOtherPChar , 255 );
  480.           end;
  481.       2 : begin
  482.             GetMem( TheOtherPChar , 255 );
  483.             StrPCopy( TheOtherPChar , 'FIXEDHD' );
  484.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  485.             FreeMem( TheOtherPChar , 255 );
  486.           end;
  487.       3 : begin
  488.             GetMem( TheOtherPChar , 255 );
  489.             StrPCopy( TheOtherPChar , 'NETWORKHD' );
  490.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  491.             FreeMem( TheOtherPChar , 255 );
  492.           end;
  493.       4 : begin
  494.             GetMem( TheOtherPChar , 255 );
  495.             StrPCopy( TheOtherPChar , 'CDROM' );
  496.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  497.             FreeMem( TheOtherPChar , 255 );
  498.           end;
  499.       5 : begin
  500.             GetMem( TheOtherPChar , 255 );
  501.             StrPCopy( TheOtherPChar , 'RAM' );
  502.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  503.             FreeMem( TheOtherPChar , 255 );
  504.           end;
  505.     end;
  506.     { The FileNme property is already set up for the caption; use directly }
  507.     FTheLabel.Caption := TheFilename;
  508.     { Set up the hint for later use (make sure to set ShowHint) }
  509.     Hint := 'Change to ' + TheFileName;
  510.     ShowHint := true;
  511.     { Set up all imported label properties and center it for drawing }
  512.     with FTheLabel do
  513.     begin
  514.       Font.Name := LabelFontName;
  515.       Font.Size := LabelFontSize;
  516.       Font.Style := LabelFontStyle;
  517.       Font.Color := LabelTextColor;
  518.       Canvas.Brush.Color := PanelColor;
  519.       Canvas.Font := Font;
  520.       TheLabelHeight := Canvas.Textheight( Caption ) + 4;
  521.       TheLabelWidth := Canvas.Textwidth( Caption ) + 4;
  522.       Left := (( Self.Width - TheLabelWidth ) div 2 ) + 1;
  523.       Top := ((( Round( Self.Height * 0.25 ) - 6 ) - TheLabelHeight) div 2) + 1;
  524.       Top := Top + Round( Self.Height * 0.75 );
  525.       Height := TheLabelHeight;
  526.       Width := TheLabelWidth;
  527.     end;
  528.   end
  529.   else
  530.   begin
  531.     { A file or directory has been sent in; use GetIconForFile to obtain an }
  532.     { icon either from the file, its owner, or a RES file default.          }
  533.     GetIconForFile( FTheName , FTheIcon );
  534.     { Check for the Backup caption and set it specially }
  535.     if ExtractfileName( FThename ) = '..' then
  536.     begin
  537.       FTheLabel.Caption := '..';
  538.       Hint := 'Up One Level';
  539.     end
  540.     else
  541.     begin
  542.       { Otherwise just get the filename for the label caption }
  543.       { And the full path for the hint (used later.)          }
  544.       FTheLabel.caption := ExtractFileName( UpperCase( FTheName ));
  545.       Hint := FTheName;
  546.     end;
  547.     { Activate showhint so hints are seen }
  548.     ShowHint := true;
  549.     { Set label properties with imported values and center for display }
  550.     with FTheLabel do
  551.     begin
  552.       Font.Name := LabelFontName;
  553.       Font.Size := LabelFontSize;
  554.       Font.Style := LabelFontStyle;
  555.       Font.Color := LabelTextColor;
  556.       Canvas.Brush.Color := PanelColor;
  557.       Canvas.Font := Font;
  558.       TheLabelHeight := Canvas.Textheight( Caption ) + 4;
  559.       TheLabelWidth := Canvas.Textwidth( Caption ) + 4;
  560.       Left := (( Self.Width - TheLabelWidth ) div 2 ) + 1;
  561.       Top := ((( Round( Self.Height * 0.25 ) - 6 ) - TheLabelHeight) div 2) + 1;
  562.       Top := Top + Round( Self.Height * 0.75 );
  563.       Height := TheLabelHeight;
  564.       Width := TheLabelWidth;
  565.     end;
  566.   end;
  567. end;
  568.  
  569. { Destroy method for FIP }
  570. destructor TFileIconPanel.Destroy;
  571. begin
  572.   { free component resources }
  573.   FTheIcon.Free;
  574.   FTheLabel.Free;
  575.   { call inherited -- VITAL! }
  576.   inherited Destroy;
  577. end;
  578.  
  579. { TheClick method for FIP; used for event responses }
  580. procedure TFileIconPanel.TheClick( Sender : TObject );
  581. begin
  582.   { Currently ignore drive clicks }
  583.   if Pos( 'DRIVE' , FTheName ) > 0 then exit;
  584.   { Flip status of bevels }
  585.   if BevelOuter = bvRaised then BevelOuter := bvLowered else
  586.    BevelOuter := bvRaised;
  587.   { Flip selected variable }
  588.   Selected := not Selected;
  589.   { Set redisplay }
  590.   Invalidate;
  591. end;
  592.  
  593. { Paint method for FIP; overrides normal paint }
  594. procedure TFileIconPanel.Paint;
  595. var
  596.   TheOtherRect   : TRect;   { Holds clientrect   }
  597.   TopColor     ,            { Holds bright color }
  598.   BottomColor    : TColor;  { Holds dark color   }
  599.  
  600. { These methods are from Borland Intl., copyright 1995 }
  601. procedure Frame3D(    Canvas       : TCanvas;
  602.                   var TheRect      : TRect;
  603.                       TopColor   ,
  604.                       BottomColor  : TColor;
  605.                       Width        : Integer );
  606.  
  607. procedure DoRect;
  608. var
  609.   TopRight, BottomLeft: TPoint;
  610. begin
  611.   with Canvas, TheRect do
  612.   begin
  613.     TopRight.X := Right;
  614.     TopRight.Y := Top;
  615.     BottomLeft.X := Left;
  616.     BottomLeft.Y := Bottom;
  617.     Pen.Color := TopColor;
  618.     PolyLine([BottomLeft, TopLeft, TopRight]);
  619.     Pen.Color := BottomColor;
  620.     Dec(BottomLeft.X);
  621.     PolyLine([TopRight, BottomRight, BottomLeft]);
  622.   end;
  623. end;
  624.  
  625. begin
  626.   Canvas.Pen.Width := 1;
  627.   Dec(TheRect.Bottom); Dec(TheRect.Right);
  628.   while Width > 0 do
  629.   begin
  630.     Dec(Width);
  631.     DoRect;
  632.     InflateRect(TheRect, -1, -1);
  633.   end;
  634.   Inc(TheRect.Bottom); Inc(TheRect.Right);
  635. end;
  636.  
  637. procedure AdjustColors(Bevel: TPanelBevel);
  638. begin
  639.   TopColor := FHighlightColor;
  640.   if Bevel = bvLowered then TopColor := FShadowColor;
  641.   BottomColor := FShadowColor;
  642.   if Bevel = bvLowered then BottomColor := FHighlightColor;
  643. end;
  644.  
  645. { Custom code begins here }
  646. begin
  647.   { Get the rectangle of the control with API/method call }
  648.   TheOtherRect := GetClientRect;
  649.   { draw basic rectangle with basic color }
  650.   with Canvas do
  651.   begin
  652.     Brush.Color := Color;
  653.     FillRect(TheOtherRect);
  654.   end;
  655.   { Set up for top "icon" frame  and draw it with frame3d }
  656.   TheOtherRect.Right := Width;
  657.   TheOtherRect.Bottom := Round( Height * 0.75 ) - 6 ;
  658.   if BevelOuter <> bvNone then
  659.   begin
  660.     AdjustColors(BevelOuter);
  661.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  662.   end;
  663.   Frame3D(Canvas, TheOtherRect, Color, Color, BorderWidth);
  664.   if BevelInner <> bvNone then
  665.   begin
  666.     AdjustColors(BevelInner);
  667.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  668.   end;
  669.   { Do the same for the lower "label" frame }
  670.   TheOtherRect.Top := Round( Height * 0.75 ) - 5;
  671.   TheOtherRect.Left := 0;
  672.   TheOtherRect.Bottom := Height;
  673.   TheOtherRect.Right := Width;
  674.   if BevelOuter <> bvNone then
  675.   begin
  676.     AdjustColors(BevelOuter);
  677.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  678.   end;
  679.   Frame3D(Canvas, TheOtherRect, Color, Color, BorderWidth);
  680.   if BevelInner <> bvNone then
  681.   begin
  682.     AdjustColors(BevelInner);
  683.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  684.   end;
  685.   { Then draw the icon using canvas draw method }
  686.   Canvas.Draw( (( Width - 32 ) div 2 ) + 1 ,
  687.   ((( Round( Height * 0.75 ) - 6 ) - 32 ) div 2 ) + 1 , FTheIcon );
  688. end;
  689.  
  690. { This procedure clears a scrollbox of all FileIconPanels }
  691. procedure TFileIconPanelScrollbox.ClearTheFIPs;
  692. var Counter_1 : Integer;
  693.     TheComponent : TComponent;
  694. begin
  695.   { Note that must use while loop since component count continually }
  696.   { decreases as removes are made!                                  }
  697.   while ComponentCount > 0 do
  698.   begin
  699.     { Save the component as a generic TComponent }
  700.     TheComponent := Components[ 0 ];
  701.     { Call removecomponent to pull it out of the owner list for sb }
  702.     { This avoids GPF when freeing the sb.                         }
  703.     RemoveComponent( Components[ 0 ]);
  704.     { Typecast the pointer and free it to release memory and res. }
  705.     TFileIconPanel( TheComponent ).Free;
  706.   end;
  707. end;
  708.  
  709. { This procedure scans for drives and obtains their type and creates file }
  710. { icon panels to represent them.                                          }
  711. procedure TFileIconPanelScrollBox.AddDriveIcons( var XCounter ,
  712.            YCounter : Integer );
  713. type
  714.   { This if from filectrl unit; reproduce here for completeness }
  715.   TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM,
  716.                 dtRAM);
  717. var
  718.   DriveNum        : Integer;         { Used to get next drive via DOS fn   }
  719.   IconType        : Integer;         { Used to hold icon type (defacto dt) }
  720.   DriveChar       : Char;            { Used to hold drive letter           }
  721.   DriveType       : TDriveType;      { Used for set-valued drive type      }
  722.   Finished        : Boolean;         { Loop flag                           }
  723.   TheFIP          : TFileIconPanel;  { Generic FileIconPanel variable      }
  724.   ButtonColor   ,                    { Main panel color                    }
  725.   ButtonHLColor ,                    { Bright panel color                  }
  726.   ButtonSColor  ,                    { Dark panel color                    }
  727.   Textcolor       : TColor;          { Label text color                    }
  728.  
  729. { This code is from the FileCtrl Unit; copyright Borland Intl 1995      }
  730. { Check whether drive is a CD-ROM.  Returns True if MSCDEX is installed }
  731. {  and the drive is using a CD driver                                   }
  732.  
  733. function IsCDROM(DriveNum: Integer): Boolean; assembler;
  734. asm
  735.   MOV   AX,1500h { look for MSCDEX }
  736.   XOR   BX,BX
  737.   INT   2fh
  738.   OR    BX,BX
  739.   JZ    @Finish
  740.   MOV   AX,150Bh { check for using CD driver }
  741.   MOV   CX,DriveNum
  742.   INT   2fh
  743.   OR    AX,AX
  744.   @Finish:
  745. end;
  746.  
  747. { This code is from the FileCtrl Unit; copyright Borland Intl 1995      }
  748. { Check whether drive is a RAM drive.                                   }
  749. function IsRAMDrive(DriveNum: Integer): Boolean; assembler;
  750. var
  751.   TempResult: Boolean;
  752. asm
  753.   MOV   TempResult,False
  754.   PUSH  DS
  755.   MOV   BX,SS
  756.   MOV   DS,BX
  757.   SUB   SP,0200h
  758.   MOV   BX,SP
  759.   MOV   AX,DriveNum
  760.   MOV   CX,1
  761.   XOR   DX,DX
  762.   INT   25h  { read boot sector }
  763.   ADD   SP,2
  764.   JC    @ItsNot
  765.   MOV   BX,SP
  766.   CMP   BYTE PTR SS:[BX+15h],0F8h  { reverify fixed disk }
  767.   JNE   @ItsNot
  768.   CMP   BYTE PTR SS:[BX+10h],1  { check for single FAT }
  769.   JNE   @ItsNot
  770.   MOV   TempResult,True
  771.   @ItsNot:
  772.   ADD   SP,0200h
  773.   POP   DS
  774.   MOV   AL, TempResult
  775. end;
  776.  
  777. { This code is from the FileCtrl Unit; copyright Borland Intl 1995      }
  778. { Finds the type of a drive letter.                                     }
  779. function FindDriveType(DriveNum: Integer): TDriveType;
  780. begin
  781.   Result := TDriveType(GetDriveType(DriveNum));
  782.   if (Result = dtFixed) or (Result = dtNetwork) then
  783.   begin
  784.     if IsCDROM(DriveNum) then Result := dtCDROM
  785.     else if (Result = dtFixed) then
  786.     begin
  787.         { do not check for RAMDrive under Windows NT }
  788.       if ((GetWinFlags and $4000) = 0) and IsRAMDrive(DriveNum) then
  789.         Result := dtRAM;
  790.     end;
  791.   end;
  792. end;
  793.  
  794. begin
  795.   { Set the button colors to an aquamarine color scheme for drives }
  796.   ButtonColor := clTeal;
  797.   ButtonHLColor := clAqua;
  798.   ButtonSColor := clNavy;
  799.   TextColor := clblack;
  800.   { Set initial variables before looping for all drives }
  801.   finished := false;
  802.   DriveNum := 0;
  803.   while not finished do
  804.   begin
  805.     { Start with no drive found }
  806.     IconType := 0;
  807.     { Call the Borland method to get the drive info }
  808.     DriveType := FindDriveType(DriveNum);
  809.     { Set its letter and make it uppercase }
  810.     DriveChar := Chr(DriveNum + ord('a'));
  811.     DriveChar := Upcase(DriveChar);
  812.     { Assign an icon based on the drive type; if no drive exists type is nil }
  813.     case DriveType of
  814.       dtFloppy  : IconType := 1;
  815.       dtFixed   : IconType := 2;
  816.       dtNetwork : IconType := 3;
  817.       dtCDROM   : IconType := 4;
  818.       dtRAM     : IconType := 5;
  819.     end;
  820.     { Set to check next drive letter }
  821.     DriveNum := DriveNum + 1;
  822.     { But if no match then out of drives so set exit flag }
  823.     if IconType = 0 then finished := true;
  824.     { If drive was valid then set up the new FileIconPanel on the imported }
  825.     { Scrollbox                                                            }
  826.     if not finished then
  827.     begin
  828.       { Create the FileIconPanel and set its parent for memory mgmt and display}
  829.       TheFIP := TFileIconPanel.Create( Self );
  830.       TheFIP.Parent := Self;
  831.       { Call its initialize method with imported position values and the   }
  832.       { preset color scheme, a drive caption, and a minimum font. Note the }
  833.       { setting of the ExtraData field to non-zero; this signals a drive   }
  834.       { rather than a file being sent in.                                  }
  835.       TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  836.        (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize , 3 ,
  837.         7 , ButtonColor, ButtonHLColor,
  838.        ButtonSColor , TextColor , 'DRIVE ' + DriveChar + ':' , 'MS Serif' , [] ,
  839.        IconType );
  840.       { Increment the column counter; if it exceeds max move to new row      }
  841.       { Note that these are 'var' parameters and will export final position. }
  842.       XCounter := XCounter + 1;
  843.       if XCounter > MaxIconsInARow then
  844.       begin
  845.         XCounter := 1;
  846.         YCounter := YCounter + 1;
  847.       end;
  848.     end;
  849.   end;
  850. end;
  851.  
  852. { This procedure assigns colors to FIP's based on file attributes }
  853. procedure TFileIconPanelScrollBox.GetColorsForFileIcon( TheFile : String;
  854.            var BC , HC , SC , TC : TColor );
  855. var AmADir      ,             { Booleans hold file attribs }
  856.     AmAnArchive ,
  857.     AmAVolumeId ,
  858.     AmHidden    ,
  859.     AmReadOnly  ,
  860.     AmSystem      : Boolean;
  861. begin
  862.   { Make the call to internal fileworkbench to set attributes }
  863.   TheFWB.GetFileAttributes( TheFile , AmADir , AmAnArchive , AmAVolumeId ,
  864.    AmHidden , AmReadOnly , AmSystem );
  865.   { Volume ID has no subtypes }
  866.   if AmAVolumeID then
  867.   begin
  868.     BC := clOlive;
  869.     HC := clYellow;
  870.     SC := clBlack;
  871.     TC := clWhite;
  872.     exit;
  873.   end;
  874.   { Check all directory combinations }
  875.   if AmADir then
  876.   begin
  877.     BC := clNavy;
  878.     HC := clBlue;
  879.     SC := clBlack;
  880.     TC := clWhite;
  881.     if AmHidden then
  882.     begin
  883.       if AmReadOnly then
  884.       begin
  885.         if AmSystem then
  886.         begin { One HECK of a file! }
  887.           BC := clBlack;
  888.           HC := clSilver;
  889.           SC := clGray;
  890.           TC := clWhite;
  891.         end
  892.         else
  893.         begin { Dir,RO,Hid }
  894.           BC := clMaroon;
  895.           HC := clFuchsia;
  896.           SC := clGreen;
  897.           TC := clWhite;
  898.         end;
  899.       end
  900.       else
  901.       begin { Dir,Hid }
  902.         BC := clPurple;
  903.         HC := clFuchsia;
  904.         SC := clBlack;
  905.         TC := clWhite;
  906.       end;
  907.     end
  908.     else
  909.     begin
  910.       if AmReadOnly then
  911.       begin
  912.         if AmSystem then
  913.         begin { Dir,RO,Sys }
  914.           BC := clMaroon;
  915.           HC := clLime;
  916.           SC := clGreen;
  917.           TC := clWhite;
  918.         end
  919.         else
  920.         begin { Dir,RO }
  921.           BC := clGreen;
  922.           HC := clLime;
  923.           SC := clBlack;
  924.           TC := clWhite;
  925.         end;
  926.       end
  927.       else
  928.       begin
  929.         if AmSystem then
  930.         begin { Dir,Sys }
  931.           BC := clMaroon;
  932.           HC := clRed;
  933.           SC := clBlack;
  934.           TC := clWhite;
  935.         end;
  936.       end;
  937.     end;
  938.   end
  939.   else { Archive Only; check all combinations }
  940.   begin
  941.     BC := clSilver;
  942.     HC := clWhite;
  943.     SC := clGray;
  944.     TC := clBlack;
  945.     if AmHidden then
  946.     begin
  947.       if AmReadOnly then
  948.       begin
  949.         if AmSystem then
  950.         begin { Hid,RO,Sys }
  951.           BC := clRed;
  952.           HC := clLime;
  953.           SC := clPurple;
  954.           TC := clBlack;
  955.         end
  956.         else
  957.         begin { RO,Hid }
  958.           BC := clLime;
  959.           HC := clFuchsia;
  960.           SC := clMaroon;
  961.           TC := clBlack;
  962.         end;
  963.       end
  964.       else
  965.       begin { Hid }
  966.         BC := clFuchsia;
  967.         HC := clWhite;
  968.         SC := clPurple;
  969.         TC := clBlack;
  970.       end;
  971.     end
  972.     else
  973.     begin
  974.       if AmReadOnly then
  975.       begin
  976.         if AmSystem then
  977.         begin { RO,Sys }
  978.           BC := clRed;
  979.           HC := clLime;
  980.           SC := clMaroon;
  981.           TC := clBlack;
  982.         end
  983.         else
  984.         begin { RO }
  985.           BC := clLime;
  986.           HC := clWhite;
  987.           SC := clGreen;
  988.           TC := clBlack;
  989.         end;
  990.       end
  991.       else
  992.       begin
  993.         if AmSystem then
  994.         begin { System }
  995.           BC := clRed;
  996.           HC := clWhite;
  997.           SC := clMaroon;
  998.           TC := clBlack;
  999.         end;
  1000.       end;
  1001.     end;
  1002.   end;
  1003. end;
  1004.  
  1005. { This procedure gets all icons for an given directory, including drives and }
  1006. { standard subdirectories. It does not get special combinations or h/ro/sys  }
  1007. procedure TFileIconPanelScrollbox.GetIconsForEntireDirectory(
  1008.             TargetPath  : String );
  1009. var Finished        : Boolean;         { Loop flag              }
  1010.     TheSR           : TSearchRec;      { Searchrecord for FF/FN }
  1011.     TheResult       : Integer;         { return variable        }
  1012.     TempPath        : String;          { path for FF/FN         }
  1013.     TheFIP          : TFileIconPanel;  { generic FIP holder     }
  1014.     RowCounter    ,                    { position in row of FIP }
  1015.     ColumnCounter   : Integer;         { position in col of FIP }
  1016.     ButtonColor   ,                    { main panel color       }
  1017.     ButtonHLColor ,                    { bright panel color     }
  1018.     ButtonSColor  ,                    { dark panel color       }
  1019.     Textcolor       : TColor;          { label text color       }
  1020.     IsADir ,                           { Variable for file attr }
  1021.     IsAnArchive ,
  1022.     IsAVolumeID,
  1023.     IsAReadOnlyFile,
  1024.     IsAHiddenFile ,
  1025.     IsASystemFile     : Boolean;
  1026.     MaxTextLength     : Integer;       { Used to safely set size}
  1027. begin
  1028.   { hide during refresh }
  1029.   Visible := false;
  1030.   { Delete the current set, if any }
  1031.   ClearTheFIPs;
  1032.   { Get the icon sizes }
  1033.   TheFIP := TFileIconPanel.Create( Self );
  1034.   TheFIP.Parent := Self;
  1035.   TheFIP.FTheLabel.Canvas.Font.Name := 'MS Serif';
  1036.   TheFIP.FTheLabel.Canvas.Font.Size := 7;
  1037.   MaxTextLength := TheFIP.FTheLabel.Canvas.TextWidth( 'COMMAND.COM' );
  1038.   TheFIP.Free;
  1039.   TheIconSize := MaxTextLength + 13;
  1040.   TheIconSpacing := TheIconSize + 5;
  1041.   { Set up maximum icons per row based on screen size }
  1042.   MaxIconsInARow := ( Screen.Width div TheIconSpacing );
  1043.   { Set up the position counters }
  1044.   RowCounter := 1;
  1045.   ColumnCounter := 1;
  1046.   { Get the drives for the current machine }
  1047.   AddDriveIcons( ColumnCounter , RowCounter  );
  1048.   { Set up the initial variables }
  1049.   Finished := false;
  1050.   TempPath := TargetPath + '*.*';
  1051.   { Make the call to FindFirst set to get any file; will return '.' }
  1052.   { so discard it.                                                  }
  1053.   TheResult := FindFirst( TempPath , faAnyFile , TheSR );
  1054.   { loop through all files in the directory and look for directories }
  1055.   while not Finished do
  1056.   begin
  1057.     { Make call to FindNext, using only SearchRecord from FindFirst }
  1058.     TheResult := FindNext( TheSR );
  1059.     { A -1 result means no more files so exit }
  1060.     if TheResult < 0 then finished := true else
  1061.     begin
  1062.       { Otherwise check for a directory attribute }
  1063.       if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory ) =
  1064.        faDirectory ) then
  1065.       begin
  1066.         GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  1067.          ButtonHLColor , ButtonSColor , TextColor );
  1068.         { If found create a new FileIconPanel on the imported scrollbox }
  1069.         { Note sending 0 ExtraData parameter to indicate file not drive }
  1070.         TheFIP := TFileIconPanel.Create( Self );
  1071.         TheFIP.Parent := Self;
  1072.         TheFIP.Initialize((( ColumnCounter - 1 ) * TheIconSpacing ),
  1073.          (( RowCounter - 1  ) * TheIconSpacing ) , TheIconSize, TheIconSize ,
  1074.           3 , 7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor ,
  1075.            TargetPath + TheSr.Name , 'MS Serif' , [] , 0 );
  1076.         { Increment column counter and move to new row if past limit }
  1077.         ColumnCounter := ColumnCounter + 1;
  1078.         if ColumnCounter > MaxIconsInARow then
  1079.         begin
  1080.           ColumnCounter := 1;
  1081.           RowCounter := RowCounter + 1;
  1082.         end;
  1083.       end;
  1084.     end;
  1085.   end;
  1086.   { Call FindClose for Windows NT/Windows 95 compatibility }
  1087.   FindClose( TheSR );
  1088.   { Set up new initialization variables }
  1089.   Finished := false;
  1090.   TempPath := TargetPath + '*.*';
  1091.   { Make needed call to FindFirst and discard '.' }
  1092.   TheResult := FindFirst( TempPath , faAnyFile , TheSR );
  1093.   while not Finished do
  1094.   begin
  1095.     { Loop through file again, this time getting only archive files }
  1096.     TheResult := FindNext( TheSR );
  1097.     { Result of -1 indicates no more files }
  1098.     if TheResult < 0 then Finished := true else
  1099.     begin
  1100.       { If faArchive file then add new FileIconPanel }
  1101.       TheFWB.GetFileAttributes(( Targetpath + TheSR.Name ) , IsADir ,
  1102.        IsAnArchive , IsAVolumeId , IsAHiddenFile , IsAReadOnlyFile ,
  1103.         IsASystemFile );
  1104.       if (( IsAnArchive ) and ( not IsADir )) then
  1105.       begin
  1106.         GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  1107.          ButtonHLColor , ButtonSColor , TextColor );
  1108.         { Initialize new FileIconPanel and call initialize, sending 0 ED }
  1109.         TheFIP := TFileIconPanel.Create( Self );
  1110.         TheFIP.Parent := Self;
  1111.         TheFIP.Initialize((( ColumnCounter - 1 ) * TheIconSpacing ),
  1112.          (( RowCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize ,
  1113.           3 , 7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor ,
  1114.            TargetPath + TheSr.Name , 'MS Serif' , [] , 0 );
  1115.         { Increment column counter and if needed row counter }
  1116.         ColumnCounter := ColumnCounter + 1;
  1117.         if ColumnCounter > MaxIconsInARow then
  1118.         begin
  1119.           ColumnCounter := 1;
  1120.           RowCounter := RowCounter + 1;
  1121.         end;
  1122.       end;
  1123.     end;
  1124.   end;
  1125.   { Call findclose for w95 and exit }
  1126.   FindClose( TheSR );
  1127.   { Reset to visible }
  1128.   Visible := true;
  1129. end;
  1130.  
  1131. { Update method for FIPscrollbox }
  1132. procedure TFileIconPanelScrollBox.Update;
  1133. begin
  1134.   IconsNeedRefreshing := true;
  1135.   { Force a repaint }
  1136.   InvalidateRect( TheStoredHandle , nil , true );
  1137. end;
  1138.  
  1139. { Create method for FIPScrollbox }
  1140. constructor TFileIconPanelScrollBox.Create( AOwner : TComponent );
  1141. begin
  1142.   inherited Create( AOwner );
  1143.   TheFWB := TFileWorkBench.Create( Self );
  1144. end;
  1145.  
  1146. { This function returns the next selected file's name }
  1147. function TFileIconPanelScrollBox.GetNextSelection( SourceDirectory : String;
  1148.                            var CurrentItem : Integer ) : String;
  1149. var TheResult    : String;      { Holds result of function }
  1150.     TheComponent : TComponent;  { Used for typecast        }
  1151.     finished     : boolean;     { Loop control variable    }
  1152.     TheComponentCount : Integer;
  1153. begin
  1154.   TheComponentCount := ComponentCount;
  1155.   { If past end of components exit with no result }
  1156.   if CurrentItem > TheComponentCount then TheResult := '' else
  1157.   begin
  1158.     { Set loop counter and run till find match or run out }
  1159.     finished := false;
  1160.     while not finished do
  1161.     begin
  1162.       { Pull component out of the list and check it }
  1163.       TheComponent := Components[ CurrentItem - 1 ];
  1164.       { Increment counter for later }
  1165.       CurrentItem := CurrentItem + 1;
  1166.       { Do the typecast with AS }
  1167.       with TheComponent as TFileIconPanel do
  1168.       begin
  1169.         { If its selected make sure OK }
  1170.         if Selected then
  1171.         begin
  1172.           { Don't accept backup for this level of operation }
  1173.           if FTheLabel.Caption <> '..' then
  1174.           begin
  1175.             { Otherwise return the name and abort the loop }
  1176.             TheResult := FTheName;
  1177.             finished := true;
  1178.           end;
  1179.         end
  1180.         else
  1181.         begin
  1182.           { Check to see if out of components }
  1183.           if CurrentItem > TheComponentCount then
  1184.           begin
  1185.             { If so signal error and abort }
  1186.             TheResult := '';
  1187.             finished := true;
  1188.           end;
  1189.         end;
  1190.       end;
  1191.     end;
  1192.   end;
  1193.   GetNextSelection := TheResult;
  1194. end;
  1195.  
  1196. end.
  1197.