home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kompon / d3456 / FILEEXPL.ZIP / Demo2 / FileExpl2873_Demo2Main.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2002-03-08  |  13.7 KB  |  489 lines
  1.  
  2. {FileExpl28_Demo2Main.pas}
  3. {=============================================================================
  4. This Demo was compiled by Delphi 6.0x. The DFM files (i.e. About.dfm and
  5. FileExpl28_Demo2Main.dfm) are saved in binary format instead of its default
  6. TextFormat, thus it will be bachwards compatible with previous versions of Delphi.
  7.  
  8. If you want to recompile it under Delphi 5, 4 or 3, just load all files (including
  9. FileExpl28_Demo.dpr, FileExpl28_Demo2Main.pas and About.pas) into Delphi's IDE
  10. befor rebuilding it. However, under D3 you'll encounter error messages, because
  11. some properties on Form1 and Form2 are not available in D3.  But don't worry,
  12. just ignore all error messages, then proceed.
  13.  
  14. These binary DFM files created by D6 can be converted to default text format
  15. by using 'textDFM' option in D5/D6's context menu.
  16. ==============================================================================}
  17.  
  18. unit FileExpl2873_Demo2Main;
  19.  
  20. interface
  21.  
  22. {$IFDEF VER140}
  23.   {$WARN UNIT_PLATFORM OFF}
  24. {$ENDIF}
  25.  
  26. uses
  27.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  28.   ComCtrls, StdCtrls, Buttons, ExtCtrls, LsFileExplorer28, Menus, ShellAPI,
  29.   FileCtrl, ImgList, ToolWin;
  30.  
  31. type
  32.   TForm1 = class(TForm)
  33.     Panel1: TPanel;
  34.     Panel2: TPanel;
  35.     Panel4: TPanel;
  36.     MaskCombo1: TComboBox;
  37.     Edit1: TEdit;
  38.     Label4: TLabel;
  39.     StatusBar1: TStatusBar;
  40.     Label1: TLabel;
  41.     MainMenu1: TMainMenu;
  42.     File1: TMenuItem;
  43.     Edit2: TMenuItem;
  44.     View1: TMenuItem;
  45.     Open1: TMenuItem;
  46.     N1: TMenuItem;
  47.     Delete1: TMenuItem;
  48.     Rename1: TMenuItem;
  49.     N3: TMenuItem;
  50.     NewFolder1: TMenuItem;
  51.     N4: TMenuItem;
  52.     Close1: TMenuItem;
  53.     Cut1: TMenuItem;
  54.     Copy1: TMenuItem;
  55.     Paste1: TMenuItem;
  56.     N5: TMenuItem;
  57.     SelectAll1: TMenuItem;
  58.     LargeIcon1: TMenuItem;
  59.     SmallIcon1: TMenuItem;
  60.     List1: TMenuItem;
  61.     Detail1: TMenuItem;
  62.     N6: TMenuItem;
  63.     Refresh1: TMenuItem;
  64.     Tool1: TMenuItem;
  65.     Find1: TMenuItem;
  66.     GoTo1: TMenuItem;
  67.     QuickView1: TMenuItem;
  68.     Help1: TMenuItem;
  69.     ShortCuts1: TMenuItem;
  70.     ShortCuts2: TMenuItem;
  71.     N2: TMenuItem;
  72.     About1: TMenuItem;
  73.     Properties1: TMenuItem;
  74.     LsFilelistView281: TLsFilelistView28;
  75.     N7: TMenuItem;
  76.     ShowFolders1: TMenuItem;
  77.     HideFileExtensions1: TMenuItem;
  78.     Panel3: TPanel;
  79.     ToolBar1: TToolBar;
  80.     LsDirTreeCombo281: TLsDirTreeCombo28;
  81.     Btn1LevelUp: TToolButton;
  82.     BtnRefresh: TToolButton;
  83.     BtnShowFolder: TToolButton;
  84.     BtnHideFileExt: TToolButton;
  85.     BtnSelectViewStyles: TToolButton;
  86.     BtnClose: TToolButton;
  87.     ImageList1: TImageList;
  88.     ImageList2: TImageList;
  89.     PopupMenu1: TPopupMenu;
  90.     LargeIcons1: TMenuItem;
  91.     SmallIcons1: TMenuItem;
  92.     List2: TMenuItem;
  93.     Details1: TMenuItem;
  94.     BtnMapDrv: TToolButton;
  95.     BtnDisconnect: TToolButton;
  96.     Language1: TMenuItem;
  97.     English1: TMenuItem;
  98.     French1: TMenuItem;
  99.     German1: TMenuItem;
  100.     Spanish1: TMenuItem;
  101.     SystemDefault1: TMenuItem;
  102.     Portuguese1: TMenuItem;
  103.     procedure FormCreate(Sender: TObject);
  104.     procedure GetStatistics(Sender: TObject);
  105.     procedure LsFilelistView281MouseUp(Sender: TObject; Button: TMouseButton;
  106.       Shift: TShiftState; X, Y: Integer);
  107.     procedure MaskCombo1Change(Sender: TObject);
  108.     procedure Find1Click(Sender: TObject);
  109.     procedure GoTo1Click(Sender: TObject);
  110.     procedure Close1Click(Sender: TObject);
  111.     procedure MainMenu1Click(Sender: TObject);
  112.     procedure MenuItemClick(Sender: TObject);
  113.     procedure ViewStyleClick(Sender: TObject);
  114.     procedure ViewStyleMenuClick(Sender: TObject);
  115.     procedure LsFilelistView281KeyUp(Sender: TObject; var Key: Word;
  116.       Shift: TShiftState);
  117. //    procedure ConnecttoNetwork1Click(Sender: TObject);
  118. //    procedure DisconnectfromNetwork1Click(Sender: TObject);
  119.     procedure Btn1LevelUpClick(Sender: TObject);
  120.     procedure BtnRefreshClick(Sender: TObject);
  121.     procedure BtnShowFolderClick(Sender: TObject);
  122.     procedure BtnCloseClick(Sender: TObject);
  123.     procedure BtnHideFileExtClick(Sender: TObject);
  124.     procedure LsDirTreeCombo281PathChange(Sender: TObject;
  125.       SelectedPath: String);
  126.     procedure BtnSelectViewStylesClick(Sender: TObject);
  127.     procedure BtnMapDrvClick(Sender: TObject);
  128.     procedure BtnDisconnectClick(Sender: TObject);
  129.     procedure LanguageClick(Sender: TObject);
  130.  
  131.   private
  132.   { Private declarations }
  133.     CanPaste: Boolean;
  134.   public
  135.   { Public declarations }
  136.   end;
  137.  
  138. var
  139.   Form1: TForm1;
  140.  
  141. implementation
  142.  
  143. uses About;
  144.  
  145. {$R *.DFM}
  146.  
  147. procedure TForm1.FormCreate(Sender: TObject);
  148. var
  149.   CurDir: string;
  150. begin
  151.   CanPaste := False;
  152.   LsDirTreeCombo281.TreeHeight := 308; //274;
  153.   CurDir := GetCurrentDir;
  154.   if CurDir[length(CurDir)] <> '\' then
  155.     CurDir := CurDir + '\';
  156.   LsDirTreeCombo281.OpenPath(CurDir);
  157.   LsFilelistView281.Directory := CurDir;
  158. //  Edit1.Text := CurDir;  //LsFilelistView281.Directory;
  159.   Edit1.Text := MinimizeName(CurDir, Canvas, 320);  
  160. end;
  161.  
  162. procedure TForm1.GetStatistics(Sender: TObject);
  163. begin
  164.   StatusBar1.Panels[0].Text := '';
  165.   StatusBar1.Panels[1].Text := '';
  166.   with LsFilelistView281 do
  167.   begin
  168.     if Selected <> nil then
  169.     begin
  170.       StatusBar1.Panels[0].Text := IntToStr(Items.Count) + ' object(s)  --  ' +
  171.         IntToStr(SelectedNumber) + '  selected ';
  172.       StatusBar1.Panels[1].Text := ' Selected Size = ' +
  173.         FormatFloat('###,##0.00 KB', (SelectedSize / 1024)) +
  174.         '( Disk free space: ' +
  175.         FormatFloat('###,### MB', (DriveFreeSpace)) + ' )';
  176.     end
  177.     else begin
  178.       StatusBar1.Panels[0].Text := IntToStr(Items.Count) + ' object(s)';
  179.       StatusBar1.Panels[1].Text := ' Selected Size = 0 KB' +
  180.         '  ( Disk free space: ' +
  181.         FormatFloat('###,### MB', (DriveFreeSpace)) + ' )';
  182.     end;
  183.   end;
  184. end;
  185.  
  186. procedure TForm1.LsFilelistView281MouseUp(Sender: TObject;
  187.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  188. begin
  189.   GetStatistics(Sender);
  190. end;
  191.  
  192. procedure TForm1.Btn1LevelUpClick(Sender: TObject);
  193. begin
  194.   LsFilelistView281.OneLevelUp;
  195. //  Edit1.Text := LsFilelistView281.Directory;
  196.   Edit1.Text := MinimizeName(LsFilelistView281.Directory, Canvas, 320); 
  197.   GetStatistics(Sender);
  198. end;
  199.  
  200. procedure TForm1.MaskCombo1Change(Sender: TObject);
  201. begin
  202.   LsFilelistView281.Mask := MaskCombo1.Text;
  203. end;
  204.  
  205. procedure TForm1.Find1Click(Sender: TObject);
  206. begin
  207.   LsFilelistView281.FindFile;
  208. end;
  209.  
  210. procedure TForm1.GoTo1Click(Sender: TObject);
  211. var
  212.   PathName: string;
  213. begin
  214.   InputQuery('Go to Folder', 'Enter the name and path of the folder to open',
  215.     PathName);
  216.   if (PathName = '') or (Length(PathName) = 1) then exit;
  217.   if PathName[Length(PathName)] <> '\' then
  218.     PathName := PathName + '\';
  219.   if DirectoryExists(PathName) then
  220.   begin
  221.     LsFilelistView281.Directory := PathName;
  222.     LsDirTreeCombo281.OpenPath(PathName);
  223.   end
  224.   else begin
  225.     if (Length(PathName) <= 3) and (PathName[2] = ':') then
  226.       MessageDlg(UpperCase(PathName) + '  not ready', mtError, [mbOK], 0)
  227.     else
  228.       MessageDlg(PathName + '  not found', mtError, [mbOK], 0);
  229.     exit;
  230.   end;
  231. end;
  232.  
  233. procedure TForm1.Close1Click(Sender: TObject);
  234. begin
  235.   Close;
  236. end;
  237.  
  238. procedure TForm1.MainMenu1Click(Sender: TObject);
  239. begin
  240.   with LsFilelistView281 do
  241.   begin
  242.     Open1.Enabled := Selected <> nil;
  243.     QuickView1.Enabled := Selected <> nil;
  244.     Delete1.Enabled := Selected <> nil;
  245.     ReName1.Enabled := Selected <> nil;
  246.     Properties1.Enabled := Selected <> nil;
  247.     NewFolder1.Enabled := UpperCase(Directory) <> 'DRIVES';
  248.     Cut1.Enabled := Selected <> nil;
  249.     Copy1.Enabled := Selected <> nil;
  250.     Paste1.Enabled := CanPaste;
  251.     Find1.Enabled := Focused; //Selected <> nil;
  252.     SelectAll1.Enabled := Focused;
  253.   end;
  254. end;
  255.  
  256. procedure TForm1.MenuItemClick(Sender: TObject);
  257. var
  258.   i: integer;
  259. begin
  260.   with sender as TMenuItem do
  261.   begin // MenuItem
  262.     case Tag of // -----------
  263.       1: LsFilelistView281.OpenItem; // Open1
  264.       2: LsFilelistView281.ViewFile; // QuickView1
  265.       3: LsFilelistView281.DeleteItems; // Delete1
  266.       4: LsFilelistView281.ReNameFile; // Rename1
  267.       {$IFDEF VER100}
  268.       5: LsFilelistView281.FileAttr; //861
  269.       {$ELSE}
  270.       5: LsFilelistView281.ShowFileProperties; // Properties
  271.       {$ENDIF}
  272.       6: LsFilelistView281.NewFolder; // NewFolder1
  273.  
  274.       11: begin // Cut
  275.           LsFilelistView281.CutCopy(2);
  276.           Cut1.Enabled := False;
  277.           CanPaste := True;
  278.         end;
  279.       12: begin // Copy
  280.           LsFilelistView281.CutCopy(0);
  281.           Copy1.Enabled := False;
  282.           CanPaste := True;
  283.         end;
  284.       13: begin // Paste
  285.           LsFilelistView281.Paste;
  286.           CanPaste := False;
  287.           Cut1.Enabled := True;
  288.           Copy1.Enabled := True;
  289.         end;
  290.       14: begin // Select All
  291.           with LsFilelistView281 do
  292.           begin
  293.             if Items.Count = 0 then exit;
  294.             for i := 0 to Items.Count - 1 do
  295.               Selected := Items[i];
  296.           end;
  297.         end;
  298.       25: LsFilelistView281.UpdateFileList; // Refresh
  299.  
  300.       41: begin // LsDirTreeCombo25 ShortCuts
  301.           Form2.PageControl1.ActivePage := Form2.TabSheet1;
  302.           Form2.ShowModal;
  303.         end;
  304.       42: begin // LsFileListView25 ShortCuts
  305.           Form2.PageControl1.ActivePage := Form2.TabSheet2;
  306.           Form2.ShowModal;
  307.         end;
  308.       43: begin // About LsFileExolorer25
  309.           Form2.PageControl1.ActivePage := Form2.TabSheet3;
  310.           Form2.ShowModal;
  311.         end;
  312.     end; // case
  313.   end; // with
  314. end;
  315.  
  316. procedure TForm1.ViewStyleClick(Sender: TObject);
  317. begin
  318.   with Sender as TMenuItem do
  319.   begin
  320.     case tag of
  321.       1: LsFilelistView281.ViewStyle := vsIcon;
  322.       2: LsFilelistView281.ViewStyle := vsSmallIcon;
  323.       3: LsFilelistView281.ViewStyle := vsList;
  324.       4: LsFilelistView281.ViewStyle := vsReport;
  325.     end;
  326.   end;
  327. end;
  328.  
  329. procedure TForm1.ViewStyleMenuClick(Sender: TObject);
  330. begin
  331.   with Sender as TMenuItem do
  332.   begin
  333.     case tag of
  334.       21: LsFilelistView281.ViewStyle := vsIcon;
  335.       22: LsFilelistView281.ViewStyle := vsSmallIcon;
  336.       23: LsFilelistView281.ViewStyle := vsList;
  337.       24: LsFilelistView281.ViewStyle := vsReport;
  338.     end;
  339.   end;
  340. end;
  341.  
  342. procedure TForm1.LsFilelistView281KeyUp(Sender: TObject; var Key: Word;
  343.   Shift: TShiftState);
  344. begin
  345.   if (Key = VK_Return) or (key = VK_Space) or (Key = VK_BACK) then
  346.   begin
  347.     GetStatistics(Sender);
  348. //    Edit1.Text := LsFileListView281.Directory;
  349.   end;
  350. end;
  351.  
  352. procedure TForm1.BtnRefreshClick(Sender: TObject);
  353. var
  354.   TreePath: string;
  355. begin
  356.   with LsDirTreeCombo281 do
  357.   begin
  358.     if (SelectedPath <> '') then
  359.       TreePath := SelectedPath;
  360.     ResetTreeView;
  361.     OpenPath(TreePath);
  362.   end;
  363.   LsFilelistView281.Directory := TreePath;
  364. //  LsFilelistView281.UpdateFileList;
  365. end;
  366.  
  367. {**
  368. procedure TForm1.ConnecttoNetwork1Click(Sender: TObject);
  369. var
  370.   Drives: set of 0..25;
  371.   ADrv: integer;
  372.   DrvLtr: Char;
  373. begin
  374.   DrvLtr := ' ';
  375.   Integer(Drives) := GetLogicalDrives;
  376.   for ADrv := 0 to 25 do
  377.     if ADrv in Drives then
  378.       DrvLtr := Chr(ADrv + Ord('B'));
  379.   if WNetConnectionDialog(Application.Handle, RESOURCETYPE_DISK) =
  380.     NO_ERROR then
  381.   begin
  382.     LsDirTreeCombo281.SelectedPath := (DrvLtr + ':\');
  383.     BtnRefreshClick(Sender);
  384.   end;
  385. end;
  386. **}
  387.  
  388. {**
  389. procedure TForm1.DisconnectfromNetwork1Click(Sender: TObject);
  390. begin
  391.   WNetDisconnectDialog(Application.Handle, RESOURCETYPE_DISK);
  392.   LsDirTreeCombo281.SelectedPath := 'Drives';
  393.   BtnRefreshClick(Sender);
  394.   LsDirTreeCombo281.ExpandRoot := True;
  395. end;
  396. **}
  397.  
  398. procedure TForm1.BtnShowFolderClick(Sender: TObject);
  399. begin
  400.   if LsFilelistView281.ShowFolders = True then
  401.   begin
  402.     LsFilelistView281.ShowFolders := False;
  403.     BtnShowFolder.Down := False;
  404.   end
  405.   else begin
  406.     LsFilelistView281.ShowFolders := True;
  407.     BtnShowFolder.Down := True;
  408.   end;
  409. end;
  410.  
  411. procedure TForm1.BtnCloseClick(Sender: TObject);
  412. begin
  413.   Close;
  414. end;
  415.  
  416. procedure TForm1.BtnHideFileExtClick(Sender: TObject);
  417. begin
  418.   with LsFileListView281 do
  419.   begin
  420.     if HideFileExt = True then
  421.     begin
  422.       HideFileExt := False;
  423.       BtnHideFileExt.Down := False;
  424.     end
  425.     else begin
  426.       HideFileExt := True;
  427.       BtnHideFileExt.Down := True;
  428.     end;
  429.     UpdateFileList;
  430.   end;
  431. end;
  432.  
  433. procedure TForm1.LsDirTreeCombo281PathChange(Sender: TObject;
  434.   SelectedPath: String);
  435. begin
  436. //  Edit1.Text := LsDirTreeCombo281.SelectedPath;
  437.   Edit1.Text := MinimizeName(LsDirTreeCombo281.SelectedPath, canvas, 320);  
  438. end;
  439.  
  440.  
  441. procedure TForm1.BtnSelectViewStylesClick(Sender: TObject);
  442. begin
  443.   with LsFileListView281 do
  444.   begin
  445.     if ViewStyle = vsIcon then
  446.       ViewStyle := vsSmallIcon
  447.     else if ViewStyle = vsSmallIcon then
  448.       ViewStyle := vsList
  449.     else if ViewStyle = vsList then
  450.       ViewStyle := vsReport
  451.     else if ViewStyle = vsReport then
  452.       ViewStyle := vsIcon;
  453.   end;
  454. end;
  455.  
  456. procedure TForm1.BtnMapDrvClick(Sender: TObject);
  457. begin
  458.   LsDirTreeCombo281.ConnectNetResource(Sender);
  459. end;
  460.  
  461. procedure TForm1.BtnDisconnectClick(Sender: TObject);
  462. begin
  463.   LsDirTreeCombo281.DisconnectNetResource(Sender);
  464. end;
  465.  
  466. procedure TForm1.LanguageClick(Sender: TObject);
  467. var
  468.   CurDir: String;
  469. begin
  470.   CurDir := GetCurrentDir;
  471.   with Sender as TMenuItem do
  472.   begin
  473.     case Tag of
  474.       0: LsFileListView281.Language := lnEnglish;
  475.       1: LsFileListView281.Language := lnFrench;
  476.       2: LsFileListView281.Language := lnGerman;
  477.       3: LsFileListView281.Language := lnSpanish;
  478.       4: LsFileListView281.Language := lnPortuguese;
  479.       5: LsFileListView281.Language := lnSysDefault;
  480.     end;
  481.   end;
  482.   LsDirTreeCombo281.OpenPath(CurDir);
  483.   LsFileListView281.Directory := CurDir;
  484.   LsFileListView281.UpdateFileList;
  485. end;
  486.  
  487. end.
  488.  
  489.