📄 tntfilectrl2.pas
字号:
{*****************************************************************************}
{ }
{ Tnt Delphi Unicode Controls }
{ http://www.tntware.com/delphicontrols/unicode/ }
{ Version: 2.1.19 }
{ }
{ Copyleft (c) 2006, adapted from Troy Wolbrink Tnt delphi controls }
{ by Jordi March (jmarch@comg.es) }
{ 06/03/2006 version
function WideSelectDirectory2 (const Caption: WideString; const Root: WideString;
var Directory: WideString): Boolean; overload;
is deleted, because now exists in TntFileCtrl
11/01/2006 version
procedure TTntFileListBox.SetFileName
when not Win32PlatformIsUnicode
{ }
{*****************************************************************************}
{ A new WideSelectDirectory similar to FileControl.SelectDirectory }
unit TntFileCtrl2;
interface
uses
FileCtrl, Windows, TntWindows, Messages, SysUtils, TntSysUtils, Classes, TntClasses,
Controls, Graphics, TntGraphics, Forms, TntForms,
Menus, StdCtrls, TntStdCtrls, Buttons, TntButtons;
type
TTntDirectoryListBox = class;
TTntFilterComboBox = class;
TTntDriveComboBox = class;
{ TTntFileListBox }
TTntFileListBox = class(TTntCustomListBox)
private
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
function GetDrive: char;
function GetFileName: WideString;
function IsMaskStored: Boolean;
procedure SetDrive(Value: char);
procedure SetFileEdit(Value: TTntEdit);
procedure SetDirectory(const NewDirectory: WideString);
procedure SetFileType(NewFileType: TFileType);
procedure SetMask(const NewMask: WideString);
procedure SetFileName(const NewFile: WideString);
procedure SetShowGlyphs (Value: Boolean);
procedure ResetItemHeight;
protected
FDirectory: WideString;
FMask: WideString;
FFileType: TFileType;
FFileEdit: TTntEdit;
FDirList: TTntDirectoryListBox;
FFilterCombo: TTntFilterComboBox;
ExeBMP, DirBMP, UnknownBMP: TBitmap;
FOnChange: TNotifyEvent;
FLastSel: Integer;
FShowGlyphs: Boolean;
procedure CreateWnd; override;
procedure ReadBitmaps; virtual;
procedure Click; override;
procedure Change; virtual;
procedure ReadFileNames; virtual;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
function GetFilePath: WideString; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Update; reintroduce;
procedure ApplyFilePath (const EditText: WideString); virtual;
property Drive: char read GetDrive write SetDrive;
property Directory: WideString read FDirectory write ApplyFilePath;
property FileName: WideString read GetFilePath write ApplyFilePath;
published
property Align;
property Anchors;
property AutoComplete;
property BevelEdges;
property BevelInner;
property BevelKind;
property BevelOuter;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragMode;
property Enabled;
property ExtendedSelect;
property FileEdit: TTntEdit read FFileEdit write SetFileEdit;
property FileType: TFileType read FFileType write SetFileType default [ftNormal];
property Font;
property ImeMode;
property ImeName;
property IntegralHeight;
property ItemHeight;
property Mask: WideString read FMask write SetMask stored IsMaskStored;
property MultiSelect;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowGlyphs: Boolean read FShowGlyphs write SetShowGlyphs default False;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnClick;
property OnContextPopup;
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;
end;
{ TTntDirectoryListBox }
TTntDirectoryListBox = class(TTntCustomListBox)
private
FFileList: TTntFileListBox;
FDriveCombo: TTntDriveComboBox;
FDirLabel: TTntLabel;
FInSetDir: Boolean;
FPreserveCase: Boolean;
FCaseSensitive: Boolean;
function GetDrive: char;
procedure SetFileListBox(Value: TTntFileListBox);
procedure SetDirLabel(Value: TTntLabel);
procedure SetDirLabelCaption;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure SetDrive(Value: char);
procedure DriveChange(NewDrive: Char);
procedure SetDir(const NewDirectory: WideString);
procedure SetDirectory(const NewDirectory: WideString); virtual;
procedure ResetItemHeight;
protected
ClosedBMP, OpenedBMP, CurrentBMP: TBitmap;
FDirectory: WideString;
FOnChange: TNotifyEvent;
procedure Change; virtual;
procedure DblClick; override;
procedure ReadBitmaps; virtual;
procedure CreateWnd; override;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
function ReadDirectoryNames(const ParentDirectory: WideString;
DirectoryList: TTntStringList): Integer;
procedure BuildList; virtual;
procedure KeyPress(var Key: Char); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function DisplayCase(const S: WideString): WideString;
function FileCompareText(const A, B: WideString): Integer;
function GetItemPath(Index: Integer): WideString;
procedure OpenCurrent;
procedure Update; reintroduce;
property Drive: Char read GetDrive write SetDrive;
property Directory: WideString read FDirectory write SetDirectory;
property PreserveCase: Boolean read FPreserveCase;
property CaseSensitive: Boolean read FCaseSensitive;
published
property Align;
property Anchors;
property AutoComplete;
property BevelEdges;
property BevelInner;
property BevelKind;
property BevelOuter;
property Color;
property Columns;
property Constraints;
property Ctl3D;
property DirLabel: TTntLabel read FDirLabel write SetDirLabel;
property DragCursor;
property DragMode;
property Enabled;
property FileList: TTntFileListBox read FFileList write SetFileListBox;
property Font;
property ImeMode;
property ImeName;
property IntegralHeight;
property ItemHeight;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnClick;
property OnContextPopup;
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;
end;
{ TTntDriveComboBox }
TTextCase = (tcLowerCase, tcUpperCase);
TTntDriveComboBox = class(TTntCustomComboBox)
private
FDirList: TTntDirectoryListBox;
FDrive: Char;
FTextCase: TTextCase;
procedure SetDirListBox (Value: TTntDirectoryListBox);
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure SetDrive(NewDrive: Char);
procedure SetTextCase(NewTextCase: TTextCase);
procedure ReadBitmaps;
procedure ResetItemHeight;
protected
FloppyBMP, FixedBMP, NetworkBMP, CDROMBMP, RAMBMP: TBitmap;
procedure CreateWnd; override;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure Click; override;
procedure BuildList; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Text;
property Drive: Char read FDrive write SetDrive;
published
property Anchors;
property AutoComplete;
property AutoDropDown;
property BevelEdges;
property BevelInner;
property BevelKind;
property BevelOuter;
property Color;
property Constraints;
property Ctl3D;
property DirList: TTntDirectoryListBox read FDirList write SetDirListBox;
property DragMode;
property DragCursor;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property TextCase: TTextCase read FTextCase write SetTextCase default tcLowerCase;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnStartDrag;
end;
{ TTntFilterComboBox }
TTntFilterComboBox = class(TTntCustomComboBox)
private
FFilter: WideString;
FFileList: TTntFileListBox;
MaskList: TTntStringList;
function IsFilterStored: Boolean;
function GetMask: WideString;
procedure SetFilter(const NewFilter: WideString);
procedure SetFileListBox (Value: TTntFileListBox);
protected
procedure Change; override;
procedure CreateWnd; override;
procedure Click; override;
procedure BuildList;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Mask: WideString read GetMask;
property Text;
published
property Anchors;
property AutoComplete;
property AutoDropDown;
property BevelEdges;
property BevelInner;
property BevelKind;
property BevelOuter;
property Color;
property Constraints;
property Ctl3D;
property DragMode;
property DragCursor;
property Enabled;
property FileList: TTntFileListBox read FFileList write SetFileListBox;
property Filter: WideString read FFilter write SetFilter stored IsFilterStored;
property Font;
property ImeName;
property ImeMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnStartDrag;
end;
function WideSelectDirectory2 (var Directory: WideString;
Options: TSelectDirOpts; HelpCtx: Longint): Boolean; overload;
function WideSelectDirectory3 (var Directory: WideString;
Options: TSelectDirOpts; HelpCtx: Longint; DialogFont: TFont): Boolean;
var
FCurrFilePath: WideString;
implementation
uses Consts, RTLConsts, Dialogs, TntDialogs, ShlObj, ActiveX, TntWideStrUtils;
type
TTntPathLabel = class(TTntCustomLabel)
protected
procedure Paint; override;
public
constructor Create(AnOwner: TComponent); override;
published
property Alignment;
property Transparent;
end;
{ TTntSelectDirDlg }
TTntSelectDirDlg = class(TTntForm)
DirList: TTntDirectoryListBox;
DirEdit: TTntEdit;
DriveList: TTntDriveComboBox;
DirLabel: TTntPathLabel;
OKButton: TTntButton;
CancelButton: TTntButton;
HelpButton: TTntButton;
NetButton: TTntButton;
FileList: TTntFileListBox;
procedure DirListChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DriveListChange(Sender: TObject);
procedure NetClick(Sender: TObject);
procedure OKClick(Sender: TObject);
procedure HelpButtonClick(Sender: TObject);
private
{ Private declarations }
FAllowCreate: Boolean;
FPrompt: Boolean;
WNetConnectDialog: function (WndParent: HWND; IType: Longint): Longint;
procedure SetAllowCreate(Value: Boolean);
procedure SetDirectory(const Value: WideString);
function GetDirectory: WideString;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
property Directory: WideString read GetDirectory write SetDirectory;
property AllowCreate: Boolean read FAllowCreate write SetAllowCreate default False;
property Prompt: Boolean read FPrompt write FPrompt default False;
end;
function CurrFilePath: WideString;
begin
if not WideDirectoryExists (FCurrFilePath) then begin
FCurrFilePath := WideExtractFilePath (ParamStr(0));
if FCurrFilePath <> ''
then System.Delete (FCurrFilePath, Length(FCurrFilePath), 1);
end;
Result := FCurrFilePath;
end;
procedure SetCurrFilePath (const Path: WideString);
begin
if WideDirectoryExists (Path)
then FCurrFilePath := Path;
end;
function SlashSep(const Path, S: WideString): WideString;
begin
if TntWideLastChar(Path) <> ''' then
Result := Path + ''' + S
else
Result := Path + S;
end;
{ TTntPathLabel }
constructor TTntPathLabel.Create(AnOwner: TComponent);
begin
inherited Create(AnOwner);
WordWrap := False;
AutoSize := False;
ShowAccelChar := False;
end;
procedure TTntPathLabel.Paint;
const
Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
Rect: TRect;
Temp: WideString;
begin
with Canvas do
begin
Rect := ClientRect;
if not Transparent then
begin
Brush.Color := Self.Color;
Brush.Style := bsSolid;
FillRect(Rect);
end;
Brush.Style := bsClear;
Temp := MinimizeName(Caption, Canvas, Rect.Right - Rect.Left);
Tnt_DrawTextW(Canvas.Handle, PWideChar(Temp), Length(Temp), Rect,
DT_NOPREFIX or Alignments[Alignment]);
end;
end;
{ TTntDriveComboBox }
procedure CutFirstDirectory(var S: TWideFileName);
var
Root: Boolean;
P: Integer;
begin
if S = ''' then
S := ''
else
begin
if S[1] = ''' then
begin
Root := True;
Delete(S, 1, 1);
end
else
Root := False;
if S[1] = '.' then
Delete(S, 1, 4);
P := AnsiPos(''',S);
if P <> 0 then
begin
Delete(S, 1, P);
S := '...'' + S;
end
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -