Skip to content

Commit 8c180e6

Browse files
carloBarazzettacarloBarazzetta
committed
26 May 2023: ver. 1.0.0
- Added packages of ShellControls for many Delphi versions - Fixed ShellEdit.pas to show the propery editor according to IDE style - Added a simple Demo and a simple unit with some useful utilities
1 parent 8f54540 commit 8c180e6

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

68 files changed

+6358
-0
lines changed

‎Demo/ShellControlsDemo/MainUnit.dfm‎

Lines changed: 596 additions & 0 deletions
Large diffs are not rendered by default.

‎Demo/ShellControlsDemo/MainUnit.pas‎

Lines changed: 215 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,215 @@
1+
unit MainUnit;
2+
3+
interface
4+
5+
uses
6+
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
7+
Dialogs, StdCtrls,
8+
Vcl.ComCtrls, Vcl.Shell.ShellCtrls, Vcl.ExtCtrls, System.Actions,
9+
Vcl.ActnList, Vcl.Buttons, Vcl.ToolWin, Vcl.ImgList,
10+
Vcl.Menus;
11+
12+
type
13+
TMainForm = class(TForm)
14+
ClientPanel: TPanel;
15+
LeftPanel: TPanel;
16+
ShellComboBox: TShellComboBox;
17+
ShellTreeView: TShellTreeView;
18+
VertSplitter: TSplitter;
19+
CenterPanel: TPanel;
20+
ShellListView: TShellListView;
21+
ActionList: TActionList;
22+
actnBack: TAction;
23+
actnRefresh: TAction;
24+
actnSorted: TAction;
25+
ImageList: TImageList;
26+
FileInfo: TPanel;
27+
PaintBox: TPaintBox;
28+
StatusBar: TStatusBar;
29+
RightSplitter: TSplitter;
30+
FileNameLabel: TLabel;
31+
PathLabel: TLabel;
32+
LastChangeLabel: TLabel;
33+
CreationLabel: TLabel;
34+
DisplayNameLabel: TLabel;
35+
TopPanel: TPanel;
36+
ToolBar: TToolBar;
37+
tbBack: TToolButton;
38+
tbRefresh: TToolButton;
39+
tbSorted: TToolButton;
40+
ViewStyle: TRadioGroup;
41+
tpSep: TToolButton;
42+
PopupMenu: TPopupMenu;
43+
Back1: TMenuItem;
44+
Refresh1: TMenuItem;
45+
Sorted1: TMenuItem;
46+
ShellChangeNotifier: TShellChangeNotifier;
47+
procedure ViewStyleClick(Sender: TObject);
48+
procedure FormCreate(Sender: TObject);
49+
procedure actnBackUpdate(Sender: TObject);
50+
procedure actnBackExecute(Sender: TObject);
51+
procedure actnRefreshExecute(Sender: TObject);
52+
procedure actnSortedUpdate(Sender: TObject);
53+
procedure actnSortedExecute(Sender: TObject);
54+
procedure PaintBoxPaint(Sender: TObject);
55+
procedure ShellListViewChange(Sender: TObject; Item: TListItem;
56+
Change: TItemChange);
57+
procedure ShellListViewExit(Sender: TObject);
58+
procedure ShellChangeNotifierChange;
59+
private
60+
procedure InitImageListIcons;
61+
procedure ClearFileInfo;
62+
end;
63+
64+
var
65+
MainForm: TMainForm;
66+
67+
implementation
68+
69+
{$R *.dfm}
70+
71+
uses
72+
Winapi.CommCtrl
73+
, Winapi.ShlObj
74+
, Vcl.Shell.Utils
75+
;
76+
77+
type
78+
TNTFolders = (rfCommonDesktopDirectory, rfCommonPrograms, rfCommonStartMenu, rfCommonStartup);
79+
80+
procedure TMainForm.FormCreate(Sender: TObject);
81+
begin
82+
Caption := Application.Title;
83+
ClearFileInfo;
84+
InitImageListIcons;
85+
DisplayNameLabel.Font.Height := Round(Self.Font.Height * 1.6);
86+
DisplayNameLabel.Font.Style := [TFontStyle.fsBold];
87+
PathLabel.Font.Height := Round(Self.Font.Height * 1.2);
88+
end;
89+
90+
procedure TMainForm.InitImageListIcons;
91+
begin
92+
;
93+
end;
94+
95+
procedure TMainForm.ShellChangeNotifierChange;
96+
begin
97+
actnRefresh.Execute;
98+
end;
99+
100+
procedure TMainForm.ShellListViewChange(Sender: TObject; Item: TListItem;
101+
Change: TItemChange);
102+
var
103+
LFileName: TFileName;
104+
LFileType: string;
105+
LCreation, LChanged: TDateTime;
106+
LFolder: TShellFolder;
107+
begin
108+
LFolder := ShellListView.SelectedFolder;
109+
if Assigned(LFolder) then
110+
begin
111+
DisplayNameLabel.Caption := LFolder.DisplayName;
112+
StatusBar.SimpleText := LFolder.PathName;
113+
if LFolder.IsFolder then
114+
begin
115+
FileNameLabel.Caption := '';
116+
PathLabel.Caption := LFolder.PathName;
117+
LastChangeLabel.Caption := '';
118+
CreationLabel.Caption := '';
119+
end
120+
else
121+
begin
122+
LFileName := LFolder.PathName;
123+
FileNameLabel.Caption := ExtractFileName(LFolder.PathName);
124+
PathLabel.Caption := ExtractFilePath(LFolder.PathName);
125+
GetFileSummary(LFileName, LFileType, LCreation, LChanged);
126+
LastChangeLabel.Caption := Format('Last Changed: %s', [DateTimeToStr(LChanged)]);
127+
CreationLabel.Caption := Format('Creation Date: %s', [DateTimeToStr(LCreation)]);
128+
end;
129+
end
130+
else
131+
ClearFileInfo;
132+
PaintBox.Invalidate;
133+
end;
134+
135+
procedure TMainForm.ShellListViewExit(Sender: TObject);
136+
begin
137+
ClearFileInfo;
138+
PaintBox.Invalidate;
139+
end;
140+
141+
procedure TMainForm.PaintBoxPaint(Sender: TObject);
142+
var
143+
LFolder: TShellFolder;
144+
LIcon: TIcon;
145+
LRect: TRect;
146+
LItem: PItemIDLIst;
147+
begin
148+
LRect := TRect.Create(0,0,PaintBox.Width,PaintBox.Height);
149+
LIcon := TIcon.Create;
150+
try
151+
//Retrieve Icon from current file
152+
LFolder := ShellListView.SelectedFolder;
153+
if Assigned(LFolder) and ShellListView.Focused then
154+
begin
155+
LItem := LFolder.AbsoluteID;
156+
LIcon.Handle := GetAssociatedIcon(LItem, True, False);
157+
PaintBox.Canvas.StretchDraw(LRect, LIcon);
158+
end
159+
else
160+
begin
161+
PaintBox.Canvas.Brush.Color := FileInfo.Color;
162+
PaintBox.Canvas.Pen.Style := psSolid;
163+
PaintBox.Canvas.FillRect(LRect);
164+
end;
165+
finally
166+
LIcon.Free;
167+
end;
168+
end;
169+
170+
procedure TMainForm.ViewStyleClick(Sender: TObject);
171+
begin
172+
ShellListView.ViewStyle := TViewStyle(ViewStyle.ItemIndex);
173+
end;
174+
175+
procedure TMainForm.actnBackUpdate(Sender: TObject);
176+
begin
177+
actnBack.Enabled := (ShellTreeView.SelectedFolder <> nil) and
178+
(ShellTreeView.SelectedFolder.Level > 0);
179+
end;
180+
181+
procedure TMainForm.actnBackExecute(Sender: TObject);
182+
begin
183+
ShellListView.Back();
184+
end;
185+
186+
procedure TMainForm.actnRefreshExecute(Sender: TObject);
187+
begin
188+
ShellListView.Refresh();
189+
end;
190+
191+
procedure TMainForm.actnSortedUpdate(Sender: TObject);
192+
begin
193+
actnSorted.Checked := ShellListView.Sorted;
194+
end;
195+
196+
procedure TMainForm.ClearFileInfo;
197+
begin
198+
DisplayNameLabel.Caption := '';
199+
FileNameLabel.Caption := '';
200+
PathLabel.Caption := '';
201+
LastChangeLabel.Caption := '';
202+
CreationLabel.Caption := '';
203+
end;
204+
205+
procedure TMainForm.actnSortedExecute(Sender: TObject);
206+
begin
207+
ShellListView.Sorted := actnSorted.Checked;
208+
end;
209+
210+
initialization
211+
{$IFDEF DEBUG}
212+
ReportMemoryLeaksOnShutdown := True;
213+
{$ENDIF}
214+
215+
end.

‎Demo/ShellControlsDemo/ShellControlsDemo.dpr‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
program ShellControlsDemo;
2+
3+
uses
4+
Forms,
5+
MainUnit in 'MainUnit.pas' {MainForm},
6+
Vcl.Themes,
7+
Vcl.Styles,
8+
Vcl.Shell.Utils in '..\..\Source\Vcl.Shell.Utils.pas';
9+
10+
{$R *.res}
11+
12+
begin
13+
Application.Initialize;
14+
Application.MainFormOnTaskBar := True;
15+
Application.ActionUpdateDelay := 50;
16+
Application.Title := 'VCL Shell Controls Demo';
17+
Application.CreateForm(TMainForm, MainForm);
18+
Application.Run;
19+
end.

0 commit comments

Comments
 (0)