| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Ошибка перехвата FormDestroy [D7, WinXP]

webpauk ©   (2009-06-15 13:45:00) 

Для примера создал 2 формы

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs;

type
 TForm1 = class(TForm)
   procedure FormClick(Sender: TObject);
 end;

var
 Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.FormClick(Sender: TObject);
begin
 TForm2.Create(Application).ShowModal;
end;

end.


unit Unit2;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs;

type
 TForm2 = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   fFormOldWndProc: TWndMethod;
   procedure FormNewWndProc(var Msg: TMessage);
 public
 end;

var
 Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
 fFormOldWndProc:=Form1.WindowProc;
 Form1.WindowProc:=FormNewWndProc;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
 TForm(Owner).WindowProc:=fFormOldWndProc;
 fFormOldWndProc:=nil;
end;

procedure TForm2.FormNewWndProc(var Msg: TMessage);
begin
 if Msg.Msg = WM_PAINT then
 begin
   with Form1.Canvas do
   begin
     Brush.Color:=clRed;
     FillRect(ClipRect);
   end;
 end;
 fFormOldWndProc(Msg);
end;

end.


всё работает. только при закрытии главной формы выскакивает ошибка.
подскажите где я слажал...

---

int64   (2009-06-16 16:24:00) [1]

webpauk ©   (15.06.09 13:45)  
Когда таким способом переопределяешь во внешнем объекте WindowProc или, даже, простой ивент (с сохранением - возвращением старого метода), надо иметь полную уверенность, что другие объекты не будут делать тоже самое. Иначе, могут появиться грабли с конкуренцией объектов за захваченный ресурс.

---

Юрий Зотов   (2009-06-15 16:15:00) [2]

> webpauk ©   (15.06.09 13:45)

Менять оконную функцию небезопасно. Почему бы для отлова разрушения Owner'а не использовать Notification?

---

Игорь Шевченко   (2009-06-15 15:46:00) [3]

> TForm(Owner).WindowProc:=fFormOldWndProc;


Смело. Свежо. про GetParentForm и ValidParentForm в справке нифига не написано

---

Сергей М.   (2009-06-15 15:05:00) [4]

> на самом деле - вместо второй формы у меня объект


А что, всякий объект непременно имеет владельца ?


> если переместить
> TForm(Owner).WindowProc:=fFormOldWndProc;
> в событие FormClose - все ок.


Интересно, что изменилось при этом, если проверкой owner'а на nil там тоже не пахнет ?)

---

KSergey   (2009-06-15 14:41:00) [5]

> webpauk ©   (15.06.09 14:03) [8]
> на самом деле - вместо второй формы у меня объект.

А овнером этому объекту непеменно должны форму подсовывать? Это неудачный дизайн, обязательно найдется тот, кто подсунет не форму и будет долго и справедливо материться на взрывы и дряной компонент.

---

webpauk   (2009-06-15 14:23:00) [6]

о! нашел!

procedure TForm2.FormDestroy(Sender: TObject);
begin
  if TForm(Owner)<>nil then
  begin
     TForm(Owner).WindowProc:=fFormOldWndProc;
     fFormOldWndProc:=nil;
  end;
end;

---

webpauk   (2009-06-15 14:03:00) [7]

если переместить

procedure TForm2.FormDestroy(Sender: TObject);
begin
TForm(Owner).WindowProc:=fFormOldWndProc;
fFormOldWndProc:=nil;
end;

в событие FormClose - все ок.
но это я показал пример с 2 формами.
на самом деле - вместо второй формы у меня объект. а там только деструктор, вроде бы...

---

Сергей М.   (2009-06-15 14:02:00) [8]

> webpauk ©   (15.06.09 13:59) [6]


И что ? Вновь засада ?)

---

webpauk   (2009-06-15 13:59:00) [9]

вопрос переиначиваю:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs;

type
 TForm1 = class(TForm)
   procedure FormClick(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.FormClick(Sender: TObject);
begin
 TForm2.Create( Self).ShowModal;
end;

end.


unit Unit2;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs;

type
 TForm2 = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   fFormOldWndProc: TWndMethod;
   procedure FormNewWndProc(var Msg: TMessage);
 public
 end;

var
 Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
 fFormOldWndProc:=TForm(Owner).WindowProc;
 TForm(Owner).WindowProc:=FormNewWndProc;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
 TForm(Owner).WindowProc:=fFormOldWndProc;
 fFormOldWndProc:=nil;
end;

procedure TForm2.FormNewWndProc(var Msg: TMessage);
begin
 if Msg.Msg = WM_PAINT then
 begin
   with TForm(Owner).Canvas do
   begin
     Brush.Color:=clRed;
     FillRect(ClipRect);
   end;
 end;
 fFormOldWndProc(Msg);
end;

end.


---

webpauk   (2009-06-15 13:57:00) [10]

> Сергей М. ©   (15.06.09 13:54) [3]


справедливо...
буду копать тут

---

Сергей М.   (2009-06-15 13:56:00) [11]

> владелец - объект новой формы Application


Имелось ввиду: владелец новой формы - объект Application

---

Сергей М.   (2009-06-15 13:54:00) [12]

> TForm2.Create( Application).ShowModal; //владелец - объект новой формы Application



> procedure TForm2.FormDestroy(Sender: TObject);
> begin
>  TForm( Owner).WindowProc:=fFormOldWndProc; //с какого же перепугу объект Application у тебя стал формой ?

---

webpauk   (2009-06-15 13:48:00) [13]

> clickmaker ©   (15.06.09 13:47) [1]


не здесь ошибка. проверил

---

clickmaker   (2009-06-15 13:47:00) [14]

а это зачем?
fFormOldWndProc:=nil;

---

Наверх