Author: Vimil Saju
How can I customize the open dialog by adding any control to it.
Answer:
I have created a component that lets you do just this.
Here is the code.
1 unit CusOpen;
2 interface
3
4 uses
5 classes, forms, sysutils, messages, windows, controls, dialogs, extctrls;
6
7 type
8 TOnPaint = procedure(sender: TObject) of object;
9 TControlInfo = record
10 control: Tcontrol;
11 parent: tWincontrol;
12 end;
13 PControlInfo = ^TControlInfo;
14 type
15 TCustomOpenDialog = class(TOpenDialog)
16 private
17 cpanel: Tpanel;
18 Controls: Tlist;
19 fOnResize: TNotifyEvent;
20 fOnPaint: TOnPaint;
21 fdwidth: integer;
22 fdheight: integer;
23 fexecute: boolean;
24 fdefproc: TFarProc;
25 fcurproc: TFarProc;
26 procedure SetHeight(aheight: integer);
27 procedure SetWidth(awidth: integer);
28 protected
29 procedure WndProc(var msg: TMessage); override;
30 procedure DlgProc(var msg: TMessage);
31 public
32 constructor Create(Aowner: Tcomponent); override;
33 destructor destroy; override;
34 procedure SetDialogSize(awidth: integer; aheight: integer);
35 function AddControl(AControl: TControl): boolean;
36 function RemoveControl(AControl: TControl): boolean;
37 function Execute: boolean; override;
38 property DialogWidth: integer read fdwidth write SetWidth;
39 property DialogHeight: integer read fdheight write SetHeight;
40 published
41 property OnResize: TNotifyEvent read fOnresize write fonresize;
42 property OnPaint: TOnPaint read fOnpaint write fonpaint;
43 end;
44
45 procedure register;
46 implementation
47
48 constructor TCustomOpenDialog.Create(Aowner: Tcomponent);
49 begin
50 fdheight := 0;
51 fdwidth := 0;
52 fexecute := false;
53 cpanel := Tpanel.create(self);
54 cpanel.Caption := '';
55 cpanel.BevelInner := bvnone;
56 cpanel.BevelOuter := bvnone;
57 controls := Tlist.Create;
58 inherited Create(Aowner);
59 end;
60
61 destructor TCustomOpenDialog.destroy;
62 var
63 i: integer;
64 pcinfo: PControlInfo;
65 begin
66 for i := 0 to controls.count - 1 do
67 begin
68 pcinfo := controls.Items[i];
69 dispose(pcinfo);
70 end;
71 freeandnil(controls);
72 freeandnil(cpanel);
73 FreeObjectInstance(fcurproc);
74 inherited;
75 end;
76
77 procedure TCustomOpenDialog.SetHeight(aheight: integer);
78 begin
79 if (aheight >= 0) then
80 begin
81 fdheight := aheight;
82 if fexecute then
83 begin
84 setwindowpos(getparent(handle), 0, 0, 0, fdwidth, fdheight, SWP_NOMOVE or
85 SWP_NOREPOSITION);
86 cpanel.SetBounds(0, 0, fdwidth, fdheight);
87 end;
88 end;
89 end;
90
91 procedure TCustomOpenDialog.SetWidth(awidth: integer);
92 begin
93 if (awidth >= 0) then
94 begin
95 fdwidth := awidth;
96 if fexecute then
97 begin
98 setwindowpos(getparent(handle), 0, 0, 0, fdwidth, fdheight, SWP_NOMOVE or
99 SWP_NOREPOSITION);
100 cpanel.SetBounds(0, 0, fdwidth, fdheight);
101 end;
102 end;
103 end;
104
105 procedure TCustomOpenDialog.SetDialogSize(awidth: integer; aheight: integer);
106 begin
107 if (awidth >= 0) and (aheight >= 0) then
108 begin
109 fdwidth := awidth;
110 fdheight := aheight;
111 if fexecute then
112 begin
113 setwindowpos(getparent(handle), 0, 0, 0, fdwidth, fdheight, SWP_NOMOVE or
114 SWP_NOREPOSITION);
115 cpanel.SetBounds(0, 0, fdwidth, fdheight);
116 end;
117 end;
118 end;
119
120 procedure TCustomOpenDialog.WndProc(var Msg: TMessage);
121 var
122 i: integer;
123 rct: Trect;
124 begin
125 inherited WndProc(msg);
126 if msg.Msg = WM_INITDIALOG then
127 begin
128 fdefproc := TFarProc(GetWindowLong(getparent(handle), GWL_WNDPROC));
129 fcurproc := MakeObjectInstance(DlgProc);
130 SetWindowlong(getparent(handle), GWL_WNDPROC, longword(fcurProc));
131 if (fdwidth > 0) and (fdheight > 0) then
132 setwindowpos(getparent(handle), 0, 0, 0, fdwidth, fdheight, SWP_NOREPOSITION
133 or
134 SWP_NOMOVE)
135 else
136 begin
137 getclientrect(getparent(handle), rct);
138 fdwidth := rct.right;
139 fdheight := rct.bottom;
140 end;
141 cpanel.parentwindow := getparent(handle);
142 setparent(cpanel.handle, getparent(handle));
143 cpanel.SetBounds(0, 0, fdwidth, fdheight);
144 setwindowpos(cpanel.handle, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE);
145 cpanel.visible := true;
146 cpanel.enabled := true;
147 for i := 0 to controls.count - 1 do
148 PControlInfo(controls[i]).control.Parent := cpanel;
149 end;
150 end;
151
152 function TCustomOpenDialog.AddControl(AControl: TControl): boolean;
153 var
154 pcinfo: pcontrolinfo;
155 begin
156 result := false;
157 if (acontrol is TControl) then
158 begin
159 new(pcinfo);
160 pcinfo.control := acontrol;
161 pcinfo.parent := TControl(acontrol).parent;
162 Controls.Add(pcinfo);
163 result := true;
164 end;
165 end;
166
167 function TCustomOpenDialog.RemoveControl(AControl: TControl): boolean;
168 var
169 i: integer;
170 pcinfo: PControlInfo;
171 begin
172 result := false;
173 if (acontrol is TControl) then
174 begin
175 for i := 0 to controls.count - 1 do
176 begin
177 pcinfo := controls.Items[i];
178 if pcinfo.control = acontrol then
179 begin
180 Tcontrol(acontrol).Parent := pcinfo.parent;
181 Controls.Remove(pcinfo);
182 dispose(pcinfo);
183 result := true;
184 break;
185 end;
186 end;
187 end;
188 end;
189
190 function TCustomOpenDialog.Execute: boolean;
191 begin
192 fexecute := true;
193 result := inherited Execute;
194 end;
195
196 procedure TCustomOpenDialog.DlgProc(var msg: Tmessage);
197 var
198 rct: TRect;
199 pcinfo: PControlInfo;
200 fcallinherited: boolean;
201 i: integer;
202 begin
203 fcallinherited := true;
204 case msg.msg of
205 WM_SIZE:
206 begin
207 getclientrect(getparent(handle), rct);
208 fdheight := rct.Bottom;
209 fdwidth := rct.Right;
210 cpanel.SetBounds(0, 0, fdwidth, fdheight);
211 if assigned(fOnResize) then
212 fOnresize(self);
213 end;
214 WM_PAINT:
215 begin
216 if assigned(fonpaint) then
217 fonpaint(self);
218 end;
219 WM_CLOSE:
220 begin
221 for i := 0 to controls.count - 1 do
222 begin
223 pcinfo := controls.Items[i];
224 Tcontrol(pcinfo.control).Parent := pcinfo.parent;
225 Controls.Remove(pcinfo);
226 dispose(pcinfo);
227 end;
228 end;
229 end;
230 if fcallinherited then
231 msg.result := CallWindowProc(fdefproc, getparent(handle), msg.msg, msg.wparam,
232 msg.lparam);
233 end;
234
235 procedure register;
236 begin
237 RegisterComponents('My Components', [TCustomOpenDialog]);
238 end;
239
240 end.
save it into a .pas file and register the component.
This component implements three functions
procedure SetDialogSize(width: integer; height: integer);
This procedure lets you set the mount of space you want to leave for your controls.
function AddControl(AControl: TControl): boolean;
This function is used to add an already created control to open dialog
function RemoveControl(AControl: TControl): boolean;
This function is used to remove a control from the dialog.
Note that when the opendialogbox is closed all controls added to the dialog are
automatically destroyed. So these components cannot be used after the dialog is
closed.
An example of how to use the component is shown below
241 unit test;
242
243 interface
244
245 uses
246 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
247 ExtCtrls, StdCtrls, CusOpen, ExtDlgs;
248
249 type
250 TForm1 = class(TForm)
251 CustomOpenDialog1: TCustomOpenDialog;
252 Button1: TButton;
253 Image1: TImage;
254 procedure Button1Click(Sender: TObject);
255 procedure CustomOpenDialog1SelectionChange(Sender: TObject);
256 private
257 { Private declarations }
258 public
259 { Public declarations }
260 end;
261
262 var
263 Form1: TForm1;
264
265 implementation
266
267 {$R *.DFM}
268
269 procedure TForm1.Button1Click(Sender: TObject);
270 begin
271 CustomOpenDialog1.SetDialogSize(600, 325);
272 CustomOpenDialog1.AddControl(image1);
273 image1.left := 430;
274 image1.top := 35;
275 CustomOpenDialog1.execute;
276 end;
277
278 procedure TForm1.CustomOpenDialog1SelectionChange(Sender: TObject);
279 begin
280 try
281 image1.Picture.LoadFromFile(CustomOpenDialog1.FileName);
282 except
283 end;
284 end;
285
286 end.
|
