VB进行子类化

目录

• 何谓子类化（subclassing）
• Visual Basic 6子类化的实现
• Visual Basic .NET子类化的实现
• 小结

1. 何谓子类化（subclassing）

　　众所周知，Windows是一个基于消息的系统，消息在Windows的对象之间进行着传递。子类化和Windows的钩子机制存在于消息系统之中，我们可以利用这些机制来操纵、修改甚至丢弃那些在操作系统或是进程中传递的消息，以求改变系统的一些行为。子类化技术用来截取窗口或控件之间的消息，当然是消息在到达目的窗口之前完成的操作。这些被截获的消息既可以保留也可以修改它们的状态，之后就继续发送到目的地。子类化技术实现了一些正常情况下无法实现的功能，试想鼠标右键单击TextBox，系统默认弹出Undo、Cut、Copy、Paste等菜单，我们就可以利用子类化技术来改变这个系统菜单。

　　简单的说，子类化就是创建一个新的窗口消息处理过程，并将其插入到原先的默认窗口消息处理过程之前。

　　子类化分为三类：实例子类化（instance subclassing）—从窗口或控件的单一实例截获消息，这种子类化技术最普遍；全局子类化（global subclassing）—能够截获从相同的窗口类创建出来的多个窗口或控件的消息；超类化（superclassing）—和全局子类化很类似，区别在于可以应用在新的窗口类上面。

2. Visual Basic 6子类化的实现

　　在Visual Basic 6子类化的实现中我将通过一段代码的实例来介绍这一技术在VB6中的应用。现在很多开发社区中经常谈到的一个话题就是界面开发如何Skin，这种技术有很多解决方式，如使用可以贴图的控件或使用第三方开发的换肤ActiveX控件。其实Skin技术需要处理的是WM_DRAWITEM、WM_MEASUREITEM、WM_NCPAINT消息，这些消息的主要用途就是可以重画控件和窗口的非客户区。想要对这些VB6无法处理的消息进行编程就必须用到子类化，这些消息都会被发送到能够自绘的控件的窗口上，因此下面的例子就是利用窗口子类化来重画Button控件。

①创建工程

　　启动Visual Basic 6同时创建一个标准EXE工程。

②窗口布局

　　在FORM1上放置3个Button控件，并将前两个Button的Style属性设置为1-Graphical，因为只有Style属性设置为Graphical的Button才可以Owner-drawn。

③在窗体中录入代码

 

代码

Private   Sub  Command3_Click() 

' 通过Enabled属性的控制，来显示重画控件在Unenabled状态时的效果 
If  Command1.Enabled  Then  

Command1.Enabled  =   False  

Else  

Command1.Enabled  =   True  

End   If  

End Sub  

Private   Sub  Form_Load() 

' 安装子类化入口 
Call  Init( Me .hWnd) 

End Sub  

Private   Sub  Form_Unload(Cancel  As   Integer ) 

' 卸载子类化 
Call  Terminate( Me .hWnd) 

End Sub
④加入一个模块并录入代码 
Option   Explicit

'  -- 引用Win32Api –
' 得到默认的窗口消息处理过程的地址需要的API

Private   Declare   Function  GetWindowLong  Lib   " user32 "   Alias   " GetWindowLongA "  ( ByVal  hWnd  As   Long ,  ByVal  nIndex  As   Long )  As   Long

' 设置一个新的窗口消息处理过程的地址需要的API

Private   Declare   Function  SetWindowLong  Lib   " user32 "   Alias   " SetWindowLongA "  ( ByVal  hWnd  As   Long ,  ByVal  nIndex  As   Long ,  ByVal  dwNewLong  As   Long )  As   Long

' 给指定的窗口消息处理过程传递消息需要的API

Private   Declare   Function  CallWindowProc  Lib   " user32 "   Alias   " CallWindowProcA "  ( ByVal  lpPrevWndFunc  As   Long ,  ByVal  hWnd  As   Long ,  ByVal  Msg  As   Long ,  ByVal  wParam  As   Long ,  ByVal  lParam  As   Long )  As   Long

' 内存拷贝

Private   Declare   Sub  CopyMemory  Lib   " kernel32 "   Alias   " RtlMoveMemory "  (Destination  As  Any, Source  As  Any,  ByVal  Length  As   Long )

Const  GWL_WNDPROC  =  ( - 4 & )

Dim  PrevWndProc &

Private   Const  WM_DESTROY  =   & H2

Private   Const  WM_DRAWITEM  =   & H2B

Private  Type RECT

  Left   As   Long
 
 Top  As   Long
 
  Right   As   Long
 
 Bottom  As   Long

End  Type

' WM_DRAWITEM需要处理的结构体

Private  Type DRAWITEMSTRUCT

CtlType  As   Long

CtlID  As   Long

itemID  As   Long

itemAction  As   Long

itemState  As   Long

hwndItem  As   Long

hdc  As   Long

rcItem  As  RECT

itemData  As   Long

End  Type

'  Owner draw 常量

Private   Const  ODT_BUTTON  =   4

'  Owner draw 动作

Private   Const  ODA_DRAWENTIRE  =   & H1

Private   Const  ODA_SELECT  =   & H2

Private   Const  ODA_FOCUS  =   & H4

'  Owner draw 状态

Private   Const  ODS_SELECTED  =   & H1

Private   Const  ODS_GRAYED  =   & H2

Private   Const  ODS_DISABLED  =   & H4

Private   Const  ODS_CHECKED  =   & H8

Private   Const  ODS_FOCUS  =   & H10

' 得到指定窗口的文本

Private   Declare   Function  GetWindowText  Lib   " user32 "   Alias   " GetWindowTextA "  ( ByVal  hWnd  As   Long ,  ByVal  lpString  As   String ,  ByVal  cch  As   Long )  As   Long

' GDI相关API函数，重画Button时使用

Private   Declare   Function  SelectObject  Lib   " gdi32 "  ( ByVal  hdc  As   Long ,  ByVal  hObject  As   Long )  As   Long

Private   Declare   Function  CreateSolidBrush  Lib   " gdi32 "  ( ByVal  crColor  As   Long )  As   Long

Private   Declare   Function  DeleteObject  Lib   " gdi32 "  ( ByVal  hObject  As   Long )  As   Long

Private   Declare   Function  GetSysColor  Lib   " user32 "  ( ByVal  nIndex  As   Long )  As   Long

' 色彩常量

Const  COLOR_SCROLLBAR  =   0

Const  COLOR_BACKGROUND  =   1

Const  COLOR_ACTIVECAPTION  =   2

Const  COLOR_INACTIVECAPTION  =   3

Const  COLOR_MENU  =   4

Const  COLOR_WINDOW  =   5

Const  COLOR_WINDOWFRAME  =   6

Const  COLOR_MENUTEXT  =   7

Const  COLOR_WINDOWTEXT  =   8

Const  COLOR_CAPTIONTEXT  =   9

Const  COLOR_ACTIVEBORDER  =   10

Const  COLOR_INACTIVEBORDER  =   11

Const  COLOR_APPWORKSPACE  =   12

Const  COLOR_HIGHLIGHT  =   13

Const  COLOR_HIGHLIGHTTEXT  =   14

Const  COLOR_BTNFACE  =   15

Const  COLOR_BTNSHADOW  =   16

Const  COLOR_GRAYTEXT  =   17

Const  COLOR_BTNTEXT  =   18

Const  COLOR_INACTIVECAPTIONTEXT  =   19

Const  COLOR_BTNHIGHLIGHT  =   20

Private   Declare   Function  FillRect  Lib   " user32 "  ( ByVal  hdc  As   Long , lpRect  As  RECT,  ByVal  hBrush  As   Long )  As   Long

Private   Declare   Function  FrameRect  Lib   " user32 "  ( ByVal  hdc  As   Long , lpRect  As  RECT,  ByVal  hBrush  As   Long )  As   Long

Private   Declare   Function  CreatePen  Lib   " gdi32 "  ( ByVal  nPenStyle  As   Long ,  ByVal  nWidth  As   Long ,  ByVal  crColor  As   Long )  As   Long

' 画笔格式

Const  PS_SOLID  =   0

Const  PS_DASH  =   1   '  -------

Const  PS_DOT  =   2   '  .......

Const  PS_DASHDOT  =   3   '  _._._._

Const  PS_DASHDOTDOT  =   4   '  _.._.._

Const  PS_NULL  =   5

Const  PS_INSIDEFRAME  =   6

Const  PS_USERSTYLE  =   7

Const  PS_ALTERNATE  =   8

Const  PS_STYLE_MASK  =   & HF

Private   Declare   Function  MoveToEx  Lib   " gdi32 "  ( ByVal  hdc  As   Long ,  ByVal  x  As   Long ,  ByVal  y  As   Long , lpPoint  As  POINTAPI)  As   Long

Private   Declare   Function  LineTo  Lib   " gdi32 "  ( ByVal  hdc  As   Long ,  ByVal  x  As   Long ,  ByVal  y  As   Long )  As   Long

Private  Type POINTAPI

 x  As   Long
 
 y  As   Long

End  Type

Private   Declare   Function  DrawText  Lib   " user32 "   Alias   " DrawTextA "  ( ByVal  hdc  As   Long ,  ByVal  lpStr  As   String ,  ByVal  nCount  As   Long , lpRect  As  RECT,  ByVal  wFormat  As   Long )  As   Long

Private   Const  DT_SINGLELINE  =   & H20

Private   Const  DT_CENTER  =   & H1

Private   Const  DT_VCENTER  =   & H4

Private   Declare   Function  SetTextColor  Lib   " gdi32 "  ( ByVal  hdc  As   Long ,  ByVal  crColor  As   Long )  As   Long

Private   Declare   Function  SetBkMode  Lib   " gdi32 "  ( ByVal  hdc  As   Long ,  ByVal  nBkMode  As   Long )  As   Long

Private   Const  TRANSPARENT  =   1

'  – 声明结束 --

Private   Sub  DrawButton( ByVal  hWnd  As   Long ,  ByVal  hdc  As   Long , rct  As  RECT,  ByVal  nState  As   Long )

  Dim  P  As  POINTAPI
 
  Dim  s  As   String
 
  Dim  hbr  As   Long
 
  Dim  hpen  As   Long
 
 
 
 hbr  =  CreateSolidBrush(GetSysColor(COLOR_BTNFACE))  ' RGB(231, 231, 231)
 
 SelectObject hdc, hbr
 
 FillRect hdc, rct, hbr
 
 DeleteObject hbr
 
 
 
  ' 画文字时背景为透明状
 
 SetBkMode hdc, TRANSPARENT
 
  ' 得到Button的Caption
 
 s  =   String $( 255 ,  "   " )
 
 GetWindowText hWnd, s,  255
 
 s  =   Trim $(s)
 
  ' 根据Button的Enabled状态进行重画
 
  If  (nState  And  ODS_DISABLED)  =  ODS_DISABLED  Then
 
  ' 画外围灰框
 
 hbr  =  CreateSolidBrush( RGB ( 132 ,  130 ,  132 ))
 
 SelectObject hdc, hbr
 
 FrameRect hdc, rct, hbr
 
 DeleteObject hbr
 
  ' 画内侧3D效果->亮色
 
 hpen  =  CreatePen(PS_SOLID,  1 ,  RGB ( 255 ,  255 ,  255 ))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left  +   1 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Right  -   1 , rct.Top  +   1
 
 MoveToEx hdc, rct.Left  +   1 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Left  +   1 , rct.Bottom  -   1
 
 DeleteObject hpen
 
  ' 画内侧3D效果->暗色
 
 hpen  =  CreatePen(PS_SOLID,  1 ,  RGB ( 189 ,  190 ,  189 ))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left  +   1 , rct.Bottom  -   2 , P
 
 LineTo hdc, rct.Right  -   1 , rct.Bottom  -   2
 
 MoveToEx hdc, rct.Right  -   2 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Right  -   2 , rct.Bottom  -   1
 
 DeleteObject hpen
 
  ' 画阴影文字
 
 rct.Left  =  rct.Left  +   1
 
 rct.Right  =  rct.Right  +   1
 
 rct.Bottom  =  rct.Bottom  +   1
 
 rct.Top  =  rct.Top  +   1
 
 SetTextColor hdc, GetSysColor(COLOR_BTNHIGHLIGHT)
 
 DrawText hdc, s, LenB( StrConv (s, vbFromUnicode)), rct, DT_CENTER  Or  DT_SINGLELINE  Or  DT_VCENTER
 
 rct.Left  =  rct.Left  -   1
 
 rct.Right  =  rct.Right  -   1
 
 rct.Bottom  =  rct.Bottom  -   1
 
 rct.Top  =  rct.Top  -   1
 
 SetTextColor hdc, GetSysColor(COLOR_GRAYTEXT)
 
 DrawText hdc, s, LenB( StrConv (s, vbFromUnicode)), rct, DT_CENTER  Or  DT_SINGLELINE  Or  DT_VCENTER
 
  Exit Sub
 
  End   If
 
  ' 按下Button时重画
 
  If  (nState  And  ODS_SELECTED)  =  ODS_SELECTED  Then
 
  ' 画内部区域颜色
 
 hbr  =  CreateSolidBrush( RGB ( 156 ,  186 ,  222 ))
 
 SelectObject hdc, hbr
 
 FillRect hdc, rct, hbr
 
 DeleteObject hbr
 
  ' 画外围灰框
 
 hbr  =  CreateSolidBrush( RGB ( 99 ,  125 ,  165 ))
 
 SelectObject hdc, hbr
 
 FrameRect hdc, rct, hbr
 
 DeleteObject hbr
 
  ' 画内侧3D效果->亮色
 
 hpen  =  CreatePen(PS_SOLID,  1 ,  RGB ( 123 ,  158 ,  206 ))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left  +   1 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Right  -   1 , rct.Top  +   1
 
 MoveToEx hdc, rct.Left  +   1 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Left  +   1 , rct.Bottom  -   1
 
 DeleteObject hpen
 
  ' 画内侧3D效果->暗色
 
 hpen  =  CreatePen(PS_SOLID,  1 ,  RGB ( 181 ,  203 ,  231 ))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left  +   1 , rct.Bottom  -   2 , P
 
 LineTo hdc, rct.Right  -   1 , rct.Bottom  -   2
 
 MoveToEx hdc, rct.Right  -   2 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Right  -   2 , rct.Bottom  -   1
 
 DeleteObject hpen
 
 
 
 rct.Left  =  rct.Left  +   1
 
 rct.Right  =  rct.Right  +   1
 
 rct.Bottom  =  rct.Bottom  +   1
 
 rct.Top  =  rct.Top  +   1
 
 SetTextColor hdc, GetSysColor(COLOR_BTNTEXT)
 
 DrawText hdc, s, LenB( StrConv (s, vbFromUnicode)), rct, DT_CENTER  Or  DT_SINGLELINE  Or  DT_VCENTER
 
  Exit Sub
 
  End   If
 
  ' Button得到焦点时重画
 
  If  (nState  And  ODS_FOCUS)  =  ODS_FOCUS  Then
 
  ' 画内部区域颜色
 
 hbr  =  CreateSolidBrush( RGB ( 173 ,  203 ,  239 ))
 
 SelectObject hdc, hbr
 
 FillRect hdc, rct, hbr
 
 DeleteObject hbr
 
  ' 画外围灰框
 
 hbr  =  CreateSolidBrush( RGB ( 107 ,  138 ,  181 ))
 
 SelectObject hdc, hbr
 
 FrameRect hdc, rct, hbr
 
 DeleteObject hbr
 
  ' 画内侧3D效果->亮色
 
 hpen  =  CreatePen(PS_SOLID,  1 ,  RGB ( 198 ,  223 ,  247 ))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left  +   1 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Right  -   1 , rct.Top  +   1
 
 MoveToEx hdc, rct.Left  +   1 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Left  +   1 , rct.Bottom  -   1
 
 DeleteObject hpen
 
  ' 画内侧3D效果->暗色
 
 hpen  =  CreatePen(PS_SOLID,  1 ,  RGB ( 132 ,  174 ,  222 ))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left  +   1 , rct.Bottom  -   2 , P
 
 LineTo hdc, rct.Right  -   1 , rct.Bottom  -   2
 
 MoveToEx hdc, rct.Right  -   2 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Right  -   2 , rct.Bottom  -   1
 
 DeleteObject hpen
 
 
 
 SetTextColor hdc, GetSysColor(COLOR_BTNTEXT)
 
 DrawText hdc, s, LenB( StrConv (s, vbFromUnicode)), rct, DT_CENTER  Or  DT_SINGLELINE  Or  DT_VCENTER
 
  Else
 
  ' 画外围灰框
 
 hbr  =  CreateSolidBrush( RGB ( 132 ,  130 ,  132 ))
 
 SelectObject hdc, hbr
 
 FrameRect hdc, rct, hbr
 
 DeleteObject hbr
 
  ' 画内侧3D效果->亮色
 
 hpen  =  CreatePen(PS_SOLID,  1 ,  RGB ( 255 ,  255 ,  255 ))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left  +   1 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Right  -   1 , rct.Top  +   1
 
 MoveToEx hdc, rct.Left  +   1 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Left  +   1 , rct.Bottom  -   1
 
 DeleteObject hpen
 
  ' 画内侧3D效果->暗色
 
 hpen  =  CreatePen(PS_SOLID,  1 ,  RGB ( 189 ,  190 ,  189 ))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left  +   1 , rct.Bottom  -   2 , P
 
 LineTo hdc, rct.Right  -   1 , rct.Bottom  -   2
 
 MoveToEx hdc, rct.Right  -   2 , rct.Top  +   1 , P
 
 LineTo hdc, rct.Right  -   2 , rct.Bottom  -   1
 
 DeleteObject hpen
 
  ' 画文字
 
 SetTextColor hdc, GetSysColor(COLOR_BTNTEXT)
 
 DrawText hdc, s, LenB( StrConv (s, vbFromUnicode)), rct, DT_CENTER  Or  DT_SINGLELINE  Or  DT_VCENTER
 
  End   If

End Sub

' 新的窗口消息处理过程，将被插入到默认处理过程之前

Private   Function  SubWndProc( ByVal  hWnd  As   Long ,  ByVal  Msg  As   Long ,  ByVal  wParam  As   Long ,  ByVal  lParam  As   Long )  As   Long

  Dim  di  As  DRAWITEMSTRUCT
 
  If  Msg  =  WM_DESTROY  Then  Terminate (hWnd)
 
  ' 处理自画消息
 
  If  Msg  =  WM_DRAWITEM  Then
 
 CopyMemory di,  ByVal  lParam,  Len (di)
 
  ' 判断是自画Button
 
  If  di.CtlType  =  ODT_BUTTON  Then
 
 DrawButton di.hwndItem, di.hdc, di.rcItem, di.itemState
 
  ' 不返回VB的默认Button绘制过程
 
 SubWndProc  =   1
 
  Exit Function
 
  End   If
 
  End   If
 
  ' 调用默认的窗口处理过程
 
 SubWndProc  =  CallWindowProc(PrevWndProc, hWnd, Msg, wParam, lParam)

End Function

' 子类化入口

Public   Sub  Init(hWnd  As   Long )

 PrevWndProc  =  SetWindowLong(hWnd, GWL_WNDPROC,  AddressOf  SubWndProc)

