首页  编辑  

自定义打开文件对话框

Tags: /超级猛料/VCL/Common.Dialog.通用对话框和控件/   Date Created:

xk, 时间:2001-5-15 12:18:06, ID:531395  

try these 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.