⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fileexpl27demo2main.pas

📁 TLsDirComboBox 及 TLsFileListView 是类似资源管理器 ( File Explorer ) 式样的加强版 TComboBox 构件
💻 PAS
字号:

{FileExpl27Demo2Main.pas}
{=============================================================================
This Demo was compiled by Delphi 5.0x. The DFM files (ie. FileExpl27Main.dfm
and About,dfm) are saved in binary format instead of its default TextFormat,
thus it will be bachwards compatible with previous versions of Delphi.

If you want to recompile it under Delphi 4 or 3, just load all files (including
FileExpl27Demo.dpr, FileExpl27Demo2Main.pas and About.pas) into Delphi's IDE
befor rebuilding it. However, under D3 you'll encounter many error messages,
because some properties on Form1 and Form2 are not available in D3. But don't
worry, just ignore all error messages, then proceed.

The binary DFM files created by D5 can be converted to D5's default text format
by using 'textDFM' option in D5's context menu.
==============================================================================}

unit FileExpl27Demo2Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons, ExtCtrls, LsFileExplorer27, Menus, ShellAPI,
  FileCtrl;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Btn1LevelUp: TSpeedButton;
    BtnIcon: TSpeedButton;
    BtnSIcon: TSpeedButton;
    BtnList: TSpeedButton;
    BtnReport: TSpeedButton;
    Panel2: TPanel;
    Panel4: TPanel;
    MaskCombo1: TComboBox;
    Edit1: TEdit;
    Label4: TLabel;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    ChBxShowFolders: TCheckBox;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Edit2: TMenuItem;
    View1: TMenuItem;
    Open1: TMenuItem;
    N1: TMenuItem;
    Delete1: TMenuItem;
    Rename1: TMenuItem;
    N3: TMenuItem;
    NewFolder1: TMenuItem;
    N4: TMenuItem;
    Close1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    N5: TMenuItem;
    SelectAll1: TMenuItem;
    LargeIcon1: TMenuItem;
    SmallIcon1: TMenuItem;
    List1: TMenuItem;
    Detail1: TMenuItem;
    N6: TMenuItem;
    Refresh1: TMenuItem;
    Tool1: TMenuItem;
    Find1: TMenuItem;
    GoTo1: TMenuItem;
    QuickView1: TMenuItem;
    Help1: TMenuItem;
    ShortCuts1: TMenuItem;
    ShortCuts2: TMenuItem;
    N2: TMenuItem;
    About1: TMenuItem;
    FileAttr1: TMenuItem;
    LsFilelistView271: TLsFilelistView27;
    LsDirTreeCombo271: TLsDirTreeCombo27;
    procedure FormCreate(Sender: TObject);
    procedure GetStatistics(Sender: TObject);
    procedure LsFilelistView271MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ChBxShowFoldersClick(Sender: TObject);
    procedure LsFilelistView271Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure MaskCombo1Change(Sender: TObject);
    procedure Btn1LevelUpClick(Sender: TObject);
    procedure Find1Click(Sender: TObject);
    procedure GoTo1Click(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure MainMenu1Click(Sender: TObject);
    procedure MenuItemClick(Sender: TObject);
    procedure ViewStyleBtnClick(Sender: TObject);
    procedure ViewStyleMenuClick(Sender: TObject);
    procedure LsFilelistView271KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
  { Private declarations }
    CanPaste: Boolean;
  public
  { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses About;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  CurDir: string;
begin
  CanPaste := False;
  LsDirTreeCombo271.TreeHeight := 274;
  CurDir := GetCurrentDir;
  if CurDir[length(CurDir)] <> '\' then
    CurDir := CurDir + '\';
  LsDirTreeCombo271.OpenPath(CurDir);
  LsFilelistView271.Directory := CurDir;
end;

procedure TForm1.GetStatistics(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := '';
  StatusBar1.Panels[1].Text := '';
  with LsFilelistView271 do
  begin
    if Selected <> nil then
    begin
      StatusBar1.Panels[0].Text := IntToStr(Items.Count) + ' object(s)  --  ' +
        IntToStr(SelectedNumber) + '  selected ';
      StatusBar1.Panels[1].Text := ' Selected Size = ' +
        FormatFloat('###,##0.00 KB', (SelectedSize / 1024)) +
        '( Disk free space: ' +
        FormatFloat('###,### MB', (DriveFreeSpace)) + ' )';
    end
    else begin
      StatusBar1.Panels[0].Text := IntToStr(Items.Count) + ' object(s)';
      StatusBar1.Panels[1].Text := ' Selected Size = 0 KB' +
        '  ( Disk free space: ' +
        FormatFloat('###,### MB', (DriveFreeSpace)) + ' )';
    end;
  end;
// Edit1.Text := LsFilelistView271.Directory;
end;

procedure TForm1.LsFilelistView271MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  GetStatistics(Sender);
end;

procedure TForm1.Btn1LevelUpClick(Sender: TObject);
begin
  LsFilelistView271.OneLevelUp;
  Edit1.Text := LsFilelistView271.Directory;
  GetStatistics(Sender);
end;

procedure TForm1.ChBxShowFoldersClick(Sender: TObject);
begin
  with ChBxShowFolders do
  begin
    if Checked = True then
      LsFilelistView271.ShowFolders := True
    else
      LsFilelistView271.ShowFolders := False;
  end;
end;

procedure TForm1.LsFilelistView271Change(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  Edit1.Text := LsFilelistView271.Directory;
end;

procedure TForm1.MaskCombo1Change(Sender: TObject);
begin
  LsFilelistView271.Mask := MaskCombo1.Text;
end;

procedure TForm1.Find1Click(Sender: TObject);
begin
  LsFilelistView271.FindFile;
end;

procedure TForm1.GoTo1Click(Sender: TObject);
var
  PathName: string;
begin
  InputQuery('Go to Folder', 'Enter the name and path of the folder to open',
    PathName);
  if (PathName = '') or (Length(PathName) = 1) then exit;
  if PathName[Length(PathName)] <> '\' then
    PathName := PathName + '\';
  if DirectoryExists(PathName) then
  begin
    LsFilelistView271.Directory := PathName;
    LsDirTreeCombo271.OpenPath(PathName);
  end
  else begin
    if (Length(PathName) <= 3) and (PathName[2] = ':') then
      MessageDlg(UpperCase(PathName) + '  not ready', mtError, [mbOK], 0)
    else
      MessageDlg(PathName + '  not found', mtError, [mbOK], 0);
    exit;
  end;
end;

procedure TForm1.Close1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.MainMenu1Click(Sender: TObject);
begin
  with LsFilelistView271 do
  begin
    Open1.Enabled := Selected <> nil;
    QuickView1.Enabled := Selected <> nil;
    Delete1.Enabled := Selected <> nil;
    ReName1.Enabled := Selected <> nil;
    FileAttr1.Enabled := Selected <> nil;
    NewFolder1.Enabled := UpperCase(Directory) <> 'DRIVES';
    Cut1.Enabled := Selected <> nil;
    Copy1.Enabled := Selected <> nil;
    Paste1.Enabled := CanPaste;
    Find1.Enabled := Focused; //Selected <> nil;
    SelectAll1.Enabled := Focused;
  end;
end;

procedure TForm1.MenuItemClick(Sender: TObject);
var
  i: integer;
begin
  with sender as TMenuItem do
  begin // MenuItem
    case Tag of // -----------
      1: LsFilelistView271.OpenItem; // Open1
      2: LsFilelistView271.ViewFile; // QuickView1
      3: LsFilelistView271.DeleteItems; // Delete1
      4: LsFilelistView271.ReNameFile; // Rename1
      5: LsFilelistView271.FileAttr; // Attributes
      6: LsFilelistView271.NewFolder; // NewFolder1

      11: begin // Cut
          LsFilelistView271.CutCopy(2);
          Cut1.Enabled := False;
          CanPaste := True;
        end;
      12: begin // Copy
          LsFilelistView271.CutCopy(0);
          Copy1.Enabled := False;
          CanPaste := True;
        end;
      13: begin // Paste
          LsFilelistView271.Paste;
          CanPaste := False;
          Cut1.Enabled := True;
          Copy1.Enabled := True;
        end;
      14: begin // Select All
          with LsFilelistView271 do
          begin
            if Items.Count = 0 then exit;
            for i := 0 to Items.Count - 1 do
              Selected := Items[i];
          end;
        end;
      25: LsFilelistView271.UpdateFileList; // Refresh

      41: begin // LsDirTreeCombo25 ShortCuts
          Form2.PageControl1.ActivePage := Form2.TabSheet1;
          Form2.ShowModal;
        end;
      42: begin // LsFileListView25 ShortCuts
          Form2.PageControl1.ActivePage := Form2.TabSheet2;
          Form2.ShowModal;
        end;
      43: begin // About LsFileExolorer25
          Form2.PageControl1.ActivePage := Form2.TabSheet3;
          Form2.ShowModal;
        end;
    end; // case
  end; // with
end;

procedure TForm1.ViewStyleBtnClick(Sender: TObject);
begin
  with Sender as TSpeedButton do
  begin
    case tag of
      1: LsFilelistView271.ViewStyle := vsIcon;
      2: LsFilelistView271.ViewStyle := vsSmallIcon;
      3: LsFilelistView271.ViewStyle := vsList;
      4: LsFilelistView271.ViewStyle := vsReport;
    end;
  end;
end;

procedure TForm1.ViewStyleMenuClick(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    case tag of
      21: LsFilelistView271.ViewStyle := vsIcon;
      22: LsFilelistView271.ViewStyle := vsSmallIcon;
      23: LsFilelistView271.ViewStyle := vsList;
      24: LsFilelistView271.ViewStyle := vsReport;
    end;
  end;
end;

procedure TForm1.LsFilelistView271KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_Return) or (key = VK_Space) or (Key = VK_BACK) then
    GetStatistics(Sender);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -