{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDriveCtrls.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Thrnqvist [peter3 at sourceforge dot net]
Portions created by Peter Thrnqvist are Copyright (C) 2002 Peter Thrnqvist.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org

Description:
  Components to replace the TDriveComboBox from Borland that also adds a TDriveListBox.
  Uses the system Iconlist to display drive icons.

Known Issues:
-----------------------------------------------------------------------------}
// $Id$

unit JvDriveCtrls;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Graphics, Controls, StdCtrls,
  FileCtrl,
  JvCombobox, JvListBox, JvSearchFiles, JvChangeNotify, JvTypes, JVCLVer;

type
  // redclare so user don't have to add JvTypes to uses manually
  TJvDriveType = JvTypes.TJvDriveType;
  TJvDriveTypes = JvTypes.TJvDriveTypes;

const
  dtStandard: TJvDriveTypes = [dtFixed, dtRemote, dtCDROM];

type
  TJvDirectoryListBox = class;

  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64{$IFDEF RTL360_UP} or pidWin64x{$ENDIF RTL360_UP})]
  {$ENDIF RTL230_UP}
  TJvDriveCombo = class(TJvCustomComboBox)
  private
    FDrives: TStringList;
    FImages: TImageList;
    FImageWidth: Integer;
    FImageSize: TJvImageSize;
    FItemIndex: Integer;
    FOffset: Integer;
    FDrive: Char;
    FDriveTypes: TJvDriveTypes;
    FSmall: Integer;
    FLarge: Integer;
    FDisplayName: string;
    FDirList: TJvDirectoryListBox;
    FOnDriveChange: TNotifyEvent;
    procedure RecreateImageList;
    procedure ResetItemHeight;
    procedure SetImageSize(Value: TJvImageSize);
    procedure SetOffset(Value: Integer);
    function DriveChangeMessage(var Msg: TMessage): Boolean;
  protected
    procedure FontChanged; override;
    procedure CreateWnd; override;
    procedure SetDrive(Value: Char);
    procedure SetDriveTypes(Value: TJvDriveTypes);
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure MeasureItem(Index: Integer; var Height: Integer); override;
    procedure CNCommand(var Msg: TWMCommand); message CN_COMMAND;
    procedure BuildList; virtual;
    procedure Change; override;
    property Items stored False;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Refresh; virtual;
  published
    property Align;
    property BevelInner;
    property BevelOuter;
    property BevelKind;
    property BevelWidth;
    property Drive: Char read FDrive write SetDrive stored False;
    property DriveTypes: TJvDriveTypes read FDriveTypes write SetDriveTypes;
    property Offset: Integer read FOffset write SetOffset;
    property ImageSize: TJvImageSize read FImageSize write SetImageSize default isSmall;
    property DisplayName: string read FDisplayName;
    property OnDriveChange: TNotifyEvent read FOnDriveChange write FOnDriveChange;
    property Color;
    property DragMode;
    property DragCursor;
    property Enabled;
    property Font;
    property ItemHeight;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDrag;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ImeMode;
    property ImeName;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
  end;

  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64{$IFDEF RTL360_UP} or pidWin64x{$ENDIF RTL360_UP})]
  {$ENDIF RTL230_UP}
  TJvDriveList = class(TJvCustomListBox)
  private
    FDrives: TStringList;
    FImages: TImageList;
    FImageWidth: Integer;
    FImageSize: TJvImageSize;
    FItemIndex: Integer;
    FOffset: Integer;
    FDrive: Char;
    FDriveTypes: TJvDriveTypes;
    FSmall: Integer;
    FLarge: Integer;
    FImageAlign: TJvImageAlign;
    FOnChange: TNotifyEvent;
    FOnDrawItem: TDrawItemEvent;
    FOnDriveChange: TNotifyEvent;
    procedure SetImageAlign(Value: TJvImageAlign);
    procedure ResetItemHeight;
    procedure SetImageSize(Value: TJvImageSize);
    procedure SetOffset(Value: Integer);
    function GetDrives(Index: Integer): string;
    function GetDriveCount: Integer;
    function DriveChangeMessage(var Msg: TMessage): Boolean;
  protected
    procedure Resize; override;
    procedure FontChanged; override;
    procedure SetDrive(Value: Char);
    procedure SetDriveTypes(Value: TJvDriveTypes);
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure MeasureItem(Index: Integer; var Height: Integer); override;
    procedure CNCommand(var Msg: TWMCommand); message CN_COMMAND;
    procedure BuildList; virtual;
    procedure Change; dynamic;
    property Offset: Integer read FOffset write SetOffset;
  public
    constructor Create(AOwner: TComponent); override;
    procedure CreateWnd; override;
    destructor Destroy; override;
    procedure Refresh; // ahuser: This hides the TControl.Refresh method, why was that name used
    property Drives[Index: Integer]: string read GetDrives;
    property DriveCount: Integer read GetDriveCount;
    property Items stored False;
    property Images: TImageList read FImages;
  published
    property MultiSelect;
    property ScrollBars default ssNone;
    property ImageAlign: TJvImageAlign read FImageAlign write SetImageAlign default iaCentered;
    property Drive: Char read FDrive write SetDrive stored False;
    property DriveTypes: TJvDriveTypes read FDriveTypes write SetDriveTypes;
    property ImageSize: TJvImageSize read FImageSize write SetImageSize;
    property OnDriveChange: TNotifyEvent read FOnDriveChange write FOnDriveChange;
    property Align;
    property BorderStyle;
    property Color;
    property Sorted;
    property Tag;
    property DragMode;
    property DragCursor;
    property Enabled;
    property Font;
    property IntegralHeight;
    property ItemHeight;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDrag;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ImeMode;
    property ImeName;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
  end;

  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64{$IFDEF RTL360_UP} or pidWin64x{$ENDIF RTL360_UP})]
  {$ENDIF RTL230_UP}
  TJvFileListBox = class(TFileListBox)
  private
    FAboutJVCL: TJVCLAboutInfo;
    FImages: TImageList;
    FForceFileExtensions: Boolean;
    FSearchFiles: TJvSearchFiles;
    FChangeNotify: TJvCHangeNotify;
    FAutoUpdate: Boolean;
    procedure SetForceFileExtensions(const Value: Boolean);
    procedure SetDirectory(const Value: string);
    procedure SetAutoUpdate(Value: Boolean);
    procedure InitFileChangeNotification;
    procedure OnFilesChanged(Sender: TObject);
  protected
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure ReadFileNames; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ApplyFilePath(const EditText: string); override;
  published
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    property AutoUpdate: Boolean read FAutoUpdate write SetAutoUpdate default false;
    property Directory write SetDirectory stored False;
    property FileName stored False;
    // set this property to True to force the display of filename extensions for all files even if
    // the user has activated the Explorer option "Don't show extensions for known file types"
    property ForceFileExtensions: Boolean read FForceFileExtensions write SetForceFileExtensions;
    property Columns;
    property BorderStyle;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ImeMode;
    property ImeName;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
  end;

  TJvDriveChangeError = procedure(Sender: TObject; var NewDrive: Char) of object;

  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64{$IFDEF RTL360_UP} or pidWin64x{$ENDIF RTL360_UP})]
  {$ENDIF RTL230_UP}
  TJvDirectoryListBox = class(TJvCustomListBox)
  private
    FFileList: TJvFileListBox;
    FDriveCombo: TJvDriveCombo;
    FDirLabel: TLabel;
    FInSetDir: Boolean;
    FPreserveCase: Boolean;
    FCaseSensitive: Boolean;
    FAutoExpand: Boolean;
    { (rb) Probably better to switch the values in FDisplayNames and the values
           in Items, see comment at TJvCustomListBox.LBAddString }
    FDisplayNames: TStringList;
    FOnDriveChangeError: TJvDriveChangeError;
    FShowAllFolders: Boolean;
    function GetDrive: Char;
    procedure SetFileList(Value: TJvFileListBox);
    procedure SetDirLabel(Value: TLabel);
    procedure SetDirLabelCaption;
    procedure SetDrive(Value: Char);
    procedure DriveChange(NewDrive: Char);
    procedure SetDir(const NewDirectory: string);
    procedure SetDirectory(const NewDirectory: string); virtual;
    procedure ResetItemHeight;
    procedure SetDriveCombo(const Value: TJvDriveCombo);
    procedure SetShowAllFolders(const Value: Boolean);
  protected
    FImages: TImageList;
    FDirectory: string;
    FOnChange: TNotifyEvent;
    procedure FontChanged; override;
    procedure Change; virtual;
    procedure DblClick; override;
    procedure ReadBitmaps; virtual;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    function ReadDirectoryNames(const ParentDirectory: string; DirectoryList: TStrings): Integer;
    procedure BuildList; virtual;
    procedure KeyPress(var Key: Char); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Click; override;
    function DoDriveChangeError(var NewDrive: Char): Boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateWnd; override;
    function GetItemPath(Index: Integer): string;
    procedure OpenCurrent;
    property Drive: Char read GetDrive write SetDrive stored False;
    procedure Update; reintroduce;
    property PreserveCase: Boolean read FPreserveCase;
    property CaseSensitive: Boolean read FCaseSensitive;
  published
    property Align;
    property AutoExpand: Boolean read FAutoExpand write FAutoExpand default True;
    property MultiSelect default False;
    property BorderStyle;
    property BevelInner;
    property BevelOuter;
    property BevelKind;
    property BevelWidth;
    property Color;
    property Directory: string read FDirectory write SetDirectory;
    property DirLabel: TLabel read FDirLabel write SetDirLabel;
    property DragCursor;
    property DragMode;
    property Enabled;
    property FileList: TJvFileListBox read FFileList write SetFileList;
    property DriveCombo: TJvDriveCombo read FDriveCombo write SetDriveCombo;
    property Font;
    property IntegralHeight;
    property ItemHeight;
    { No need to store the items, image indexes aren't stored thus need to call
      BuildList anyway }
    property Items stored False;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowAllFolders: Boolean read FShowAllFolders write SetShowAllFolders default False;
    property ShowHint;
    property ScrollBars default ssNone;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDriveChangeError: TJvDriveChangeError read FOnDriveChangeError write FOnDriveChangeError;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ImeMode;
    property ImeName;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL$';
    Revision: '$Rev$';
    Date: '$Date$';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  ShellAPI, SysUtils, Math, Forms, ImgList,
  DBT,
  {$IFDEF HAS_UNIT_SYSTEM_UITYPES}
  System.UITypes,
  {$ENDIF HAS_UNIT_SYSTEM_UITYPES}
  JvJCLUtils, JvJVCLUtils, JvConsts;

function GetItemHeight(Font: TFont): Integer;
var
  DC: HDC;
  SaveFont: HFONT;
  Metrics: TTextMetric;
begin
  DC := GetDC(HWND_DESKTOP);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(HWND_DESKTOP, DC);
  Result := Metrics.tmHeight;
end;

function IsValidDriveType(DriveTypes: TJvDriveTypes; DriveType: UINT): Boolean;
const
  cDriveMasks: array [TJvDriveType] of UINT =
  (DRIVE_UNKNOWN, DRIVE_REMOVABLE, DRIVE_FIXED, DRIVE_REMOTE, DRIVE_CDROM, DRIVE_RAMDISK);
var
  I: TJvDriveType;
begin
  Result := True;
  for I := Low(TJvDriveType) to High(TJvDriveType) do
    if (I in DriveTypes) and (DriveType = cDriveMasks[I]) then
      Exit;
  Result := False;
end;

//=== { TJvDriveCombo } ======================================================

constructor TJvDriveCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FLarge := GetSystemMetrics(SM_CXICON);
  FSmall := GetSystemMetrics(SM_CXSMICON);

  FDrives := TStringList.Create;
  FDriveTypes := dtStandard;

  FImageSize := isSmall;
  RecreateImageList;
  FImageWidth := FImages.Width;

  FItemIndex := 0;
  FOffset := 4;
  Color := clWindow;
  Style := csOwnerDrawFixed;
  ResetItemHeight;
  Application.HookMainWindow(DriveChangeMessage);
end;

destructor TJvDriveCombo.Destroy;
begin
  Application.UnhookMainWindow(DriveChangeMessage);
  FDrives.Free;
  FImages.Free;
  inherited Destroy;
end;

function TJvDriveCombo.DriveChangeMessage(var Msg: TMessage): Boolean;
begin
  Result := False;
  if Msg.Msg = WM_DEVICECHANGE then
    if ((TWMDeviceChange(Msg).Event = DBT_DEVICEARRIVAL) or
      (TWMDeviceChange(Msg).Event = DBT_DEVICEREMOVECOMPLETE)) and
      (PDevBroadcastVolume(TWMDeviceChange(Msg).dwData)^.dbcv_devicetype = DBT_DEVTYP_VOLUME) then
    begin
      Refresh;
      if Assigned(FOnDriveChange) then
        FOnDriveChange(Self);
    end;
