Customize the Open Dialog

Problem/Question/Abstract:

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.

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 (fdwidth > 0) and (fdheight > 0) 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.