delphi2007 教程

delphi2007 教程

首页 新随笔 联系 聚合 管理
  1013 Posts :: 0 Stories :: 28 Comments :: 0 Trackbacks
求救:activeForm释放问题? Delphi / Windows SDK/API
http://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)事件不能运行?怎样使它能运行?

posted on 2009-03-02 11:34 delphi2007 阅读(556) 评论(0)  编辑 收藏 引用
只有注册用户登录后才能发表评论。