end;

procedure TJvDriveCombo.RecreateImageList;
begin
  if FImageSize = isSmall then
    FImages := TImageList.CreateSize(FSmall, FSmall)
  else
    FImages := TImageList.CreateSize(FLarge, FLarge);

  FImages.DrawingStyle := dsTransparent;
  FImages.ShareImages := True;
end;

procedure TJvDriveCombo.BuildList;
var
  Info: TSHFileInfo;
  S: string;
  Options: Integer;
  Drv: Char;
  LastErrorMode: Cardinal;
  Tmp: array [0..104] of Char; // 4 chars ('C:\#0') * 26 possible drives + 1 terminating #0 = 105 chars
  P: PChar;
begin
  Drv := Drive;
  Items.Clear;
  FDrives.Clear;
  Options := SHGFI_SYSICONINDEX;
  if FImageSize = isSmall then
    Options := Options or SHGFI_SMALLICON
  else
    Options := Options or SHGFI_LARGEICON;

  FImages.Handle := SHGetFileInfo('', 0, Info, SizeOf(TSHFileInfo), Options);
  FImages.ShareImages := True;
  LastErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  try
    FillChar(Tmp[0], SizeOf(Tmp), #0);
    GetLogicalDriveStrings(Length(Tmp) - 1, Tmp);
    P := Tmp;
    while P^ <> #0 do
    begin
      S := P;
      Inc(P, 4);
      if IsValidDriveType(DriveTypes, GetDriveType(PChar(S))) then
      begin
        SHGetFileInfo(PChar(S), 0, Info, SizeOf(TSHFileInfo), SHGFI_DISPLAYNAME or Options);
        Items.AddObject(Trim(Info.szDisplayName), TObject(Info.iIcon));
        FDrives.Add(S[1]);
      end
    end;
    Drive := Drv;
    Update;
  finally
    SetErrorMode(LastErrorMode);
  end;
end;

procedure TJvDriveCombo.CreateWnd;
begin
  inherited CreateWnd;
  BuildList;
  if FDrive = #0 then
  begin
    if FDrives.IndexOf(GetCurrentDir[1]) > 0 then
      Drive := GetCurrentDir[1]
    else
    if FDrives.Count > 0 then
      Drive := FDrives[0][1];
  end;
end;

procedure TJvDriveCombo.Refresh;
begin
  BuildList;
end;

procedure TJvDriveCombo.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Msg.DrawItemStruct^ do
  begin
    State := [];
    if (itemState and ODS_CHECKED) <> 0 then
      Include(State, odChecked);
    if (itemState and ODS_COMBOBOXEDIT) <> 0 then
      Include(State, odComboBoxEdit);
    if (itemState and ODS_DEFAULT) <> 0 then
      Include(State, odDefault);
    if (itemState and ODS_DISABLED) <> 0 then
      Include(State, odDisabled);
    if (itemState and ODS_FOCUS) <> 0 then
      Include(State, odFocused);
    if (itemState and ODS_GRAYED) <> 0 then
      Include(State, odGrayed);
    if (itemState and ODS_SELECTED) <> 0 then
      Include(State, odSelected);
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State)
    else
      Canvas.FillRect(rcItem);
    Canvas.Handle := 0;
  end;
end;

