home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / Plasmatech / ptscp_examples.exe / %MAINDIR% / Examples / Demo / FExplorer.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-08-31  |  12.8 KB  |  380 lines
  1. unit FExplorer; // Copyright ⌐ 1996-2001 Plasmatech Software Design. All rights reserved.
  2. {
  3.  Shell Control Pack - Demo Program
  4.  Version 1.6
  5.  
  6.  This file is part of the Shell Control Pack demonstration program.
  7.  It implements the mini-explorer form.
  8.  
  9.  History
  10.  ===================================================================================================
  11.  V1.6   2Jul01 Delphi 6 release. No changes.
  12.  V1.5c 30Mar01 No changes.
  13.  V1.5b 12Dec00 No changes.
  14.  V1.5a 14May00 No changes.
  15.  V1.5   3Mar00 C++Builder 5 release. No changes.
  16.  V1.4a  5Nov99 No significant changes.
  17.  V1.4  14Sep99 Delphi 5 release. No changes.
  18.  V1.3h 29Mar99 No changes.
  19.  V1.3g  1Dec98 No changes.
  20.  V1.3f 12Jul98 Delphi 4 release. No changes.
  21.  V1.3e 22Apr98 No changes.
  22.  V1.3d 18Apr98 No changes.
  23.  V1.3c 16Mar98 No changes.
  24.  V1.3b  7Feb98 No changes.
  25.  V1.3a  7Jan98 No changes.
  26.  V1.3  28Nov97 Added internationalisation code.
  27.  V1.2b 12Oct97 No changes.
  28.  V1.2a  5Oct97 No significant changes.
  29.  V1.2   6Sep97 No significant changes.
  30.  V1.1a  6Jul97 No changes.
  31.  V1.1  26Jun97 Added custom draw examples and menu for TPTListView.
  32.  V1.0c 31May97 No significant changes.
  33.  V1.0b 17May97 Minor fixes and Delphi 3 support.
  34.  V1.0a  1May97 No significant changes.
  35.  V1.0  21Apr97 Released version 1.0
  36. }
  37.  
  38. {$INCLUDE PTCompVer.inc}
  39.  
  40. {$RANGECHECKS OFF} {$OVERFLOWCHECKS OFF} {$WRITEABLECONST OFF}
  41. {$BOOLEVAL OFF}    {$EXTENDEDSYNTAX ON}  {$TYPEDADDRESS ON}
  42.  
  43. interface
  44. uses
  45.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  46.   ComCtrls, Menus, StdCtrls, ExtCtrls, Buttons, ShellApi,
  47.     UPTShellControls, UPTSysFolderDlg, UPTSplitter, UPTShellUtils,
  48.     UPTFrame, UPTShell95, UPTImageCombo, UPTTreeList, UPTShConsts;
  49.  
  50. type
  51.   TFrmExplorer = class(TForm)
  52.     StatusBar1: TStatusBar;
  53.     MainMenu1: TMainMenu;
  54.     File1: TMenuItem;
  55.     CloseMitm: TMenuItem;
  56.     DetailsBtn: TSpeedButton;
  57.     ListBtn: TSpeedButton;
  58.     SmallIconsBtn: TSpeedButton;
  59.     LargeIconsBtn: TSpeedButton;
  60.     F1: TMenuItem;
  61.     TreeSelectPathnameMitm: TMenuItem;
  62.     TreeRefreshMitm: TMenuItem;
  63.     PTSysFolderDlg1: TPTSysFolderDlg;
  64.     PTSplitter1: TPTSplitter;
  65.     PTShellList1: TPTShellList;
  66.     N4: TMenuItem;
  67.     TreeViewSelectedPathnameMitm: TMenuItem;
  68.     PTShellCombo1: TPTShellCombo;
  69.     UpOneLevelBtn: TSpeedButton;
  70.     PopupMenu1: TPopupMenu;
  71.     Item11: TMenuItem;
  72.     Item21: TMenuItem;
  73.     ListPopup: TPopupMenu;
  74.     LargeIconsMitm: TMenuItem;
  75.     SmalliconsMItm: TMenuItem;
  76.     ListMitm: TMenuItem;
  77.     DetailsMitm: TMenuItem;
  78.     View1Submenu: TMenuItem;
  79.     LargeIcons2Mitm: TMenuItem;
  80.     Smallicons2Mitm: TMenuItem;
  81.     List2Mitm: TMenuItem;
  82.     Details2Mitm: TMenuItem;
  83.     Highlightexecutables1: TMenuItem;
  84.     Dimreadonlyfoldersintree1: TMenuItem;
  85.     Edit1: TMenuItem;
  86.     SelectAll1: TMenuItem;
  87.     Paste1: TMenuItem;
  88.     N2: TMenuItem;
  89.     InvertSelection1: TMenuItem;
  90.     Cut1: TMenuItem;
  91.     Copy1: TMenuItem;
  92.     Cantundo1: TMenuItem;
  93.     N3: TMenuItem;
  94.     New1Submenu: TMenuItem;
  95.     N5: TMenuItem;
  96.     NewFolder1Mitm: TMenuItem;
  97.     View2Submenu: TMenuItem;
  98.     N6: TMenuItem;
  99.     New2Submenu: TMenuItem;
  100.     NewFolder2Mitm: TMenuItem;
  101.     N7: TMenuItem;
  102.     Properties1Mitm: TMenuItem;
  103.     Paste2Mitm: TMenuItem;
  104.     N8: TMenuItem;
  105.     CustomDraw1: TMenuItem;
  106.     Hotkeys1: TMenuItem;
  107.     F11Mitm: TMenuItem;
  108.     DeleteBtn: TSpeedButton;
  109.     PTShellTree1: TPTShellTree;
  110.     PTGroup1: TPTGroup;
  111.     procedure ViewBtnClick(Sender: TObject);
  112.     procedure PTShellTree1Change(Sender: TObject; Node: TTreeNode);
  113.     procedure CloseMitmClick(Sender: TObject);
  114.     procedure TreeRefreshMitmClick(Sender: TObject);
  115.     procedure TreeSelectPathnameMitmClick(Sender: TObject);
  116.     procedure FileSwapPanesMitmClick(Sender: TObject);
  117.     procedure TreeViewSelectedPathnameMitmClick(Sender: TObject);
  118.     procedure UpOneLevelBtnClick(Sender: TObject);
  119.     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  120.     procedure FormCreate(Sender: TObject);
  121.     procedure PTShellList1PopupHint(aSender: TObject; const hint: string);
  122.     procedure Highlightexecutables1Click(Sender: TObject);
  123.     procedure PTShellList1CustomDrawSh(aSender: TObject;
  124.       aCD: TPTCustomDraw; aItem: TListItem; aData: TPTShListData);
  125.     procedure Dimreadonlyfoldersintree1Click(Sender: TObject);
  126.     procedure PTShellTree1CustomDrawSh(aSender: TObject;
  127.       aCD: TPTCustomDraw; aNode: TTreeNode; aData: TPTShTreeData);
  128.     procedure SelectAll1Click(Sender: TObject);
  129.     procedure NewFolder1MitmClick(Sender: TObject);
  130.     procedure Paste1Click(Sender: TObject);
  131.     procedure Properties1MitmClick(Sender: TObject);
  132.     procedure InvertSelection1Click(Sender: TObject);
  133.     procedure F11MitmClick(Sender: TObject);
  134.     procedure DeleteBtnClick(Sender: TObject);
  135.     procedure PTShellTree1Edited(Sender: TObject; Node: TTreeNode;
  136.       var S: String);
  137.   private
  138.     mfHighlightExe: Boolean;
  139.     mfDimReadOnly: Boolean;
  140.     procedure OnAppHint(sender: TObject);
  141.     procedure LoadStrings;
  142.   public
  143.     { Public declarations }
  144.   end;
  145.  
  146. var
  147.   FrmExplorer: TFrmExplorer;
  148.  
  149. implementation
  150. uses TypInfo;
  151. {$R *.DFM}
  152.  
  153. procedure TFrmExplorer.ViewBtnClick(Sender: TObject);
  154. var tag: Integer;
  155.   procedure CheckItems( a: array of TComponent;  prop: ShortString );
  156.   var i: Integer;
  157.   begin
  158.     for i := Low(a) to High(a) do
  159.       SetOrdProp( a[i], GetPropInfo(a[i].ClassInfo, prop), Integer(a[i].Tag=tag) );
  160.   end;
  161. begin
  162.   tag := (sender as TComponent).Tag;
  163.   CheckItems( [LargeIconsMitm, SmallIconsMitm, ListMitm, DetailsMitm], 'Checked' );
  164.   CheckItems( [LargeIcons2Mitm, SmallIcons2Mitm, List2Mitm, Details2Mitm], 'Checked' );
  165.   CheckItems( [LargeIconsBtn, SmallIconsBtn, ListBtn, DetailsBtn], 'Down' );
  166.   PTShellList1.ViewStyle := TViewStyle(tag);
  167. end;
  168.  
  169. procedure TFrmExplorer.PTShellTree1Change(Sender: TObject; Node: TTreeNode);
  170. begin
  171.   StatusBar1.SimpleText := PTShellTree1.SelectedPathName;
  172.   UpOneLevelBtn.Enabled := Assigned(PTShellTree1.Selected) and (PTShellTree1.Selected.Parent <> nil);
  173. end;
  174.  
  175. procedure TFrmExplorer.CloseMitmClick(Sender: TObject);
  176.   begin Close; end;
  177.  
  178. procedure TFrmExplorer.TreeRefreshMitmClick(Sender: TObject);
  179. begin
  180.   PTShellTree1.RefreshNodes;
  181.  
  182.   PTShellList1.FillItems;
  183.     // We don't call RefreshItems because we want the resulting list sorted
  184. end;
  185.  
  186. procedure TFrmExplorer.TreeSelectPathnameMitmClick(Sender: TObject);
  187. begin
  188.   PTSysFolderDlg1.Title := 'Select a folder to highlight.';
  189.   if PTSysFolderDlg1.Execute then
  190.     PTShellCombo1.SelectedFolder.IdList := PTSysFolderDlg1.FolderIdList;
  191. end;
  192.  
  193. procedure TFrmExplorer.FileSwapPanesMitmClick(Sender: TObject);
  194.   begin PTSplitter1.SwapPanes(TRUE); end;
  195.  
  196. procedure TFrmExplorer.TreeViewSelectedPathnameMitmClick(Sender: TObject);
  197. var p: String;
  198. begin
  199.   p := PTShellTree1.SelectedPathname;
  200.   if p = '' then
  201.     ShowMessage( 'The selected item is not part of the filesystem.' )
  202.   else
  203.     ShowMessage( 'Selected Item: '+p );
  204. end;
  205.  
  206. procedure TFrmExplorer.UpOneLevelBtnClick(Sender: TObject);
  207. begin
  208.   PTShellTree1.GoUp(1);
  209. end;
  210.  
  211. procedure TFrmExplorer.DeleteBtnClick(Sender: TObject);
  212. begin
  213.   if PTShellTree1.Focused then
  214.     PTShellTree1.DoCommandForNode( PTShellTree1.Selected, PTSH_CMDS_DELETE )
  215.   else
  216.     PTShellList1.DoCommandForAllSelected( PTSH_CMDS_DELETE );
  217. end;
  218.  
  219. procedure TFrmExplorer.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  220. begin
  221.   if Key=VK_ESCAPE then Close;
  222.   inherited;
  223. end;
  224.  
  225. procedure TFrmExplorer.FormCreate(Sender: TObject);
  226. {$IFDEF VCL30PLUS}
  227. var
  228.   i: Integer;
  229. {$ENDIF}
  230. begin
  231.   Application.OnHint := OnAppHint;
  232.   LoadStrings;
  233.  
  234. {$IFDEF VCL30PLUS}
  235.   for i := 0 to PTGroup1.ControlCount-1 do
  236.     if PTGroup1.Controls[i] is TSpeedButton then
  237.       TSpeedButton(PTGroup1.Controls[i]).Flat := TRUE;
  238. {$ENDIF}
  239. end;
  240.  
  241. procedure TFrmExplorer.OnAppHint(sender: TObject);
  242. begin
  243.   StatusBar1.Panels[0].Text := Application.Hint;
  244. end;
  245.  
  246. procedure TFrmExplorer.LoadStrings;
  247.   procedure SetMenuItems( caption, hint: String;  arr: array of TMenuItem );
  248.   var i: Integer;
  249.   begin
  250.     for i := Low(arr) to High(arr) do
  251.     begin
  252.       if caption<>'' then arr[i].Caption := caption;
  253.       if hint<>'' then arr[i].Hint := hint;
  254.     end;
  255.   end;
  256. begin
  257.  // This procedure loads some translated strings. There are a set of strings available with the Shell
  258.  // Control Pack that are generally useful to an explorer-like application.
  259.   UpOneLevelBtn.Hint := PTLoadStr(SUpOneLevelHint);
  260.   LargeIconsBtn.Hint := PTLoadStr(SViewLargeIconsHint) + '|' + PTLoadStr(SViewLargeIconsContext);
  261.   SmallIconsBtn.Hint := PTLoadStr(SViewSmallIconsHint) + '|' + PTLoadStr(SViewSmallIconsContext);
  262.   ListBtn.Hint := PTLoadStr(SViewListHint) + '|' + PTLoadStr(SViewListContext);
  263.   DetailsBtn.Hint := PTLoadStr(SViewDetailsHint) + '|' + PTLoadStr(SViewDetailsContext);
  264.  
  265.   SetMenuItems( PTLoadStr(SEditPasteMenu),      PTLoadStr(SPasteContext),      [Paste2Mitm] );
  266.   SetMenuItems( PTLoadStr(SPropertiesMenu),     PTLoadStr(SPropertiesContext),     [Properties1Mitm] );
  267.   SetMenuItems( PTLoadStr(SViewLargeIconsMenu), PTLoadStr(SViewLargeIconsContext), [LargeIconsMitm, LargeIcons2Mitm] );
  268.   SetMenuItems( PTLoadStr(SViewSmallIconsMenu), PTLoadStr(SViewSmallIconsContext), [SmallIconsMitm, SmallIcons2Mitm] );
  269.   SetMenuItems( PTLoadStr(SViewListMenu),       PTLoadStr(SViewListContext),       [ListMitm, List2Mitm] );
  270.   SetMenuItems( PTLoadStr(SViewDetailsMenu),    PTLoadStr(SViewDetailsContext),    [DetailsMitm, Details2Mitm] );
  271.   SetMenuItems( PTLoadStr(SViewMenu),           PTLoadStr(SViewContext),           [View1Submenu, View2Submenu] );
  272.   SetMenuItems( PTLoadStr(SNewMenu),            PTLoadStr(SNewContext),            [New1Submenu, New2Submenu] );
  273.   SetMenuItems( PTLoadStr(SNewFolderMenu),      PTLoadStr(SNewFolderContext),      [NewFolder1Mitm, NewFolder2Mitm] );
  274. end;
  275.  
  276. procedure TFrmExplorer.PTShellList1PopupHint(aSender: TObject; const hint: string);
  277. begin
  278.   Application.Hint := hint;
  279. end;
  280.  
  281. procedure TFrmExplorer.Highlightexecutables1Click(Sender: TObject);
  282. begin
  283.   mfHighlightExe := not mfHighlightExe;
  284.   Highlightexecutables1.Checked := mfHighlightExe;
  285.   PTShellList1.Invalidate;
  286. end;
  287.  
  288. procedure TFrmExplorer.Dimreadonlyfoldersintree1Click(Sender: TObject);
  289. begin
  290.   mfDimReadOnly := not mfDimReadOnly;
  291.   Dimreadonlyfoldersintree1.Checked := mfDimReadOnly;
  292.   PTShellTree1.Invalidate;
  293.   PTShellList1.Invalidate;
  294. end;
  295.  
  296. procedure TFrmExplorer.PTShellList1CustomDrawSh(aSender: TObject;
  297.   aCD: TPTCustomDraw; aItem: TListItem; aData: TPTShListData);
  298. var ext: ShortString;
  299. begin
  300.   if mfHighlightExe then
  301.   begin
  302.     ext := AnsiLowercase(ExtractFileExt(aData.FileName));
  303.     if (ext = '.exe') or (ext = '.com') or (ext = '.bat') or (ext = '.pif') then
  304.     begin
  305.       aCD.Font.Style := [fsBold];
  306.       aCD.Font.Color := clBlue;
  307.     end;
  308.   end;
  309.  
  310.   if mfDimReadOnly and not aData.Editable then
  311.     aCD.Font.Color := clBtnFace;
  312. end;
  313.  
  314. procedure TFrmExplorer.PTShellTree1CustomDrawSh(aSender: TObject;
  315.   aCD: TPTCustomDraw; aNode: TTreeNode; aData: TPTShTreeData);
  316. begin
  317.   if mfDimReadOnly and not aNode.Selected and not aNode.DropTarget then
  318.     if not aData.Editable then
  319.       aCD.Font.Color := clBtnFace;
  320. end;
  321.  
  322. procedure TFrmExplorer.SelectAll1Click(Sender: TObject);
  323.   begin PTShellList1.SelectAll; end;
  324.  
  325. procedure TFrmExplorer.NewFolder1MitmClick(Sender: TObject);
  326.   begin PTShellList1.CreateNewFolder( TRUE ); end;
  327.  
  328. procedure TFrmExplorer.Paste1Click(Sender: TObject);
  329.   begin PTShellList1.DoCommandForFolder( PTSH_CMDS_PASTE ); end;
  330.  
  331. procedure TFrmExplorer.Properties1MitmClick(Sender: TObject);
  332.   begin PTShellList1.DoCommandForFolder( PTSH_CMDS_PROPERTIES ); end;
  333.  
  334. procedure TFrmExplorer.InvertSelection1Click(Sender: TObject);
  335. var i: Integer;
  336. begin
  337.   PTShellList1.Items.BeginUpdate;
  338.   try
  339.     for i := 0 to PTShellList1.Items.Count-1 do
  340.       PTShellList1.Items[i].Selected := not PTShellList1.Items[i].Selected;
  341.   finally
  342.     PTShellList1.Items.EndUpdate;
  343.   end;
  344. end;
  345.  
  346. procedure TFrmExplorer.F11MitmClick(Sender: TObject);
  347. var s: String;
  348.     i: Integer;
  349.     p: PChar;
  350. begin
  351.   if PTShellTree1.Focused then
  352.   begin
  353.     if InputQuery( 'Enter command string', 'Command: ', s ) then
  354.     begin
  355.       i := StrToIntDef( s, -1 );
  356.       if i < 0 then p := PChar(s) else p := PChar(i);
  357.       PTShellTree1.DoCommandForNode( PTShellTree1.Selected, p );
  358.     end;
  359.   end
  360.   else if PTShellList1.Focused then
  361.   begin
  362.     if InputQuery( 'Enter command string', 'Command: ', s ) then
  363.       if PTShellList1.SelCount>0 then
  364.         PTShellList1.DoCommandForAllSelected( PChar(s) )
  365.       else
  366.         PTShellList1.DoCommandForFolder( PChar(s) );
  367.   end;
  368. end;
  369.  
  370. procedure TFrmExplorer.PTShellTree1Edited(Sender: TObject; Node: TTreeNode;
  371.   var S: String);
  372. begin
  373.   if Assigned(Node) and Assigned(Node.Parent) then
  374.     PTShellTree1.SortNode( Node.Parent );
  375. end;
  376.  
  377. end.
  378.  
  379.  
  380.