Hook运用之个性化Excel

当你编制了一个小程序，希不希望当别人使用你的程序时给Excel的程序留下一点印记。下面我们就来个性化Excel的关于对话框。在对话框中添加自己的LOGO和关于你小程序的介绍。
运行后 效果如下：

代码：

' **********************************************************************************************************
' **********************************************************************************************************
' //用来产生TIMER控件的效果。
Private   Declare   Function  SetTimer _
     Lib   " user32 "  ( _
         ByVal  hwnd  As   Long , _
         ByVal  nIDEvent  As   Long , _
         ByVal  uElapse  As   Long , _
         ByVal  lpTimerfunc  As   Long ) _
As   Long
' //将文本描绘到指定的矩形中
Private   Declare   Function  DrawTextEx _
     Lib   " user32 "   Alias   " DrawTextExA "  ( _
         ByVal  hdc  As   Long , _
         ByVal  lpsz  As   String , _
         ByVal  n  As   Long , _
        lpRect  As  RECT, _
         ByVal  un  As   Long , _
        lpDrawTextParams  As  Any) _
As   Long
' //设置指定矩形的内容
Declare   Function  SetRect _
     Lib   " user32 "  ( _
        lpRect  As  RECT, _
         ByVal  X1  As   Long , _
         ByVal  Y1  As   Long , _
         ByVal  X2  As   Long , _
         ByVal  Y2  As   Long ) _
As   Long
' //结束Settimer过程
Public   Declare   Function  KillTimer _
     Lib   " user32 "  ( _
         ByVal  hwnd  As   Long , _
         ByVal  nIDEvent  As   Long ) _
As   Long
' //从指定的模块或应用程序实例中载入一个图标
Private   Declare   Function  LoadIcon _
     Lib   " user32 "  _
     Alias   " LoadIconA "  ( _
         ByVal  hInstance  As   Long , _
         ByVal  lpIconName  As  Any) _
As   Long
' //清除图标
Private   Declare   Function  DestroyIcon _
     Lib   " user32 "  ( _
         ByVal  hIcon  As   Long ) _
As   Long
' //释放设备环境
Private   Declare   Function  ReleaseDC _
     Lib   " user32 "  ( _
         ByVal  hwnd  As   Long , _
         ByVal  hdc  As   Long ) _
As   Long
' //取得窗体设备环境
Private   Declare   Function  GetDC _
     Lib   " user32 "  ( _
         ByVal  hwnd  As   Long ) _
As   Long
' //取得系统颜色刷
Private   Declare   Function  GetSysColorBrush _
     Lib   " user32 "  ( _
     ByVal  nIndex  As   Long ) _
As   Long
' //绘制图标
Private   Declare   Function  DrawIconEx _
     Lib   " user32 "  ( _
         ByVal  hdc  As   Long , _
         ByVal  xLeft  As   Long , _
         ByVal  yTop  As   Long , _
         ByVal  hIcon  As   Long , _
         ByVal  cxWidth  As   Long , _
         ByVal  cyWidth  As   Long , _
         ByVal  istepIfAniCur  As   Long , _
         ByVal  hbrFlickerFreeDraw  As   Long , _
         ByVal  diFlags  As   Long ) _
As   Long
' //设置钩子函数
Public   Declare   Function  SetWindowsHookEx _
     Lib   " user32 "  _
     Alias   " SetWindowsHookExA "  ( _
         ByVal  idHook  As   Long , _
         ByVal  lpfn  As   Long , _
         ByVal  hmod  As   Long , _
         ByVal  dwThreadId  As   Long ) _
As   Long
' //结束钩子
Public   Declare   Function  UnhookWindowsHookEx _
     Lib   " user32 "  ( _
         ByVal  hHook  As   Long ) _
As   Long
' //下一个钩子
Public   Declare   Function  CallNextHookEx _
     Lib   " user32 "  ( _
         ByVal  hHook  As   Long , _
         ByVal  nCode  As   Long , _
         ByVal  wParam  As   Long , _
        lParam  As  Any) _
As   Long
' //取得当前线程的ID
Public   Declare   Function  GetCurrentThreadId _
     Lib   " kernel32 "  () _
As   Long
' //取得窗体标题或控件内容
Public   Declare   Function  GetWindowText _
     Lib   " user32 "  _
     Alias   " GetWindowTextA "  ( _
     ByVal  hwnd  As   Long , _
     ByVal  lpString  As   String , _
     ByVal  cch  As   Long ) _