procedure TJvDriveCombo.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  Offset, I: Integer;
begin
  //  inherited;
  with Canvas do
  begin
    Offset := FImageWidth + FOffset + FOffset;
    if FImages.Count > 0 then
    begin
      I := Integer(Items.Objects[Index]);
      FImages.Draw(Canvas, Rect.Left + FOffset, Rect.Top, I);
      Rect.Left := Rect.Left + Offset;
      Rect.Right := Rect.Left + Canvas.TextWidth(Items[Index]) + 6;
    end;
    FillRect(Rect);
    if odSelected in State then
      DrawFocusRect(Rect);
    Inc(Rect.Left, 3);
    DrawText(Canvas, Items[Index], -1, Rect,
      DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
  end;
end;

procedure TJvDriveCombo.MeasureItem(Index: Integer; var Height: Integer);
begin
  Height := ItemHeight;
end;

procedure TJvDriveCombo.FontChanged;
begin
  inherited FontChanged;
  ResetItemHeight;
  RecreateWnd;
end;

procedure TJvDriveCombo.ResetItemHeight;
var
  NewHeight: Integer;
begin
  NewHeight := GetItemHeight(Font);
  if NewHeight < FImages.Height then
    NewHeight := FImages.Height;
  ItemHeight := NewHeight;
end;

procedure TJvDriveCombo.SetDriveTypes(Value: TJvDriveTypes);
begin
  FDriveTypes := Value;
  if FDriveTypes = [] then
    FDriveTypes := [dtFixed];
  BuildList;
  Change;
  // Drive := FDrive;
end;

procedure TJvDriveCombo.SetDrive(Value: Char);
var
  I, J: Integer;
begin
  J := 0;
  if FItemIndex <> -1 then
    J := FItemIndex;

  Value := UpCase(Value);
  if FDrive <> Value then
  begin
    I := FDrives.IndexOf(Value);
    if I > -1 then
    begin
      FDrive := Value;
      FItemIndex := I;
      ItemIndex := I;
      if FDirList <> nil then
        FDirList.DriveChange(FDrive);
      Change;
    end;
  end
  else
    ItemIndex := J;
end;

procedure TJvDriveCombo.SetImageSize(Value: TJvImageSize);
begin
  if FImageSize <> Value then
  begin
    FImageSize := Value;

    if Items.Count > 0 then
      Items.Clear;

    RecreateImageList;
    FImageWidth := FImages.Width;
    ResetItemHeight;
    RecreateWnd;
    BuildList;
    Change;
  end;
end;

procedure TJvDriveCombo.SetOffset(Value: Integer);
begin
  if FOffset <> Value then
  begin
    FOffset := Value;
    Refresh;
  end;
end;

procedure TJvDriveCombo.Change;

  function FirstChar(const S: string): Char;
  begin
    if Length(S) > 0 then
      Result := S[1]
    else
      Result := #0;
  end;

begin
  if ItemIndex <> -1 then
    FItemIndex := ItemIndex
  else
    FItemIndex := 0;
  if (FItemIndex >= 0) and (FItemIndex < FDrives.Count) then
    Drive := FirstChar(FDrives[FItemIndex]);
  if (ItemIndex > -1) and (ItemIndex < Items.Count) then
    FDisplayName := Items[ItemIndex]
  else
    FDisplayName := '';
  inherited Change;
end;

procedure TJvDriveCombo.CNCommand(var Msg: TWMCommand);
begin
  inherited;
  case Msg.NotifyCode of
    {    CBN_EDITCHANGE:
          Change;}
    CBN_SELCHANGE:
      Change;
  end;
end;

//=== { TJvDriveList } =======================================================

constructor TJvDriveList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FLarge := GetSystemMetrics(SM_CXICON);
  FSmall := GetSystemMetrics(SM_CXSMICON);

  FDrives := TStringList.Create;
  FDriveTypes := dtStandard;
  FImageAlign := iaCentered;
  ScrollBars := ssNone;

  if FImageSize = isSmall then
    FImages := TImageList.CreateSize(FSmall, FSmall)
  else
    FImages := TImageList.CreateSize(FLarge, FLarge);

  FImages.DrawingStyle := dsTransparent;
  FImageWidth := FImages.Width;
  FImages.ShareImages := True;

  FItemIndex := 0;
  Color := clWindow;
  SetBounds(0, 0, FImageWidth * 6 + 16, 97);
  FOffset := 4;
  Style := lbOwnerDrawFixed;
  ResetItemHeight;
  Application.HookMainWindow(DriveChangeMessage);
end;

destructor TJvDriveList.Destroy;
begin
  Application.UnhookMainWindow(DriveChangeMessage);
  FDrives.Free;
  FImages.Free;
  inherited Destroy;
end;

function TJvDriveList.DriveChangeMessage(var Msg: TMessage): Boolean;
begin
  Result := False;
  if Msg.Msg = WM_DEVICECHANGE then
    if ((TWMDeviceChange(Msg).Event = DBT_DEVICEARRIVAL) or
      (TWMDeviceChange(Msg).Event = DBT_DEVICEREMOVECOMPLETE)) and
      (PDevBroadcastVolume(TWMDeviceChange(Msg).dwData)^.dbcv_devicetype = DBT_DEVTYP_VOLUME) then
    begin
      Refresh;
      if Assigned(FOnDriveChange) then
        FOnDriveChange(Self);
    end;
end;

procedure TJvDriveList.BuildList;
var
  Info: TSHFileInfo;
  S: string;
  Options: Integer;
  Drv: Char;
  Tmp: array [0..105] of Char;
  P: PChar;
  LastErrorMode: Cardinal;
begin
  Drv := Drive;
  if Items.Count > 0 then
  begin
    Items.Clear;
    FDrives.Clear;
  end;

  Options := SHGFI_SYSICONINDEX;
  if FImageSize = isSmall then
    Options := Options or SHGFI_SMALLICON
  else
    Options := Options or SHGFI_LARGEICON;

  FImages.Handle := SHGetFileInfo('', 0, Info, SizeOf(TSHFileInfo), Options);
  FImages.ShareImages := True;
  FillChar(Tmp[0], SizeOf(Tmp), #0);
  LastErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  try
    GetLogicalDriveStrings(Length(Tmp) - 1, Tmp);
    P := Tmp;
    while P^ <> #0 do
    begin
      S := P;
      Inc(P, 4);
      if IsValidDriveType(DriveTypes, GetDriveType(PChar(S))) then
      begin
        SHGetFileInfo(PChar(S), 0, Info, SizeOf(TSHFileInfo), SHGFI_DISPLAYNAME or Options);
        Items.AddObject(Trim(Info.szDisplayName), TObject(Info.iIcon));
        FDrives.Add(S[1]);
      end;
    end;
    Drive := Drv;
    Update;
  finally
    SetErrorMode(LastErrorMode);
  end;
end;

procedure TJvDriveList.CreateWnd;
begin
  inherited CreateWnd;
  BuildList;
  if Drive = #0 then
    if FDrives.IndexOf(GetCurrentDir[1]) > 0 then
      Drive := GetCurrentDir[1]
    else
    if FDrives.Count > 0 then
      Drive := FDrives[0][1];
end;

procedure TJvDriveList.Refresh;
begin
  BuildList;
end;

procedure TJvDriveList.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Msg.DrawItemStruct^ do
  begin
    State := [];
    if (itemState and ODS_CHECKED) <> 0 then
      Include(State, odChecked);
    if (itemState and ODS_COMBOBOXEDIT) <> 0 then
      Include(State, odComboBoxEdit);
    if (itemState and ODS_DEFAULT) <> 0 then
      Include(State, odDefault);
    if (itemState and ODS_DISABLED) <> 0 then
      Include(State, odDisabled);
    if (itemState and ODS_FOCUS) <> 0 then
      Include(State, odFocused);
    if (itemState and ODS_GRAYED) <> 0 then
      Include(State, odGrayed);
    if (itemState and ODS_SELECTED) <> 0 then
      Include(State, odSelected);
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText;
    end;
    if Integer(itemID) >= 0 then
    begin
      if Assigned(FOnDrawItem) then
        OnDrawItem(Self, itemID, rcItem, State)
      else
        DrawItem(itemID, rcItem, State);
    end
    else
      Canvas.FillRect(rcItem);

    Canvas.Handle := 0;
  end;
end;

procedure TJvDriveList.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  HOffset, I: Integer;
  tmpCol: TColor;
  tmpR: TRect;
begin
  tmpCol := Canvas.Brush.Color;
  Canvas.Brush.Color := Self.Color;
  Canvas.FillRect(Rect);
  Canvas.Brush.Color := tmpCol;
  if FImageAlign = iaCentered then
  begin
    HOffset := (Rect.Right - Rect.Left) div 2 - FImageWidth div 2;
    if FImages.Count > 0 then
    begin
      I := Integer(Items.Objects[Index]);
      FImages.Draw(Canvas, HOffset, Rect.Top, I);
    end;
    InflateRect(Rect, 1, -6);
    tmpR := Rect;
    DrawText(Canvas, Items[Index], -1, tmpR,
      DT_SINGLELINE or DT_BOTTOM or DT_CENTER or DT_NOPREFIX or DT_CALCRECT);
    Rect.Top := tmpR.Bottom - CanvasMaxTextHeight(Canvas);
    Rect.Left := (Rect.Right - Rect.Left) div 2 - Canvas.TextWidth(PChar(Items[Index])) div 2;
    Rect.Right := Rect.Left + Canvas.TextWidth(PChar(Items[Index]));
    DrawText(Canvas, Items[Index], -1, Rect, DT_SINGLELINE or DT_CENTER or DT_NOPREFIX);
  end
  else
  begin
    if FImages.Count > 0 then
    begin
      I := Integer(Items.Objects[Index]);
      FImages.Draw(Canvas, Rect.Left + FOffset * 2, Rect.Top + FOffset * 2, I);
    end;
    tmpR := Rect;
    DrawText(Canvas, Items[Index], -1, tmpR,
      DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_NOPREFIX or DT_CALCRECT);
    Rect.Top := tmpR.Bottom - CanvasMaxTextHeight(Canvas);
    Rect.Bottom := Rect.Top + CanvasMaxTextHeight(Canvas);
    Rect.Left := FImageWidth + FOffset * 3;
    Rect.Right := Rect.Left + Canvas.TextWidth(PChar(Items[Index]));
    DrawText(Canvas, Items[Index], -1, Rect, DT_SINGLELINE or DT_TOP or DT_NOPREFIX);
  end;
  if odFocused in State then
    DrawFocusRect(Canvas.Handle, Rect);
end;

procedure TJvDriveList.MeasureItem(Index: Integer; var Height: Integer);
begin
  if FImageAlign = iaCentered then
    Height := FImageWidth + GetItemHeight(Font)
  else
    Height := Max(GetItemHeight(Font), FImageWidth);
end;

procedure TJvDriveList.SetImageAlign(Value: TJvImageAlign);
begin
  if FImageAlign <> Value then
  begin
    FImageAlign := Value;
    Invalidate;
  end;
end;

procedure TJvDriveList.FontChanged;
begin
  inherited FontChanged;
  ResetItemHeight;
  RecreateWnd;
end;

procedure TJvDriveList.ResetItemHeight;
begin
  ItemHeight := GetItemHeight(Font) + FImageWidth + 8;
end;

procedure TJvDriveList.SetDriveTypes(Value: TJvDriveTypes);
begin
  FDriveTypes := Value;
  if FDriveTypes = [] then
    FDriveTypes := [dtFixed];
  BuildList;
end;

procedure TJvDriveList.SetDrive(Value: Char);
var
  I, J: Integer;
begin
  J := 0;
  if FItemIndex <> -1 then
    J := FItemIndex;

  Value := UpCase(Value);
  if (FDrive <> Value) and (Value <> #0) then
  begin
    I := FDrives.IndexOf(Value);
    if I > -1 then
    begin
      FDrive := Value;
      FItemIndex := I;
      ItemIndex := I;
    end;
  end
  else
    ItemIndex := J;
end;

procedure TJvDriveList.SetImageSize(Value: TJvImageSize);
begin
  if FImageSize <> Value then
  begin
    FImageSize := Value;
    if Items.Count > 0 then
      Items.Clear;
    if Assigned(FImages) then
      FImages.Free;

    if Value = isSmall then
      FImages := TImageList.CreateSize(FSmall, FSmall)
    else
      FImages := TImageList.CreateSize(FLarge, FLarge);

    FImages.DrawingStyle := dsTransparent;
    FImages.ShareImages := True;
    FImageWidth := FImages.Width;
    ResetItemHeight;
    RecreateWnd;
    BuildList;
    Change;
  end;
end;

procedure TJvDriveList.SetOffset(Value: Integer);
begin
  if FOffset <> Value then
  begin
    FOffset := Value;
    Refresh;
  end;
end;

procedure TJvDriveList.Resize;
begin
  inherited Resize;
  Invalidate;
end;

procedure TJvDriveList.Change;
begin
  if ItemIndex <> -1 then
    FItemIndex := ItemIndex;
  if (FItemIndex >= 0) and (FItemIndex < FDrives.Count) then
    Drive := FDrives[FItemIndex][1];
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvDriveList.CNCommand(var Msg: TWMCommand);
begin
  inherited;
  case Msg.NotifyCode of
    {    CBN_EDITCHANGE:
          Change;}
    CBN_SELCHANGE:
      Change;
  end;
end;

//=== { TJvDirectoryListBox } ================================================

function AddPathBackslash(const Path: string): string;
begin
  if (Path <> '') then
    Result := IncludeTrailingPathDelimiter(Path)
  else
    Result := Path;
end;

function DirLevel(const PathName: string): Integer; { counts '\' in path }
var
  P: PChar;
begin
  Result := 0;
  P := AnsiStrScan(PChar(PathName), PathDelim);
  while P <> nil do
  begin
    Inc(Result);
    Inc(P);
    P := AnsiStrScan(P, PathDelim);
  end;
end;

function ConcatPaths(const Path, S: string): string;
begin
  if Path = '' then
  begin
    Result := AddPathBackslash(S);
    Exit;
  end;
  if AnsiLastChar(Path)^ <> PathDelim then
    Result := Path + PathDelim + S
  else
    Result := Path + S;
end;

constructor TJvDirectoryListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 145;
  Style := lbOwnerDrawFixed;
  Sorted := False;
  ScrollBars := ssNone;
  FAutoExpand := True;
  FImages := TImageList.Create(Self);
  FImages.ShareImages := True;
  FDisplayNames := TStringList.Create;
  ReadBitmaps;
  GetDir(0, FDirectory);
  MultiSelect := False;
  ResetItemHeight;
end;

destructor TJvDirectoryListBox.Destroy;
begin
  FDisplayNames.Free;
  inherited Destroy;
end;

function TJvDirectoryListBox.DoDriveChangeError(var NewDrive: Char): Boolean;
begin
  Result := Assigned(FOnDriveChangeError);
  if Result then
    FOnDriveChangeError(Self, NewDrive);
end;

procedure TJvDirectoryListBox.DriveChange(NewDrive: Char);
var
  VolFlags, MLength: DWORD;
  TmpDrive: Char;
begin
  if UpCase(NewDrive) <> UpCase(Drive) then
  begin
    if NewDrive <> #0 then
    begin
      if not SetCurrentDir(NewDrive + DriveDelim + PathDelim) then
      begin
        TmpDrive := NewDrive;
        if DoDriveChangeError(NewDrive) and (NewDrive <> TmpDrive) then
        begin
          DriveChange(NewDrive)
        end
        else
        if TmpDrive <> Drive then
          DriveChange(Drive); // ...if not, revert
      end;
      FDirectory := GetCurrentDir; { store correct directory name }
      GetVolumeInformation(PChar(NewDrive + ':\'), nil, 0, nil, MLength, VolFlags, nil, 0);
      FPreserveCase := VolFlags and (FS_CASE_IS_PRESERVED or FS_CASE_SENSITIVE) <> 0;
      FCaseSensitive := (VolFlags and FS_CASE_SENSITIVE) <> 0;
    end;
    if not FInSetDir then
    begin
      BuildList;
      Change;
    end;
  end;
end;

procedure TJvDirectoryListBox.SetFileList(Value: TJvFileListBox);
begin
  if FFileList <> nil then
    FFileList.FDirList := nil;
  ReplaceComponentReference(Self, Value, TComponent(FFileList));
  if FFileList <> nil then
    FFileList.Directory := Directory;
end;

procedure TJvDirectoryListBox.SetDirLabel(Value: TLabel);
begin
  ReplaceComponentReference(Self, Value, TComponent(FDirLabel));
  SetDirLabelCaption;
end;

procedure TJvDirectoryListBox.SetDir(const NewDirectory: string);
begin
  if DirectoryExists(FDirectory) then
    SetCurrentDir(FDirectory);
  SetCurrentDir(NewDirectory); { exception raised if invalid dir }
  FDirectory := GetCurrentDir; { store correct directory name }
  BuildList;
  Change;
end;

procedure TJvDirectoryListBox.OpenCurrent;
begin
  Directory := GetItemPath(ItemIndex);
end;

procedure TJvDirectoryListBox.Update;
begin
  BuildList;
  Change;
end;

function TJvDirectoryListBox.ReadDirectoryNames(const ParentDirectory: string;
  DirectoryList: TStrings): Integer;
const
  cAttr: array [Boolean] of Integer = (faDirectory,  faReadOnly or faHidden or faSysFile or faArchive or  faDirectory);
var
  Status: Integer;
  SearchRec: TSearchRec;
begin
  Result := 0;
  DirectoryList.BeginUpdate;
  Status := FindFirst(ConcatPaths(ParentDirectory, AllFilePattern), cAttr[ShowAllFolders], SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.Attr and faDirectory) = faDirectory then
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          DirectoryList.Add(ConcatPaths(ParentDirectory, SearchRec.Name));
          Inc(Result);
        end;
      end;
      Status := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
    DirectoryList.EndUpdate;
  end;
end;

procedure TJvDirectoryListBox.BuildList;
const
  CFlagsDir = SHGFI_SYSICONINDEX or SHGFI_SMALLICON or
              SHGFI_SELECTED or SHGFI_OPENICON or SHGFI_DISPLAYNAME;
  CFlagsSubDirs = SHGFI_SYSICONINDEX or SHGFI_SMALLICON or
                  SHGFI_DISPLAYNAME;
var
  TempPath: string;
  DirName: string;
  BackSlashPos: Integer;
  I: Integer;
  Siblings: TStringList;
  NewSelect: Integer;
  tmpFolder: string;
  psfi: TSHFileInfo;
begin
  Items.BeginUpdate;
  try
    Items.Clear;
    FDisplayNames.Clear;

    TempPath := Directory;
    tmpFolder := '';

    if Length(TempPath) > 0 then
    begin
      if AnsiLastChar(TempPath)^ <> PathDelim then
      begin
        BackSlashPos := AnsiPos(PathDelim, TempPath);
        while BackSlashPos <> 0 do
        begin
          DirName := Copy(TempPath, 1, BackSlashPos - 1);
          tmpFolder := ConcatPaths(tmpFolder, DirName);
          Delete(TempPath, 1, BackSlashPos);
          SHGetFileInfo(PChar(tmpFolder), 0, psfi, SizeOf(TSHFileInfo), CFlagsDir);
          Items.AddObject(tmpFolder, TObject(psfi.iIcon));
          FDisplayNames.Add(psfi.szDisplayName);
          BackSlashPos := AnsiPos(PathDelim, TempPath);
        end;
      end;
      // add the selected dir:
      SHGetFileInfo(PChar(Directory), 0, psfi, SizeOf(TSHFileInfo), CFlagsDir);
      Items.AddObject(Directory, TObject(psfi.iIcon));
      FDisplayNames.Add(psfi.szDisplayName);
    end;
    NewSelect := Items.Count - 1;

    Siblings := TStringList.Create;
    try
      Siblings.Sorted := True;
      { read all the subdir names into Siblings }
      ReadDirectoryNames(Directory, Siblings);
      for I := 0 to Siblings.Count - 1 do
      begin
        SHGetFileInfo(PChar(Siblings[I]), 0, psfi, SizeOf(TSHFileInfo), CFlagsSubDirs);
        Items.AddObject(Siblings[I], TObject(psfi.iIcon));
        FDisplayNames.Add(psfi.szDisplayName);
      end;
    finally
      Siblings.Free;
    end;
  finally
    Items.EndUpdate;
  end;
  if HandleAllocated then
    ItemIndex := NewSelect;
end;

procedure TJvDirectoryListBox.ReadBitmaps;
var
  psfi: TSHFileInfo;
begin
  FImages.Handle := SHGetFileInfo('', 0, psfi, SizeOf(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  FImages.ShareImages := True;
  FImages.DrawingStyle := dsTransparent;
end;

procedure TJvDirectoryListBox.DblClick;
begin
  OpenCurrent;
  inherited DblClick;
end;

procedure TJvDirectoryListBox.Change;
begin
  if FFileList <> nil then
    FFileList.Directory := Directory;
  if FDriveCombo <> nil then
    FDriveCombo.Drive := Drive;
  SetDirLabelCaption;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvDirectoryListBox.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Msg.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(Lo(itemState));
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText;
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State)
    else
    begin
      Canvas.FillRect(rcItem);
      //if odFocused in State then
      //  DrawFocusRect(hDC, rcItem);
    end;
    Canvas.Handle := 0;
  end;
end;

procedure TJvDirectoryListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  BmpWidth: Integer;
  DirOffset: Integer;
  S: string;
  RectText: TRect;
begin
  with Canvas do
  begin
    FillRect(Rect);

    BmpWidth := FImages.Width;
    if Index = 0 then
      DirOffset := Rect.Left + 2
    else
      DirOffset := Rect.Left + (DirLevel(Items[Index]) + 1) * 4 + 2;
    FImages.Draw(Canvas, DirOffset, (Rect.Top + Rect.Bottom - FImages.Height) div 2,
      Integer(Items.Objects[Index]));

    S := FDisplayNames[Index];

    RectText := Rect;
    RectText.Left := RectText.Left + DirOffset + FImages.Width + 2;
    RectText.Right := RectText.Left + TextWidth(S) + 4;

    TextOut(Rect.Left + BmpWidth + DirOffset + 4, Rect.Top + 2, S);
    if odFocused in State then
      DrawFocusRect(RectText);
  end;
end;

function TJvDirectoryListBox.GetItemPath(Index: Integer): string;
begin
  Result := '';
  if Index < Items.Count then
    Result := Items[Index];
  Exit;
end;

procedure TJvDirectoryListBox.CreateWnd;
begin
  inherited CreateWnd;
  BuildList;
  ItemIndex := DirLevel(Directory);
end;

procedure TJvDirectoryListBox.FontChanged;
begin
  inherited FontChanged;
  ResetItemHeight;
end;

procedure TJvDirectoryListBox.ResetItemHeight;
var
  NewHeight: Integer;
begin
  NewHeight := GetItemHeight(Font);
  if NewHeight < (FImages.Height + 1) then
    NewHeight := FImages.Height + 1;
  ItemHeight := NewHeight;
end;

function TJvDirectoryListBox.GetDrive: Char;
begin
  Result := FDirectory[1];
end;

procedure TJvDirectoryListBox.SetDrive(Value: Char);
begin
  if UpCase(Value) <> UpCase(Drive) then
    SetDirectory(Format('%s:', [Value]));
end;

procedure TJvDirectoryListBox.SetDirectory(const NewDirectory: string);
var
  NewDrive: string;
begin
  { When reading from the stream, always set the directory; if we don't do this
    the image indexes aren't initialized }
  if (Length(NewDirectory) = 0) or
    (SameFileName(NewDirectory, Directory) and not (csReading in ComponentState)) then
    Exit;
  NewDrive := ExtractFileDrive(NewDirectory);
  if Length(NewDrive) <> 2 then // we only support single Char drives (no UNC's)
    Exit;
  //  ProcessPath(NewDirectory, NewDrive, DirPart, FilePart);
  try
    if Drive <> NewDrive[1] then
    begin
      FInSetDir := True;
      if FDriveCombo <> nil then
        FDriveCombo.Drive := NewDrive[1]
      else
        DriveChange(NewDrive[1]);
    end;
  finally
    FInSetDir := False;
  end;
  if not DirectoryExists(NewDirectory) then
    SetDir(GetCurrentDir) // we have to do this because we might have changed drive
  else
    SetDir(NewDirectory);
end;

procedure TJvDirectoryListBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if Word(Key) = VK_RETURN then
    OpenCurrent;
end;

procedure TJvDirectoryListBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FFileList then
      FFileList := nil
    else
    if AComponent = FDriveCombo then
      FDriveCombo := nil
    else
    if AComponent = FDirLabel then
      FDirLabel := nil;
  end;
end;

procedure TJvDirectoryListBox.SetDirLabelCaption;
var
  DirWidth: Integer;
begin
  if FDirLabel <> nil then
  begin
    DirWidth := Width;
    if not FDirLabel.AutoSize then
      DirWidth := FDirLabel.Width;
    FDirLabel.Caption := MinimizeName(Directory, FDirLabel.Canvas, DirWidth);
  end;
end;

procedure TJvDirectoryListBox.SetDriveCombo(const Value: TJvDriveCombo);
begin
  if FDriveCombo <> nil then
    FDriveCombo.FDirList := nil;
  ReplaceComponentReference(Self, Value, TComponent(FDriveCombo));
  if FDriveCombo <> nil then
  begin
    FDriveCombo.FDirList := Self;
    FDriveCombo.Drive := Drive;
  end;
end;

procedure TJvDirectoryListBox.Click;
begin
  if FAutoExpand then
    OpenCurrent;
  inherited Click;
end;

procedure TJvDirectoryListBox.SetShowAllFolders(const Value: Boolean);
begin
  if FShowAllFolders <> Value then
  begin
    FShowAllFolders := Value;
    BuildList;
  end;
end;

//=== { TJvFileListBox } =====================================================

constructor TJvFileListBox.Create(AOwner: TComponent);
var
  shi: TSHFileInfo;
begin
  inherited Create(AOwner);
  FImages := TImageList.CreateSize(16, 16);
  FImages.ShareImages := True;
  FillChar(shi, SizeOf(shi), 0);
  FImages.Handle := SHGetFileInfo('', 0, shi, SizeOf(shi), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  FImages.DrawingStyle := dsTransparent;

  FSearchFiles := TJvSearchFiles.Create(Self);
  FSearchFiles.Options := [soAllowDuplicates,
    soSearchDirs, soSearchFiles, soStripDirs];
  FSearchFiles.DirOption := doExcludeSubDirs;
  FSearchFiles.FileParams.FileMaskSeperator := ';';
  FSearchFiles.FileParams.SearchTypes := [stAttribute, stFileMask];
  FSearchFiles.FileParams.Attributes.IncludeAttr := 0;
  { No filter on drives }
  FSearchFiles.DirParams.SearchTypes := [];
  FSearchFiles.ErrorResponse := erIgnore;

  // We sort the directory and file list ourself. This is necessary to fix Mantis #5295.
  // The control inserted a space character in front of all directory names to get them
  // sorted above all files. But this space character couldn't be removed before handling
  // the item's text to the user.
  inherited Sorted := False;
end;

destructor TJvFileListBox.Destroy;
begin
  FImages.Free;
  FChangeNotify.Free;
  inherited Destroy;
end;

procedure TJvFileListBox.ReadFileNames;
var
  shinf: SHFILEINFO;
  I, J: Integer;
  Flags: Cardinal;
  AttrIndex: TFileAttr;
  AttrWord: DWORD;
  SaveCursor: TCursor;
const
  SHGFI_OVERLAYINDEX = $00000040;
  {TFileAttr = (ftReadOnly, ftHidden, ftSystem, ftVolumeID, ftDirectory,
    ftArchive, ftNormal);}
  Attributes: array [TFileAttr] of Word = (FILE_ATTRIBUTE_READONLY, FILE_ATTRIBUTE_HIDDEN,
    FILE_ATTRIBUTE_SYSTEM, 0 {faVolumeID}, 0 {faDirectory}, FILE_ATTRIBUTE_ARCHIVE,
    FILE_ATTRIBUTE_READONLY or FILE_ATTRIBUTE_ARCHIVE or FILE_ATTRIBUTE_NORMAL {faNormal});
  CAllAttributes = FILE_ATTRIBUTE_READONLY or FILE_ATTRIBUTE_HIDDEN or
    FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_ARCHIVE or FILE_ATTRIBUTE_NORMAL;
begin
  AttrWord := 0;
  if HandleAllocated then
  begin
    { Set attribute flags based on values in FileType }
    for AttrIndex := Low(TFileAttr) to High(TFileAttr) do
      if AttrIndex in FileType then
        AttrWord := AttrWord or Attributes[AttrIndex];
    SetCurrentDir(FDirectory); { go to the directory we want }
    Clear; { clear the list }

    SaveCursor := Screen.Cursor;
    try
      FSearchFiles.RootDirectory := GetCurrentDir;
      FSearchFiles.FileParams.FileMask := FMask;
      { CAllAttributes is used to ensure that we do not filter out some new
        Attributes, such as FILE_ATTRIBUTE_NOT_CONTENT_INDEXED etc }
      FSearchFiles.FileParams.Attributes.ExcludeAttr := not AttrWord and CAllAttributes;
      if ftDirectory in FileType then
        FSearchFiles.Options := FSearchFiles.Options + [soSearchDirs]
      else
        FSearchFiles.Options := FSearchFiles.Options - [soSearchDirs];

      FSearchFiles.Search;

      { Overlay included to display linked folders or files etc. }
      Flags := SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_DISPLAYNAME;
      if GetShellVersion >= $00050000 then
        Flags := Flags or SHGFI_OVERLAYINDEX;

      { First add directories.. }
      if FSearchFiles.Directories is TStringList then
        TStringList(FSearchFiles.Directories).Sort;
      with FSearchFiles.Directories do
        for J := 0 to Count - 1 do
        begin
          { Note that the strings in FSearchFiles.Directories do not include a path }
          FillChar(shinf, SizeOf(shinf), 0);
          SHGetFileInfo(PChar(Strings[J]), 0, shinf, SizeOf(shinf), Flags);
          if FForceFileExtensions then
            I := Items.Add(Strings[J])
          else
            I := Items.Add(string(shinf.szDisplayName));
          Items.Objects[I] := TObject(shinf.iIcon);
          if I = 100 then
            Screen.Cursor := crHourGlass;
        end;

      { ..then add files }
      if FSearchFiles.Files is TStringList then
        TStringList(FSearchFiles.Files).Sort;
      with FSearchFiles.Files do
        for J := 0 to Count - 1 do
        begin
          FillChar(shinf, SizeOf(shinf), 0);
          SHGetFileInfo(PChar(Strings[J]), 0, shinf, SizeOf(shinf), Flags);
          if FForceFileExtensions then
            I := Items.Add(Strings[J])
          else
            I := Items.Add(shinf.szDisplayName);
          Items.Objects[I] := TObject(shinf.iIcon);
          if I = 100 then
            Screen.Cursor := crHourGlass;
        end;
    finally
      Screen.Cursor := SaveCursor;
    end;
    Change;
  end;
end;

procedure TJvFileListBox.SetAutoUpdate(Value: Boolean);
begin
  if Value <> FAutoUpdate then
  begin
    // Lazy initialization of JvChangeNofity
    if not FAutoUpdate then
      InitFileChangeNotification
    else
      // If disabled, notification component can be freed
      FChangeNotify.Free;

    FAutoUpdate := Value;
  end;
end;

procedure TJvFileListBox.SetDirectory(const Value: string);
begin
  // Mantis #5301. We split the Directory and FileName setter to handle them slightly different.
  // For FileName we must only change the directory if the file path changed.
  if (Value <> '') and
     (AnsiCompareFileName(ExcludeTrailingPathDelimiter(FileName), ExcludeTrailingPathDelimiter(Directory)) <> 0) then
  begin
    inherited ApplyFilePath(Value);
    if Assigned(FChangeNotify) and (FChangeNotify.Notifications.Count > 0) then
    begin
      FChangeNotify.Active := False;
      try
        FChangeNotify.Notifications[0].Directory := Value;
      finally
        FChangeNotify.Active := True;
      end;
    end;
  end
  else
    // no directory defined any longer, so free change notification as well.
    FreeAndNil(FChangeNotify);
end;

procedure TJvFileListBox.ApplyFilePath(const EditText: string);
begin
  if (EditText <> '') and
    (AnsiCompareFileName(ExtractFilePath(FileName), ExtractFilePath(EditText)) <> 0) then
  begin
    inherited ApplyFilePath(EditText);
  end;
end;

procedure TJvFileListBox.SetForceFileExtensions(const Value: Boolean);
begin
  if FForceFileExtensions <> Value then
  begin
    FForceFileExtensions := Value;
    ReadFileNames;
  end;
end;

procedure TJvFileListBox.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Msg.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(Lo(itemState));
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State)
    else
      Canvas.FillRect(rcItem);
    //    if odFocused in State then DrawFocusRect(hDC, rcItem);
    Canvas.Handle := 0;
  end;
end;

procedure TJvFileListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  Offset: Integer;
  tmpR: TRect;
  ImageIndex: Integer;
  OverlayIndex: Integer;
begin
  with Canvas do
  begin
    //    FillRect(Rect);
    Offset := 2;
    tmpR := Rect;
    if ShowGlyphs then
    begin
      ImageIndex := Integer(Items.Objects[Index]);
      OverlayIndex := (ImageIndex shr 24) - 1;
      if OverlayIndex >= 0 then
        FImages.DrawOverlay(Canvas, Rect.Left + 2, (Rect.Top + Rect.Bottom - FImages.Height) div 2,
          ImageIndex and $00FFFFFF, OverlayIndex)
      else
        FImages.Draw(Canvas, Rect.Left + 2, (Rect.Top + Rect.Bottom - FImages.Height) div 2,
          ImageIndex);
      Offset := FImages.Width + 6;
    end;

    tmpR.Left := tmpR.Left + Offset - 2;
    tmpR.Right := tmpR.Left + TextWidth(Items[Index]) + 4;
    FillRect(tmpR);
    TextOut(Rect.Left + Offset, Rect.Top, Items[Index]);

    if odFocused in State then
      DrawFocusRect(tmpR);
  end;
end;

procedure TJvFileListBox.InitFileChangeNotification;
var
  Item: TJvChangeItem;
begin
  FChangeNotify := TJvChangeNotify.Create(Self);
  Item := FChangeNotify.Notifications.Add;
  Item.Directory := Self.Directory;
  Item.IncludeSubTrees := False;
  Item.Actions := [caChangeFileName];
  Item.OnChange := OnFilesChanged;

  FChangeNotify.Active := True;
end;

procedure TJvFileListBox.OnFilesChanged(Sender: TObject);
begin
  Update;
end;

function TJvDriveList.GetDrives(Index: Integer): string;
begin
  Result := FDrives[Index];
end;

function TJvDriveList.GetDriveCount: Integer;
begin
  Result := FDrives.Count;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.