End Sub

' 子类化出口

Public   Sub  Terminate(hWnd  As   Long )

  Call  SetWindowLong(hWnd, GWL_WNDPROC, PrevWndProc)

End Sub

'  -- 模块结束 -- '

 

 

3. Visual Basic .NET子类化的实现

　　.NET中使用子类化技术要比VB6中简单，因为微软在.NET中已经提供了接口，不需要我们再自己SetWindowLong了，我们做的是Overrides（覆盖） WndProc过程即可。
　　Overrides Protected Sub WndProc( ByRef m As Message )参数m实现了Windows的消息类型。

　　下面的例子将演示如何将About加入窗口的系统菜单。

①创建工程

　　创建一个VB.NET的Windows Application工程。

②录入代码

 

代码

Public   Class  Form1 

Inherits  System.Windows.Forms.Form 

' 中间隐去了.NET自动生成的代码 
'  – 引用Win32Api 
Private   Declare   Function  GetSystemMenu  Lib   " user32 "  ( ByVal  hWnd  As  IntPtr,  ByVal  bRevert  As  Int32)  As  Int32 
Private   Declare   Function  InsertMenu  Lib   " user32 "   Alias   " InsertMenuA "  ( ByVal  hMenu  As  Int32,  ByVal  nPosition  As  Int32,  ByVal  wFlags  As  Int32,  ByVal  wIDNewItem  As  Int32,  ByVal  lpNewItem  As   String )  As  Int32 

Private   Const  MF_BYCOMMAND  =   & H0 &  
Private   Const  MF_BYPOSITION  =   & H400 &  
Private   Const  MF_STRING  =   & H0 &  
Private   Const  MF_SEPARATOR  =   & H800 &  
Private   Const  WM_SYSCOMMAND  =   & H112 

Private   Sub  Form1_Load( ByVal  sender  As  System.Object,  ByVal  e  As  System.EventArgs)  Handles   MyBase .Load 

InsertMenu(GetSystemMenu( Me .Handle,  False ),  0 , MF_BYPOSITION  Or  MF_SEPARATOR,  2001 ,  "" )  ' 加入一条分割线 

' GetSystemMenu(Me.Handle, False)是得到系统菜单的句柄，第二个参数为True的话不能改变系统菜单，所以要设为False 
InsertMenu(GetSystemMenu( Me .Handle,  False ),  0 , MF_BYPOSITION  Or  MF_STRING,  2002 ,  " About Me(&A) " )  ' 加入About me菜单在系统菜单中 

End Sub  

Protected   Overrides   Sub  WndProc( ByRef  m  As  System.Windows.Forms.Message) 
' 类化窗口--覆盖WndProc过程 

If  m.Msg  =  WM_SYSCOMMAND  Then  

If  m.WParam.ToInt32  =   2002   Then  

MsgBox ( " About Context " , vbInformation,  " About... " ) 

End   If  

End   If  

' 调用窗口默认的处理过程 
MyBase .WndProc(m) 

End Sub  

End Class

 

4. 小结

　　子类化技术可以让我们实现一些使用VB在正常条件下无法完成的任务，而且通过这些技术可以更为深入的学习Windows编程，成为VB开发人员中的高手。

 

转载：http://laomaspeak.blog.sohu.com/96138422.html

转载于:https://www.cnblogs.com/huanghai/archive/2010/04/30/1724904.html