Mega Code Archive
How to customize the Open Dialog
<![CDATA[
Title: How to customize the Open Dialog
Question: 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.
I have updated the code. Now the component does not destroy the controls added to it. I have also added two events namely OnResize event and OnPaint event which is useful for customizing the opendialog
Here is the code.
--------------------------------------------------------------------------------
unit CusOpen;
interface
uses
classes,forms,sysutils,messages,windows,controls,dialogs,extctrls;
type
TOnPaint=procedure(sender:TObject) of object;
TControlInfo=record
control:Tcontrol;
parent:tWincontrol;
end;
PControlInfo=^TControlInfo;
type
TCustomOpenDialog=class(TOpenDialog)
private
cpanel:Tpanel;
Controls:Tlist;
fOnResize:TNotifyEvent;
fOnPaint:TOnPaint;
fdwidth:integer;
fdheight:integer;
fexecute:boolean;
fdefproc:TFarProc;
fcurproc:TFarProc;
procedure SetHeight(aheight:integer);
procedure SetWidth(awidth:integer);
protected
procedure WndProc(var msg: TMessage); override;
procedure DlgProc(var msg:TMessage);
public
constructor Create(Aowner:Tcomponent);override;
destructor destroy;override;
procedure SetDialogSize(awidth:integer;aheight:integer);
function AddControl(AControl:TControl):boolean;
function RemoveControl(AControl:TControl):boolean;
function Execute:boolean;override;
property DialogWidth:integer read fdwidth write SetWidth;
property DialogHeight:integer read fdheight write SetHeight;
published
property OnResize:TNotifyEvent read fOnresize write fonresize;
property OnPaint:TOnPaint read fOnpaint write fonpaint;
end;
procedure Register;
implementation
constructor TCustomOpenDialog.Create(Aowner:Tcomponent);
begin
fdheight:=0;fdwidth:=0;
fexecute:=false;
cpanel:=Tpanel.create(self);
cpanel.Caption:='';
cpanel.BevelInner:=bvnone;
cpanel.BevelOuter:=bvnone;
controls:=Tlist.Create;
inherited Create(Aowner);
end;
destructor TCustomOpenDialog.destroy;
var
i:integer;
pcinfo:PControlInfo;
begin
for i:=0 to controls.count-1 do
begin
pcinfo:=controls.Items[i];
dispose(pcinfo);
end;
freeandnil(controls);
freeandnil(cpanel);
FreeObjectInstance(fcurproc);
inherited;
end;
procedure TCustomOpenDialog.SetHeight(aheight:integer);
begin
if (aheight=0) then
begin
fdheight:=aheight;
if fexecute then
begin
setwindowpos(getparent(handle),0,0,0,fdwidth,fdheight,SWP_NOMOVE or SWP_NOREPOSITION);
cpanel.SetBounds(0,0,fdwidth,fdheight);
end;
end;
end;
procedure TCustomOpenDialog.SetWidth(awidth:integer);
begin
if (awidth=0) then
begin
fdwidth:=awidth;
if fexecute then
begin
setwindowpos(getparent(handle),0,0,0,fdwidth,fdheight,SWP_NOMOVE or SWP_NOREPOSITION);
cpanel.SetBounds(0,0,fdwidth,fdheight);
end;
end;
end;
procedure TCustomOpenDialog.SetDialogSize(awidth:integer;aheight:integer);
begin
if (awidth=0) and (aheight=0) then
begin
fdwidth:=awidth;
fdheight:=aheight;
if fexecute then
begin
setwindowpos(getparent(handle),0,0,0,fdwidth,fdheight,SWP_NOMOVE or SWP_NOREPOSITION);
cpanel.SetBounds(0,0,fdwidth,fdheight);
end;
end;
end;
procedure TCustomOpenDialog.WndProc(var Msg: TMessage);
var
i:integer;
rct:Trect;
begin
inherited WndProc(msg);
if msg.Msg=WM_INITDIALOG then
begin
fdefproc:=TFarProc(GetWindowLong(getparent(handle),GWL_WNDPROC));
fcurproc:=MakeObjectInstance(DlgProc);
SetWindowlong(getparent(handle),GWL_WNDPROC,longword(fcurProc));
if(fdwidth0) and (fdheight0) then
setwindowpos(getparent(handle),0,0,0,fdwidth,fdheight,SWP_NOREPOSITION or SWP_NOMOVE)
else
begin
getclientrect(getparent(handle),rct);
fdwidth:=rct.right;
fdheight:=rct.bottom;
end;
cpanel.parentwindow:=getparent(handle);
setparent(cpanel.handle,getparent(handle));
cpanel.SetBounds(0,0,fdwidth,fdheight);
setwindowpos(cpanel.handle,HWND_BOTTOM,0,0,0,0,SWP_NOSIZE or SWP_NOMOVE);
cpanel.visible:=true;
cpanel.enabled:=true;
for i:=0 to controls.count-1 do
PControlInfo(controls[i]).control.Parent:=cpanel;
end;
end;
function TCustomOpenDialog.AddControl(AControl:TControl):boolean;
var
pcinfo:pcontrolinfo;
begin
result:=false;
if (acontrol is TControl) then
begin
new(pcinfo);
pcinfo.control:=acontrol;
pcinfo.parent:=TControl(acontrol).parent;
Controls.Add(pcinfo);
result:=true;
end;
end;
function TCustomOpenDialog.RemoveControl(AControl:TControl):boolean;
var
i:integer;
pcinfo:PControlInfo;
begin
result:=false;
if (acontrol is TControl) then
begin
for i:=0 to controls.count-1 do
begin
pcinfo:=controls.Items[i];
if pcinfo.control=acontrol then
begin
Tcontrol(acontrol).Parent:=pcinfo.parent;
Controls.Remove(pcinfo);
dispose(pcinfo);
result:=true;
break;
end;
end;
end;
end;
function TCustomOpenDialog.Execute:boolean;
begin
fexecute:=true;
result:=inherited Execute;
end;
procedure TCustomOpenDialog.DlgProc(var msg:Tmessage);
var
rct:TRect;
pcinfo:PControlInfo;
fcallinherited:boolean;
i:integer;
begin
fcallinherited:=true;
case msg.msg of
WM_SIZE:
begin
getclientrect(getparent(handle),rct);
fdheight:=rct.Bottom;
fdwidth:=rct.Right;
cpanel.SetBounds(0,0,fdwidth,fdheight);
if assigned(fOnResize) then
fOnresize(self);
end;
WM_PAINT:
begin
if assigned(fonpaint) then
fonpaint(self);
end;
WM_CLOSE:
begin
for i:=0 to controls.count-1 do
begin
pcinfo:=controls.Items[i];
Tcontrol(pcinfo.control).Parent:=pcinfo.parent;
Controls.Remove(pcinfo);
dispose(pcinfo);
end;
end;
end;
if fcallinherited then
msg.result:=CallWindowProc(fdefproc,getparent(handle),msg.msg,msg.wparam,msg.lparam);
end;
procedure Register;
begin
RegisterComponents('My Components', [TCustomOpenDialog]);
end;
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
-------------------------------------------------------------------------------
unit test;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, CusOpen, ExtDlgs;
type
TForm1 = class(TForm)
CustomOpenDialog1: TCustomOpenDialog;
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure CustomOpenDialog1SelectionChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
CustomOpenDialog1.SetDialogSize(600,325);
CustomOpenDialog1.AddControl(image1);
image1.left:=430;
image1.top:=35;
CustomOpenDialog1.execute;
end;
procedure TForm1.CustomOpenDialog1SelectionChange(Sender: TObject);
begin
try
image1.Picture.LoadFromFile(CustomOpenDialog1.FileName);
except
end;
end;
end.
]]>