jvdrivectrls.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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 Th鰎nqvist [peter3 at sourceforge dot net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2002 Peter Th鰎nqvist.
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.sourceforge.net

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

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvDriveCtrls.pas,v 1.42 2005/02/17 10:20:26 marquardt Exp $

unit JvDriveCtrls;

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

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Graphics, Controls,
  FileCtrl, StdCtrls,
  JvComboBox, JvListBox, JvSearchFiles, 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;

  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;
    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 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;

  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;
    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 Items stored False;
    property Offset: Integer read FOffset write SetOffset;
  public
    constructor Create(AOwner: TComponent); override;
    procedure CreateWnd; override;
    destructor Destroy; override;
    procedure Refresh;
    property Drives[Index: Integer]: string read GetDrives;
    property DriveCount: Integer read GetDriveCount;
  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 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 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;

  TJvFileListBox = class(TFileListBox)
  private
    FAboutJVCL: TJVCLAboutInfo;
    FImages: TImageList;
    FForceFileExtensions: Boolean;
    FSearchFiles: TJvSearchFiles;
    procedure SetForceFileExtensions(const Value: Boolean);
  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 Directory 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;

  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 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: '$RCSfile: JvDriveCtrls.pas,v $';
    Revision: '$Revision: 1.42 $';
    Date: '$Date: 2005/02/17 10:20:26 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  ShellAPI, SysUtils, Math, Forms, ImgList,
  DBT,
  JvJCLUtils, JvJVCLUtils, JvConsts;

const
  cDirPrefix = #32;

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);