求救:activeForm释放问题? Delphi / Windows SDK/APIhttp://www.delphi2007.net/DelphiNetwork/html/delphi_20061204173421201.html
问题:1.在win2000,IE6下,先打开一个IE,不做任何操作.
2.后再先打开一个嵌有activeForm控件的页面(ActiveFormProj11.htm).
3.关闭ActiveFormProj11.htm后再次打开,出现"Access violation at address 00000000 in module 'activeForm.ocx
4.如果没有第1步,不先打开一个IE,就不会出现第3步提示.
5.在win2k3的IE6中不会出现任何问题.
发现如果有一个IE先打开,后面再打开有控件的页面后关闭,想删除控件,提示有一个用户在使用,即当有一个IE先打开时,activeForm.ocx控件没被关闭和释放?各位大侠,如何解决.
上面例子就是用向导简单做一个例子,另再加一个窗口,在activeform自动生成的窗口的create事件中增加如下代码:
procedure THqFormX.ActiveFormCreate(Sender: TObject);
begin
self.AxBorderStyle:= forms.afbNone;
Form1:= TForm1.Create(self);
Form1.BorderStyle:= bsNone;
Form1.Parent:= self;
Form1.Align:= alClient;
Form1.Show;
end;
form1为THqFormX的成员.
public
{ Public declarations }
Form1: TForm1;
procedure Initialize; override;
没用过,up
ActiveForm 本质上是 运行在多线称环境(每个IE窗口都是独立线称)下的dll,
宿主进程就是iexplore.exe,VCL会有一些线程安全问题,很令人头痛。
对于你的问题,可以这样试试:
删除 Form1.pas 中 Form1 : TForm1 这个全局变量,改在 THqFormX 的成员中声明。
这个问题的本质原因在于delphi的源码文件AxCtrls.pas中存在bug,
导致控件未正常析构之前给ParkingWindow发送了WM_DESTROY消息,
导致ParkingWindow关闭,而控件访问了不存在的窗口,导致异常。
解决的方法是修改Borland/delphi7/source/vcl/AxCtrls.pas文件。
一共修改两个函数如下:
一个是ParkingWindowProc()函数,修改如下:
function ParkingWindowProc(Wnd: HWND; Msg, wParam, lParam: Longint): Longint; stdcall;
var
ControlWnd: HWND;
begin
case Msg of
WM_COMPAREITEM, WM_DELETEITEM, WM_DRAWITEM, WM_MEASUREITEM, WM_COMMAND:
begin
case Msg of
WM_COMPAREITEM: ControlWnd := PCompareItemStruct(lParam).CtlID;
WM_DELETEITEM: ControlWnd := PDeleteItemStruct(lParam).CtlID;
WM_DRAWITEM: ControlWnd := PDrawItemStruct(lParam).CtlID;
WM_MEASUREITEM: ControlWnd := PMeasureItemStruct(lParam).CtlID;
WM_COMMAND: ControlWnd := HWND(lParam);
else
Result := 0;
Exit;
end;
Result := SendMessage(ControlWnd, OCM_BASE + Msg, wParam, lParam);
end;
else
////////////////////////////////////////////////////////////////////////////
//zhaoyan edit begin
{
if (Msg = WM_NCDESTROY) and (Wnd = xParkingWindow) then xParkingWindow := 0;
Result := DefWindowProc(Wnd, Msg, WParam, LParam);
}
if (Msg = WM_NCDESTROY) and (Wnd = xParkingWindow) then
begin
xParkingWindow := 0;
Result := DefWindowProc(Wnd, Msg, WParam, LParam);
end else begin
Result := SendMessage(ControlWnd, OCM_BASE + Msg, wParam, lParam);
end;
//zhaoyan edit end
/////////////////////////////////////////////////////////////////////////////
end;
end;
另外一个是ParkingWindow()函数,修改如下:
function ParkingWindow: HWND;
var
TempClass: TWndClass;
ParkingName:String; //zhaoyan add
begin
Result := xParkingWindow;
if Result <> 0 then Exit;
//zhaoyan add start
//fixDaxerror:accessviolation(win2k,winxp)
ParkingName:='DAXParkingWindow_'+Format('%p',[@ParkingWindowProc]);
//zhaoyan add end
FillChar(TempClass, sizeof(TempClass), 0);
//zhaoyan edit start
//fixDaxerror:accessviolation(win2k,winxp)
if not GetClassInfo(HInstance,PChar(ParkingName),TempClass)then
//if not GetClassInfo(HInstance, 'DAXParkingWindow', TempClass) then
//zhaoyan edit end
begin
TempClass.hInstance := HInstance;
TempClass.lpfnWndProc := @ParkingWindowProc;
//zhaoyan edit start
TempClass.lpszClassName:=PChar(ParkingName);//fixDaxerror:accessviolation(win2k,winxp)
//TempClass.lpszClassName := 'DAXParkingWindow';
//zhaoyan edit end
if Windows.RegisterClass(TempClass) = 0 then
raise EOutOfResources.Create(SWindowClass);
end;
xParkingWindow := CreateWindowEx(WS_EX_TOOLWINDOW, TempClass.lpszClassName, nil,
WS_POPUP, GetSystemMetrics(SM_CXSCREEN) div 2,
GetSystemMetrics(SM_CYSCREEN) div 2, 0, 0, 0, 0, HInstance, nil);
SetWindowPos(xParkingWindow, 0, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOREDRAW
or SWP_NOZORDER or SWP_SHOWWINDOW);
Result := xParkingWindow;
end;
结贴
一个是ParkingWindowProc()函数,修改如下:
function ParkingWindowProc(Wnd: HWND; Msg, wParam, lParam: Longint): Longint; stdcall;
var
ControlWnd: HWND;
begin
case Msg of
WM_COMPAREITEM, WM_DELETEITEM, WM_DRAWITEM, WM_MEASUREITEM, WM_COMMAND:
begin
case Msg of
WM_COMPAREITEM: ControlWnd := PCompareItemStruct(lParam).CtlID;
WM_DELETEITEM: ControlWnd := PDeleteItemStruct(lParam).CtlID;
WM_DRAWITEM: ControlWnd := PDrawItemStruct(lParam).CtlID;
WM_MEASUREITEM: ControlWnd := PMeasureItemStruct(lParam).CtlID;
WM_COMMAND: ControlWnd := HWND(lParam);
else
Result := 0;
Exit;
end;
Result := SendMessage(ControlWnd, OCM_BASE + Msg, wParam, lParam);
end;
else
////////////////////////////////////////////////////////////////////////////
//zhaoyan edit begin
{
if (Msg = WM_NCDESTROY) and (Wnd = xParkingWindow) then xParkingWindow := 0;
Result := DefWindowProc(Wnd, Msg, WParam, LParam);
}
if (Msg = WM_NCDESTROY) and (Wnd = xParkingWindow) then
begin
xParkingWindow := 0;
Result := DefWindowProc(Wnd, Msg, WParam, LParam);
end else begin
Result := SendMessage(ControlWnd, OCM_BASE + Msg, wParam, lParam);
end;
//zhaoyan edit end
/////////////////////////////////////////////////////////////////////////////
end;
end;
按上面改后,对原有的在XP和2000系统的IE6环境下,控件无法释放的问题解决了,但随之而来的问题是原来在Tscrollbar中有一个TImage控件进行画图时,出现错拉!造成更大的问题!
请继续讨论,结束后,再开新贴给分!
还有:为什么ActiveFormDestroy(Sender: TObject)事件不能运行?怎样使它能运行?