As   Long
' ---类型---
Type RECT
     Left   As   Long
    Top  As   Long
     Right   As   Long
    Bottom  As   Long
End  Type
' ---常量---
Public   Const  DT_CALCRECT  =   & H400
Public   Const  DI_NORMAL  =   & H3
Public   Const  DT_LEFT  =   & H0                                        ' 左对齐
Public   Const  IDI_EXCLAMATION  =   32515 &                              ' 惊叹图标
Public   Const  COLOR_BTNFACE  =   15                                    ' 按钮表面色
Public   Const  HCBT_ACTIVATE  =   5
Public   Const  WH_CBT  =   5
' ---变量---
Public  IHook  As   Long
Public  IThreadId  As   Long
Public  WindowText  As   String
Public  IText  As   String , Mhwnd  As   Long , MyTid  As   Long
' ---回调---
Public   Function  HookProc_Excel( ByVal  nCode  As   Long ,  ByVal  wParam  As   Long ,  ByVal  lParam  As   Long )  As   Long
     If  nCode  <   0   Then
        HookProc_Excel  =  CallNextHookEx(IHook, nCode, wParam, lParam)
         Exit Function
     End   If
     If  nCode  =  HCBT_ACTIVATE  Then
        WindowText  =   String ( 255 ,  Chr ( 0 ))
        GetWindowText wParam, WindowText,  255
        IText  =   Left (WindowText,  InStr (WindowText, vbNullChar)  -   1 )
         If  IText  =   " 关于 Microsoft Excel "   Then
            Mhwnd  =  wParam
            MyTid  =  SetTimer( 0 ,  0 ,  10 ,  AddressOf  pMsgOutProc)
         Else
            KillTimer  0 , MyTid
         End   If
     End   If
    HookProc_Excel  =  CallNextHookEx(IHook, nCode, wParam, lParam)
End Function
' ********************************************************************************************
' ********************************************************************************************
' -------设置钩子-----------
Sub  EnableHook()
     If  IHook  =   0   Then
        IThreadId  =  GetCurrentThreadId
        IHook  =  SetWindowsHookEx(WH_CBT,  AddressOf  HookProc_Excel, Application.hInstance, IThreadId)
     End   If
End Sub
' -------取消钩子-----------
Sub  FreeHook()
     If  IHook  <>   0   Then
         Call  UnhookWindowsHookEx(IHook)
        IHook  =   0
        KillTimer  0 , MyTid
     End   If
End Sub
' //****************************************************************************************************************************************
' //回调函数
' //****************************************************************************************************************************************
Private   Function  pMsgOutProc( ByVal  hwnd  As   Long ,  ByVal  uMsg  As   Long ,  ByVal  idEvent  As   Long ,  ByVal  SysTime  As   Long )  As   Long
     Dim  MyDC  As   Long , myIcon  As   Long , R  As  RECT, Mstr  As   String , IconRush  As   Long
    Mstr  =   " Hook应用之个性化你的Excel(Code by wangminbai) "
     ' 取得按钮颜色刷
    IconRush  =  GetSysColorBrush(COLOR_BTNFACE)
     ' 取得对话框场景
    MyDC  =  GetDC(Mhwnd)
     ' 载入图标
    myIcon  =  LoadIcon( 0 , IDI_EXCLAMATION)
     ' 在指定位置绘制图标，在这里最好用DrawIconEx函数。而不用DrawIcon函数，不然绘制图标时闪烁的厉害
    DrawIconEx MyDC,  80 ,  110 , myIcon,  0 ,  0 ,  0 , IconRush, DI_NORMAL
     ' 清除图标
    DestroyIcon myIcon
     ' 取得字符串的高度和宽度区域
    DrawTextEx MyDC, Mstr,  - 1 & , R, DT_CALCRECT,  ByVal   0 &
     ' 设置矩形区域
    SetRect R, R.Left  +   120 , R.Top  +   130 , R.Right  +   120 , R.Bottom  +   130
     ' 描绘文本
    DrawTextEx MyDC, Mstr,  - 1 & , R, DT_LEFT,  ByVal   0 &
     ' 释放设备环境
    ReleaseDC Mhwnd, MyDC
End Function

详见附件：
点击下载

转载于:https://www.cnblogs.com/wangminbai/archive/2008/03/08/1096398.html