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