📄 dcfolderview.pas
字号:
FullFolderName := FindUnusedFolderName(IncludeTrailingBackslash(Folder) + FolderName);
FolderName := ExtractFileName(FullFolderName);
if CreateDirectory(PChar(FullFolderName), nil) then
begin
{ checking the created folder to retrieve information }
FindHandle := FindFirstFile(PChar(FullFolderName), FindData);
if FindHandle <> INVALID_HANDLE_VALUE then
with FindData do
begin
Windows.FindClose(FindHandle);
{ retrieving the folder information and adding to internal list }
ShGetFileInfo(PChar(FullFolderName), 0, ShInfo, SizeOf(TShFileInfo), SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
ShObject := TdcShellObject.Create(FullFolderName, ShInfo.szTypeName,
0, UTCFileTimeToDateTime(FindData.ftLastWriteTime),
[saDirectory], ShInfo.iIcon);
FFiles.Add(ShObject);
{ adding list item}
if Edit then
TListItem(ShObject.ApplyToListView(Self)).EditCaption;
end;
end;
end;
procedure TdcFolderListView.CreateShortcut;
begin
try
WinExec(PChar('rundll32 appwiz.cpl,NewLinkHere ' + Folder), SW_SHOWNORMAL);
except
end;
end;
{$IFDEF D3}
procedure TdcFolderListView.ShowFolderProperties;
begin
FShellProperties.ShowPropertiesByFile(Folder);
end;
procedure TdcFolderListView.ShowItemProperties;
begin
if Selected <> nil then
FShellProperties.ShowPropertiesByFile(FileNameByListItem(Selected));
end;
{$ENDIF}
procedure TdcFolderListView.Refresh;
begin
if not (csLoading in ComponentState) and
not (csReading in ComponentState) and
not FDiskScanner.Busy and not Busy then
begin
Busy := True;
ListUpdated := True;
if Columns.Count = 0 then InitColumns;
if Assigned(FOnBeginUpdate) then
FOnBeginUpdate(Self);
if Assigned(FFolderMonitor) then
begin
FFolderMonitor.Active := False;
FFolderMonitor.Folder := Folder;
end;
if not (csDesigning in ComponentState) then
begin
OldControlCursor := Cursor;
Cursor := crHourglass;
end;
Items.BeginUpdate;
FFiles.Clear;
Items.Clear;
Items.EndUpdate;
FDiskScanner.Execute;
end;
end;
{ event handlers }
procedure TdcFolderListView.ScanDone(Sender: TObject; TotalFiles: Integer;
const TotalSize: Extended; ElapsedTimeInSeconds: Integer);
begin
UpdateListItems;
if not (csDesigning in ComponentState) then
Cursor := OldControlCursor;
if Assigned(FFolderMonitor) then
FFolderMonitor.Active := True;
if Assigned(FOnEndUpdate) then
FOnEndUpdate(Self);
Busy := False;
end;
procedure TdcFolderListView.FileFound(Sender: TObject;
const FileName, FileType: String;
const FileSize: Extended; const FileTime: TDateTime;
const FileAttributes: TdcScanAttributes;
const LargeIcon, SmallIcon: TIcon; SysImageIndex: Integer;
TotalFiles: Integer; const TotalSize: Extended);
var
ShellObject: TdcShellObject;
begin
ShellObject := TdcShellObject.Create(FileName, FileType,
FileSize, FileTime, FileAttributes, SysImageIndex);
FFiles.Add(ShellObject);
end;
procedure TdcFolderListView.FolderMonitorOnChange(Sender: TObject);
begin
Refresh;
end;
procedure TdcFolderListView.ContextMenuOnDelete(Sender: TObject; const FileName: String);
var
ShellObject: TdcShellObject;
begin
if Selected <> nil then
begin
{ delete record from list }
try
ShellObject := Selected.Data;
FFiles.Remove(ShellObject);
except
end;
{ delete list item }
Items.Delete(Selected.Index);
end;
end;
procedure TdcFolderListView.ContextMenuOnRename(Sender: TObject; const FileName: String);
begin
if Selected <> nil then Selected.EditCaption;
end;
{ public methods }
function TdcFolderListView.FileNameByListItem(ListItem: TListItem): String;
begin
Result := '';
if ListItem <> nil then
try
Result := TdcShellObject(ListItem.Data).FileName;
except
end
end;
function TdcFolderListView.FileSizeByListItem(ListItem: TListItem): Extended;
begin
Result := -1;
if ListItem <> nil then
try
Result := TdcShellObject(ListItem.Data).FileSize;
except
end
end;
function TdcFolderListView.FileTypeByListItem(ListItem: TListItem): String;
begin
Result := '';
if ListItem <> nil then
try
Result := TdcShellObject(ListItem.Data).FileType;
except
end
end;
function TdcFolderListView.FileTimeByListItem(ListItem: TListItem): TDateTime;
begin
Result := -1;
if ListItem <> nil then
try
Result := TdcShellObject(ListItem.Data).FileTime;
except
end
end;
function TdcFolderListView.FileAttributesByListItem(ListItem: TListItem): TdcScanAttributes;
begin
Result := [];
if ListItem <> nil then
try
Result := TdcShellObject(ListItem.Data).Attributes;
except
end
end;
function TdcFolderListView.ListItemByFileName(FileName: String): TListItem;
var
I: Integer;
begin
Result := nil;
I := FFiles.Count;
if I <> 0 then
for I := 0 to I - 1 do
if TdcShellObject(FFiles[I]).FileName = FileName then
begin
Result := TdcShellObject(FFiles[I]).ListItem;
Exit;
end;
end;
function TdcFolderListView.DeleteSelectedFiles: Boolean;
var
I: Integer;
St: String;
Lst: TList;
ShellObject: TdcShellObject;
FileOperations: TdcFileOperations;
begin
Result := False;
I := Items.Count;
if I = 0 then Exit;
Lst := TList.Create;
FileOperations := TdcFileOperations.Create(Self);
with FileOperations do
try
try
for I := 0 to I - 1 do
if Items[I].Selected then
begin
St := FileNameByListItem(Items[I]);
FileList.Add('"' + St + '"');
Lst.Add(Items[I]);
end;
ListUpdated := False;
Result := FileOperations.Delete;
{ if command confirmed }
if Result and not ListUpdated and (Lst.Count <> 0) then
begin
Items.BeginUpdate;
for I := Lst.Count - 1 downto 0 do
begin
try
ShellObject := TListItem(Lst[I]).Data;
FFiles.Remove(ShellObject);
except
end;
{ delete list item }
Items.Delete(TListItem(Lst[I]).Index);
end;
Items.EndUpdate;
end;
except
end;
finally
Free;
end;
Lst.Free;
end;
{ properties }
function TdcFolderListView.GetFolder: String;
begin
Result := FDiskScanner.Folder;
end;
procedure TdcFolderListView.SetFolder(const Value: String);
begin
if LowerCase(IncludeTrailingBackslash(FDiskScanner.Folder)) <> LowerCase(IncludeTrailingBackslash(Value)) then
begin
FDiskScanner.Folder := Value;
Refresh;
end;
end;
function TdcFolderListView.GetFileMask: String;
begin
Result := FDiskScanner.SearchMask;
end;
procedure TdcFolderListView.SetFileMask(const Value: String);
begin
if LowerCase(FDiskScanner.SearchMask) <> LowerCase(Value) then
begin
FDiskScanner.SearchMask := Value;
Refresh;
end;
end;
procedure TdcFolderListView.SetFolderMonitor(Value: TdcFolderMonitor);
begin
if FFolderMonitor <> Value then
begin
FFolderMonitor := Value;
if Value <> nil then
begin
FFolderMonitor.Active := True;
FFolderMonitor.Folder := Folder;
FFolderMonitor.OnChange := FolderMonitorOnChange;
Value.FreeNotification(Self);
end;
end;
end;
function TdcFolderListView.GetFileAttributes: TdcScanAttributes;
begin
Result := FDiskScanner.SearchAttributes;
end;
procedure TdcFolderListView.SetFileAttributes(Value: TdcScanAttributes);
begin
if FDiskScanner.SearchAttributes <> Value then
begin
FDiskScanner.SearchAttributes := Value;
Refresh;
end;
end;
function TdcFolderListView.GetReadOnly: Boolean;
begin
Result := inherited ReadOnly;
end;
procedure TdcFolderListView.SetReadOnly(Value: Boolean);
begin
inherited ReadOnly := Value;
{$IFDEF D3}
with FShellProperties do
if Value then
MenuOptions := MenuOptions - [moCanRename]
else
MenuOptions := MenuOptions + [moCanRename];
{$ENDIF}
end;
function TdcFolderListView.GetShowAllFolders: Boolean;
begin
Result := FDiskScanner.FindAllFolders;
end;
procedure TdcFolderListView.SetShowAllFolders(Value: Boolean);
begin
FDiskScanner.FindAllFolders := Value;
if HandleAllocated then Refresh;
end;
procedure TdcFolderListView.SetShowFileExtensions(Value: Boolean);
begin
if FShowFileExtensions <> Value then
begin
FShowFileExtensions := Value;
UpdateListItems;
end;
end;
procedure TdcFolderListView.SetKBStr(Value: String);
begin
if FKBStr <> Value then
begin
FKBStr := Value;
UpdateListItems;
end;
end;
{ misc functions }
procedure TdcFolderListView.WMLButtonDblClk(var Msg: TWMLButtonDblClk);
begin
inherited;
ExecuteListItem(GetItemAt(Msg.XPos, Msg.YPos));
end;
procedure TdcFolderListView.WMRButtonDown(var Msg: TWMRButtonDown);
var
ListItem: TListItem;
begin
ListItem := GetItemAt(Msg.XPos, Msg.YPos);
if (ListItem <> nil) and (floShowContextMenu in FOptions) then
begin
SetFocus;
if MultiSelect then UnselectAll;
ListItem.Selected := True;
{$IFDEF D3}
with FShellProperties do
begin
if floAllowDelete in FOptions then
MenuOptions := MenuOptions + [moAllowDelete]
else
MenuOptions := MenuOptions - [moAllowDelete];
ShowContextMenuByFile(FileNameByListItem(ListItem));
end;
{$ENDIF}
end
else inherited;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -