Карта сайтаСсылкиКонтакты

Как настроить диалоговое окно открытия файлов

PDF Печать
Статьи

Как можно добавить любые управления в диалоговое окно открытия файлов?


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 файле и зарегистрируйте компонент.

По материалам http://delphi3000.com


 

Комментарии   

 
0 #1 woodyfon 15.01.2015 23:56
А как собственно разместить на форме диалога открытия файла элементы управления (Label, CheckBox)?
Цитировать
 

Добавить комментарий


Защитный код
Обновить