ajfilebrowser.pas

FileBrowser, source code for delphi

  SysFlags  : DWORD;
begin
  FillMemory(@Result, SizeOf(Result), 0);
  with Result do begin
    ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
    try
      case GetDriveType(PChar(Value)) of
        DRIVE_UNKNOWN     : MediaType := 'Unknown';
        DRIVE_NO_ROOT_DIR : MediaType := 'NotExists';
        DRIVE_REMOVABLE   : MediaType := 'Removable';
        DRIVE_FIXED       : MediaType := 'Fixed';
        DRIVE_REMOTE      : MediaType := 'Remote';
        DRIVE_CDROM       : MediaType := 'CDROM';
        DRIVE_RAMDISK     : MediaType := 'RAMDisk';
      end; {case}
      if (Value <> 'A:\') then begin
        FreeSpace := DiskFree(ord(Value[1])-$40);
        Capacity  := DiskSize(ord(Value[1])-$40);
        GetVolumeInformation(PChar(Value), VolumeLabel, SizeOf(VolumeLabel), @Serial, DW, SysFlags, FileSystem, SizeOf(FileSystem));
      end; {if}
    finally
      SetErrorMode(ErrorMode);
    end; {try}
  end; {with}
end; {GetDiskInfo}

{--------------------------------------------------------------------------------------------------}

procedure HighlightFocusedItem(ListView : TListView);
// Highlights a focused item in a list view - if no item focused then selects the first item.
var
  Item  : TListItem;
begin
  if ListView.Visible then begin                                          // Can't do anything if it's not visible.
    with ListView do begin
      Item  := ItemFocused;                                               // Get the focused item ... and
      if (Item = nil) and (Items.Count > 0) then                          // if there isn't one and there are items
        Item  := Items[0];                                                // then pick the first one.
      if (Item <> nil) then begin                                         // If we've now got a valid item ...
        SetFocus;                                                         // Set focus on me.
        ItemFocused   := Item;                                            // Focus the item and
        Selected      := Item;                                            // select it too.
        Item.MakeVisible(true);                                           // Make sure that you can see me !
      end; {if}
    end; {with}
  end; {if}
end; {HighlightFocusedItem}

{--------------------------------------------------------------------------------------------------}
{                                       TfrmFileBrowser                                            }
{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.FormCreate(Sender : TObject);
var
  lp1 : integer;
begin
  for lp1 := 0 to 1 do begin
    fSortArrows[lp1]  := TBitmap.Create;
    case lp1 of
      0 : fSortArrows[lp1].LoadFromResourceName(hInstance, 'DOWNBITMAP');
      1 : fSortArrows[lp1].LoadFromResourceName(hInstance, 'UPBITMAP'  );
    end; {case}
  end; {for}

  pnBack.DoubleBuffered           := true;                                // Stop some of the flicker.
  pnFilename.DoubleBuffered       := true;
  edFilename.DoubleBuffered       := true;

  fajAlterMenu  := TajAlterMenu.Create(Self);                             // Create the XP menu extension object.
  fajRecentKeys                   := TajRecentKeys.Create(mnuBookmarks, fajAlterMenu, cRegFileBrowser);  // Add bookmark support.
  fajRecentKeys.OnRecentKeyClick  := RecentKeyClick;                      // Connect the event handler.
  Width         := 632;                                                   // The form kept getting resized in the
  Height        := 376;                                                   // IDE ... so set it what seems right !

  btnBookmark.Tag                 := cAddBookmark;                        // Initialize bookmark Tags.
  mnuPopBookmark.Tag              := cAddBookmark;

  for lp1 := cColName to cColAttributes do begin                          // Initialize the store for making
    fColumnSettings[lp1].DefWidth := lvFiles.Columns[lp1].Width;          // the columns visible.
    fColumnSettings[lp1].Visible  := true;
  end; {for}

  flvOldWindowProc      := lvFiles.WindowProc;                            // Exchange old window proc for new.
  lvFiles.WindowProc    := lvNewWindowProc;                               // All this to control column visibility !
  fFoldersHidden        := not mnuShowFolders.Checked;                    // Decide if folders are on view.
  fSortAscending        := true;                                          // Ascending sort.
  fColumnToSort         := cColName;                                      // Default - sort on name.
  IsPropertyEditor      := false;                                         // Not a property editor - might be later.
  lvDrives.LargeImages  := TImageList.Create(Self);                       // Create the image lists for the
  lvDrives.SmallImages  := TImageList.Create(Self);                       // system icons.
  lvFiles.LargeImages   := lvDrives.LargeImages;
  lvFiles.SmallImages   := lvDrives.SmallImages;
  GetSystemIcons;                                                         // Now go and get them !
  AddDrives;
  SetFileAttributesFilter;                                                // Set the file attributes filter.
  fFilename             := '';
  SetColumnBitmap(lvFiles.Column[0]);
end; {FormCreate}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.FormShow(Sender : TObject);
begin

  RegSubMenuSettings(mnuView, cRegPath + cRegFileBrowser, tRegRead);

  if lvDrives.Visible then
    HighlightFocusedItem(lvDrives);

  if lvFiles.Visible then
    FileFindAndSelect(lvFiles, ExtractFileName(fFilename));

  if not fIsPropertyEditor then
    SetBounds((Screen.Width - Width) div 2, (Screen.Height - Height) div 2, Width, Height);

  btnCancel.Left    := pnToolbar.Width - btnCancel.Width - 3;
  btnUpdate.Left    := btnCancel.Left  - btnUpdate.Width - 3;
  edFilename.Width  := pnFilename.Width - 8;

end; {FormShow}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.FormResize(Sender : TObject);
begin
  lvDrives.Arrange(arAlignTop);
  lvFiles.Arrange(arAlignTop);
end; {FormResize}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.FormClose(Sender : TObject; var Action : TCloseAction);
begin
  RegSubMenuSettings(mnuView, cRegPath + cRegFileBrowser, tRegWrite);
end; {FormClose}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.FormDestroy(Sender : TObject);
var
  lp1 : integer;
begin
  for lp1 := 0 to 1 do
    fSortArrows[lp1].Free;
  fajAlterMenu.Free;                                                      // Destroy the XP menu object.
  fajRecentKeys.Free;                                                     // Free bookmark support.
  lvFiles.WindowProc  := flvOldWindowProc;                                // Restore the old window proc ... blows up if we forget !
end; {FormDestroy}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.lvNewWindowProc(var Message : TMessage);        // All this to control the columns.
var
  hdn : ^THDNotify;                                                       // Notifcation parameter block.
begin
  if (Message.Msg = WM_NOTIFY) then begin                                 // Hey this could be for us !
    hdn := Pointer(Message.lParam);
    if (hdn.Item in [cColName..cColAttributes]) then begin                // One of our columns ?
      case  hdn.Hdr.code of                                               // If visible - then obey the dragging.
        HDN_BeginTrackA, HDN_BeginTrackW  : if fColumnSettings[hdn.Item].Visible then
                                              flvOldWindowProc(Message)
                                            else
                                              Message.Result  := 1;
        HDN_EndTrackA, HDN_EndTrackW      : begin                         // Update our width store.
                                              fColumnSettings[hdn.Item].DefWidth  := hdn.PItem.cxy;
                                              flvOldWindowProc(Message);
                                            end;
      else
        flvOldWindowProc(Message);                                        // Not for us after all - so pass it on.
      end; {case}
    end else
      flvOldWindowProc(Message);                                          // Neither was this one for us !
  end else
    flvOldWindowProc(Message);
end; {lvNewWindowProc}                                                    // Or this one either !


{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.SetfIsPropertyEditor(Value : boolean);
var
  lp1 : integer;
begin
  fIsPropertyEditor := Value;                                             // Hide or reveal stuff that
  mnuUpdate.Visible := fIsPropertyEditor;                                 // relates to the usage as a
  for lp1 := 0 to pred(pnToolbar.ControlCount) do                         // property editor.
    pnToolBar.Controls[lp1].Visible := (pnToolBar.Controls[lp1].Tag <> -1) or fIsPropertyEditor;
end; {SetfIsPropertyEditor}                                               // Uses tag of -1 for property editor.

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.SetfFilename(Value : string);
begin
  if (fFilename <> Value) then begin
    fFilename       := Value;
    edFilename.Text := fFilename;                                         // Display the full file name.
    UpdateFileListView(fFileMask, fFileAttributes);
  end; {if}
end; {SetfFilename}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.GetSystemIcons;
var
  SysImageList  : THandle;
  SHFileInfo    : TSHFileInfo;
begin
  with lvFiles do begin                                                   // What else - just get the icons.
    SysImageList  := SHGetFileInfo('', 0, SHFileInfo, SizeOf(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
    if (SysImageList <> 0) then begin                                     // Large ones ...
      LargeImages.Handle      := SysImageList;
      LargeImages.AddImages(imLarge);                                     // Add the icon for the parent root directory.
      LargeImages.ShareImages := true;
    end; {if}
    SysImageList  := SHGetFileInfo('', 0, SHFileInfo, SizeOf(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
    if (SysImageList <> 0) then begin                                     // Small ones ...
      SmallImages.Handle      := SysImageList;
      SmallImages.AddImages(imSmall);                                     // Add the icon for the parent root directory.
      SmallImages.ShareImages := true;
    end; {if}
    fRootIconIndex  := pred(SmallImages.Count);
  end; {with}
end; {GetSystemIcons}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.SetFileAttributesFilter;
var
  lp1 : integer;
begin
  fFileAttributes := 0;                                                   // Build up the filter mask ...
  for lp1 := 0 to pred(mnuAttributes.Count) do                            // Note that the menu tags hold
    if mnuAttributes.Items[lp1].Checked then                              // the actual masks.
      fFileAttributes := fFileAttributes or DWORD(mnuAttributes.Items[lp1].Tag);
end; {SetFileAttributesFilter}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.AddDrives;
var
  Drives  : set of 0..25;
  ShInfo  : TSHFileInfo;
  lp1     : integer;
  Drv     : string;
  DI      : TDiskInfo;
begin
  lvDrives.Items.BeginUpdate;
  lvDrives.Items.Clear;
  Integer(Drives) := GetLogicalDrives;
  for lp1 := 0 to 25 do begin
    if (lp1 in Drives) then begin
      with lvDrives.Items.Add do begin
        Drv := chr(ord('A') + lp1) + ':\';
        try
          SHGetFileInfo(PChar(Drv), 0, ShInfo, SizeOf(ShInfo), SHGFI_SYSICONINDEX or SHGFI_DISPLAYNAME or SHGFI_TYPENAME);
    	    if (lvDrives.SmallImages <> nil) then
     	      ImageIndex  := ShInfo.iIcon;
          Caption := StrPas(ShInfo.szDisplayName);
          DI      := GetDiskInfo(Drv);
          SubItems.Add(DI.MediaType);
          if (DI.Serial = 0) then begin
            SubItems.Add('');
            SubItems.Add('');
            SubItems.Add('');
            SubItems.Add('');
          end else begin
            SubItems.Add(DI.FileSystem);