Как настроить диалоговое окно открытия файлов
Пример кода компонента:
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.
Сохраните это в .pas
файле и зарегистрируйте компонент.
Комментарии