Archivado/Componentes.Terceros.jvcl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
b40ce04eb4
Componentes.Terceros.jvcl/official/3.32/run/JvDriveCtrls.pas

1727 lines
48 KiB
ObjectPascal
Raw Blame History

{-----------------------------------------------------------------------------
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.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 10612 2006-05-19 19:04:09Z jfudickar $
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 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: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvDriveCtrls.pas $';
Revision: '$Revision: 10612 $';
Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}
implementation
uses
ShellAPI, SysUtils, Math, Forms, ImgList,
DBT,
JvVCL5Utils, 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);
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
Refresh;
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(SizeOf(Tmp), 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
Refresh;
end;
procedure TJvDriveList.BuildList;
var
Info: TSHFileInfo;
S: string;
Options: Integer;
Drv: Char;
Tmp: array [0..104] 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(SizeOf(Tmp), 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
DrawItem(itemID, rcItem, State)
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
with Canvas do
begin
tmpCol := Canvas.Brush.Color;
Canvas.Brush.Color := Self.Color;
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;
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;
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
Result := Path;
if (Length(Path) > 1) and (AnsiLastChar(Path) <> '\') then
Result := Path + '\';
end;
function DirLevel(const PathName: string): Integer; { counts '\' in path }
var
P: PChar;
begin
Result := 0;
P := AnsiStrScan(PChar(PathName), '\');
while P <> nil do
begin
Inc(Result);
Inc(P);
P := AnsiStrScan(P, '\');
end;
end;
function ConcatPaths(const Path, S: string): string;
begin
if Path = '' then
begin
Result := AddPathBackslash(S);
Exit;
end;
if AnsiLastChar(Path)^ <> '\' then
Result := Path + '\' + 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 + ':') 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;
FFileList := Value;
if FFileList <> nil then
begin
FFileList.FreeNotification(Self);
FFileList.Directory := Directory;
end;
end;
procedure TJvDirectoryListBox.SetDirLabel(Value: TLabel);
begin
FDirLabel := Value;
if Value <> nil then
Value.FreeNotification(Self);
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,
{$IFDEF VCL} faReadOnly or faHidden or faSysFile or faArchive or {$ENDIF} 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)^ <> '\' then
begin
BackSlashPos := AnsiPos('\', 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('\', 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;
FDriveCombo := Value;
if FDriveCombo <> nil then
begin
FDriveCombo.FDirList := Self;
FDriveCombo.Drive := Drive;
FDriveCombo.FreeNotification(Self);
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;
end;
destructor TJvFileListBox.Destroy;
begin
FImages.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.. }
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(cDirPrefix + Strings[J])
else
I := Items.Add(cDirPrefix + string(shinf.szDisplayName));
Items.Objects[I] := TObject(shinf.iIcon);
if I = 100 then
Screen.Cursor := crHourGlass;
end;
{ ..then add files }
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.ApplyFilePath(const EditText: string);
begin
if (EditText <> '') and
(AnsiCompareFileName(ExtractFilePath(FileName), ExtractFilePath(EditText)) <> 0) then
begin
inherited ApplyFilePath(EditText);
ReadFileNames;
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;
// Use Trim because directories have a space as prefix, so that
// the directory names appear above the files.
tmpR.Left := tmpR.Left + Offset - 2;
tmpR.Right := tmpR.Left + TextWidth(Trim(Items[Index])) + 4;
FillRect(tmpR);
TextOut(Rect.Left + Offset, Rect.Top, Trim(Items[Index]));
if odFocused in State then
DrawFocusRect(tmpR);
end;
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.
Reference in New Issue View Git Blame Copy Permalink