⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 subclass.pas

📁 支持库类 / 模块控件 / 支持库类 eLIB++支持库 源代码 Delphi
💻 PAS
字号:
unit SubClass;

{$IFNDEF __SUBCLASS_PAS}
{$DEFINE __SUBCLASS_PAS}
interface
uses
  windows,SysUtils,{WMConst,}elibTypes,Clp,Messages;
const
  {$IFDEF __DEBUG}
  MsgCount=2;
  WndCount=4;
  {$ELSE}
  MsgCount=50;            //用于InceptMsg--每个窗口最大可截获的消息数
  WndCount=50;            //用于InceptMsg--系统中最大可截获消息的窗口数
  {$ENDIF}


type

  pMsgProc=^MsgProc;      //用户定义的消息处理程序
  MsgProc=function(var wHwnd:Hwnd;var wMsg:integer;var wParam:integer;var lParam:integer):LongBool;stdcall;

  //子类化窗口的消息信息,用作WndInf的msgInfAry成员
  MsgInf=record
    msg:integer;                //截获的消息
    pProc:pMsgProc;             //该消息的处理程序
  end;
  //子类化窗口的信息
  WndInf=record
    hwnd:HWND;                  //窗口句柄
    pOldProc:Pointer;           //子类化前的窗口程序(WndProc)指针
    msgInfAry:Array[0..MsgCount-1]of MsgInf;
  end;


var
  WndInfAry:Array[0..WndCount-1]of WndInf;      //保存子类化后的窗口的相关信息

  /////////////////////////////////
  //声明部分
  //WndInfAry的初试化程序
  procedure InitWndInfAry();
  //子类化后真正的窗口程序
  function TrueWndProc(whwnd:Hwnd;wmsg:integer;wParam,lParam:integer):integer;stdcall
{$ENDIF}
  implementation
   ///////////////////////////////////////////////////////////
   //实现部分
  //WndInfAry的初试化程序
  procedure InitWndInfAry();
  var
    m,n:integer;
  begin
    for m:=0 to WndCount-1 do
    with WndInfAry[m]do
    begin
      hwnd:=0;
      pOldProc:=nil;
      //ClpChainNext:=0;
      for n:=0 to MsgCount-1 do
      with MsgInfAry[n]do
      begin
        msg:=0;
        pProc:=nil;
      end;//for n
    end;//for m

  end;  //procedure IntWndInfAry
  ////////////////////////////////////////

  function TrueWndProc(wHwnd:Hwnd;wMsg:integer;wParam,lParam:integer):integer;stdcall;
  var
    m,n:integer;
    m1,n1:integer;
    debugM,debugN:integer;
    pOldWndProc:Pointer;      //旧的窗口程序
    lbPassDownMsg:LongBool;        //是否把消息传递给旧的窗口程序
    nMsgProc:MsgProc;         //消息处理程序
  begin
    debugM:=0;debugN:=0;
    pOldWndProc:=nil;
    nMsgProc:=MsgProc(nil);
    lbPassDownMsg:=true;      //默认,当前在用户定义的消息处理程序处理完成后传递给旧的窗口程序处理
    Result:=0;
    //m:=0;n:=0;

    //------寻找当前窗口的信息------------
    (*      ***找当前窗口的信息记录**                *)
    for m:=0 to WndCount-1 do
    begin
      if WndInfAry[m].hwnd=wHwnd then
      //找到该窗口的子类化信息记录
      begin
        //messagebox(0,pChar(Pchar(inttostr(wHwnd))+' 找到wHwnd!'),'TrueWndProc',mb_ok);
        pOldWndproc:=WndInfAry[m].pOldProc;

        (*      ***找当前消息的记录**                *)
        for n:=0 to MsgCount-1 do
        begin
          if WndInfAry[m].msgInfAry[n].msg=wMsg then
          //找到该窗口的当前消息的记录
          begin
            //messagebox(0,pchar(pchar(inttostr(wMsg))+' 找到wMsg!'),'TrueWndProc',mb_ok);
            @nMsgProc:=WndInfAry[m].msgInfAry[n].pProc;
            break;
          end;//if WndInfAry[m].msgInfAry[n]
        end;//for n
        (*            ***                *)
        break;
      end;//if WndInfAry[m]
    end;//for m


       if @nMsgProc<>nil then
       begin
        try
          //执行用户定义的消息处理函数
          lbPassDownMsg:=nMsgProc(wHwnd,wMsg,wParam,lParam);
        except
          GReportError('eLIB++ 执行消息处理子程序时出错!请确认正在执行的消息处理子程序具有正确的参数和返回值类型。');
          exit;
        end;//try
       end;

       if wMsg=2(*WM_Destroy*) then
       //该窗口将被销毁,取消子类化,从剪辑板链中移除
       begin
       {$IFDEF __DEBUG}
        Messagebox(0,'Auto Free!','TrueWndProc',mb_ok);
       {$ELSE}

       {$ENDIF}

        try
          for m1:=0 to WndCount-1 do
          begin
            if WndInfAry[m1].hwnd=wHwnd then
            begin
              for n1:=0 to MsgCount-1 do
              begin
                debugM:=m1;
                debugN:=n1;
                WndInfAry[m1].msgInfAry[n1].msg:=0;
                WndInfAry[m1].msgInfAry[n1].pProc:=nil;
              end;
              SetWindowLong(wHwnd,GWL_WNDPROC,integer(WndInfAry[m1].pOldProc));
              WndInfAry[m1].hwnd:=0;
              WndInfAry[m1].pOldProc:=nil;
              //break;

              //从剪辑板链中移除
              CallBackDestroy(wHwnd,wMsg,wParam,lParam);
            end;//if WndInfAry[m].hwnd=wHwnd
          end;//for m1:=0 to WndCount-1
        except
         Messagebox(0,PChar('自动释放错误!'+#13+
                            'm='+inttostr(debugM)+' n='+inttostr(debugN)+#13+
                            'WndCount='+inttostr(WndCount)+' MsgCount='+inttostr(MsgCount))
                            ,'TrueWndProc',mb_ok);
        end//try
       end//if (wMsg=16.....
      else
        if wMsg=WM_CHANGECBCHAIN then
        //处理 WM_CHANGECBCHAIN 消息
          result:=CallBackChangeCBChin(wHwnd,wMsg,wParam,lParam);

       if lbPassDownMsg then
         case wMsg of
          WM_DRAWCLIPBOARD:
            begin
              result:=CallBackDrawClp(wHwnd,wMsg,wParam,lParam);
            end;
          {WM_CHANGECBCHAIN:
          //处理 WM_CHANGECBCHAIN 消息
            begin
              result:=CallBackChangeCBChin(wHwnd,wMsg,wParam,lParam);
            end;}
          else
            //执行旧的窗口程序
            result:=CallWindowProc(pOldWndProc,wHwnd,wMsg,WParam,LParam);
          end;//case

  end;  //function TureWndProc
  ///////////////////////////////////////////

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -