Access-自定义控件TabControl
说说帖子的由来：
在论坛也混了蛮长时间了，一直没有发表过什么专题性质的文章。主要是论坛上高手如云，很多学习过程中的问题在论坛上都能找到答案，特别是论坛的精华帖。通过不断学习，我也开始对一些问题形成了些自己的想法。比如最近一段时间碰到一个问题：关于Access中动态添加控件的问题，Access中要给Form动态添加控件之类的，必须切换到窗体的设计模式，即使通过VBA代码也必须这么做。以往碰到这个问题，一般的做法是在窗体中先添加固定数目的控件，然后窗体加载时将其隐藏，当需要动态添加时就将其显示出来，但是这个方法一旦超出当初添加控件的数目时，就没办法解决了，并且控件添加多了对窗体加载速度也有一定影响。另外的话也可以通过一些ActiveX控件来做到这些，不过要找到适合Access且适合自己需求的ActiveX控件并不是件容易的事情，鉴于此我就想怎么才能在窗体上动态添加控件。
其实这个问题纠结了差不多有1年了，当初也想到来自绘这个途径，但是有好几个问题都不懂，所以解决不了。这些问题包括：
1、自绘的话，用什么在窗体上自绘？ 肯定不能用Access的控件，线条、框什么的都不能用，因为这些都不能动态添加到窗体上。只有选择通过API来绘图，可以使用的包括GDI、GDI+。但是我那时对GDI和GDI+是一点了解都没有，所以画了很长时间研究VBA中用API、GDI跟GDI+。
2、要用API绘图就要有窗体句柄、要获得设备环境(DC)，Access里怎么获取这些了？
可能有些人马上会想到Access窗体有个hwnd属性啊，不就可以了吗？其实这里面还有些曲折，后面我会详细说。这里大家所要了解的是Access的窗体下面还包含了好几个，包括窗体页眉、主体跟窗体页脚，它们都有句柄，要进行绘图的话，你得获取对应的句柄，而不是直接使用Access窗体的hwnd属性。
3、以上2个问题解决了，还只是完成了在窗体上自绘，要怎样才能将这些自绘窗体像控件一样使用到其他窗体上了？
可能大家看完这个问题，对Access有些了解的朋友会马上想到子窗体。但是当时我是想了1个星期才想到用子窗体，因为当初对这个问题我的想法是怎么在Access中做自定义控件，而没有想到怎么将窗体放到窗体里面这个方法。使用子窗体作为类似“控件”容器的承载体，这就解决的自定义控件的“容器”问题。
好了，说完这几个问题，那么我再总结下要读懂本文内容所需要储备的知识，如果你还对以下内容完全不了解的话，我建议你首先百度下或者找找相关的书什么的了解下，当然你也可以继续读下去，因为我会尽力讲的通俗易懂。不过如果你感觉阅读的很吃力的话，那你最好还是补一补相关的内容再来。
1、VBA中如何使用API？
2、GDI是用来干什么的？如何使用GDI？GDI句柄跟设备环境的关系，如何用GDI绘图？
3、Access窗体的构成。
4、Access子窗体是什么？怎么使用子窗体？
5、VBA中的类模块是什么？怎么使用类模块？类模块属性、方法、事件怎么建立？
6、Access窗体与类模块的关系；
7、使用VBA代码怎么调用自定义“控件”？
8、集合在类模块中的使用；
另外我也想说明一下，由于本贴内容可能会比较长，我会分批将所写内容更新进来，由于平时工作比较忙，可能一次更新的内容也不会太多，所以希望大家也不要急躁，慢慢看慢慢消化。另外相应的代码部分也有很多在调试之中，但是大部分主体的代码已经完成，我暂时不把源代码随帖子一起发布，我会将其中的大部分代码写到本贴里面并讲解，希望有兴趣的将贴看下去。
下面我们就开始讲怎么在Access来做一个类似TabControl的“控件”。
首先，我们来看下最终的效果，示例中包含了2个窗体，frmTest是个测试窗体,TabControl就是我们所谓的当作控件来使用的子窗体。另外还有些模块跟类模块，有些模块是无用的，因为我在做这个的时候，借鉴了部分代码，只是没有删除，我在后面会说到有哪些模块跟代码会使用到的，所以这里就不再说明各个模块的作用了。
双击打开frmTest，默认会建立3个框，相当于3个Tab，点击添加按钮，会自动添加Tab，点删除按钮会从最后依次删除Tab，在某个Tab上点击，会弹出一个对话框显示当前Tab的序号。
第一部分、建立clsAccTabBar类模块
在动手编写代码前，首先我们得分析下TabControl控件的结构，搞清楚我们需要建立什么样的模块、类模块以及窗体模块。从上面我们已经看到了我们用了一个子窗体作为TabControl的容器，那么TabControl里面还包括了很多Tab，这些Tab会构成一个集合Tabs，所以这个控件的层级关系就是：
TabControl
+---Tabs
+----Tab
之所以要理清楚这个关系，是因为基于这个结构建立我们的“控件”，会大大方便对我们控件的访问。这里的TabControl对应我们的窗体，Tabs的话我们将在TabControl的窗体代码中建立一个私有集合变量mTabBars，而Tab这个东西就需要我们自己来写类模块了。我将这个类模块命名为clsAccTabBar,cls代码是类模块，Acc表示是Access中的，TabBar就是这个类模块的含义。
下面我们来分析下这个类模块的内容，这个类模块所代表的是TabControl中的一个TabBar：
1、与属性相关的：包括TabBar的位置信息(Top、Left、Right、Bottom)、鼠标是否在其上(IsMouseOn)、是否被单击(Selected)、显示文字内容(Text)、标识字符串(Key)。可能大家还会说有与颜色相关的属性，这些我都放在了TabControl里面了，因为这些颜色是所有Tab共用的，而不是某一个Tab专属的，即使是选中色、鼠标移动其上的颜色。
2、与方法相关：Tab重画，这个方法我将它写在了TabControl里面了，当然你如果有兴趣可以为Tab建立一个ReDraw的方法；
3、与事件相关：TabBar被单击事件，TabBar鼠标移动事件，这2个事件的实现有些特殊，按道理应该在Tab类模块里建立这2个事件，但是鼠标的移动跟单击触发都是在TabControl里面，所以这2个事件我都把实现做到了TabControl窗体的事件代码里面了，后面讲述TabControl的时候我会再讲；
从上面的描述来看，我基本上把这个clsAccTabBar类模块只让其用于保存各个Tab相关信息，下面是类模块里面的代码：
1 Option Compare Database 2 3 Private mIndex As Integer 4 Private mKey As String 5 Private mText As String 6 Private mTargetFom As String 7 Private mSelected As Boolean 8 Private mIsMouseOn As Boolean 9 10 Public Property Get Index() As Integer 11 Index = mIndex 12 End Property 13 14 Public Property Let Index(Value As Integer) 15 mIndex = Value 16 End Property 17 18 Public Property Get Key() As String 19 Key = mKey 20 End Property 21 22 Public Property Get Text() As String 23 Text = mText 24 End Property 25 26 Public Property Let Text(Value As String) 27 mText = Value 28 End Property 29 30 Public Property Get TargetFom() As String 31 TargetForm = mtargetform 32 End Property 33 34 Public Property Get Left() As Long 35 Left = mRect.Left 36 End Property 37 38 Public Property Let Left(Value As Long) 39 mRect.Left = Value 40 End Property 41 42 Public Property Get Right() As Long 43 Right = mRect.Right 44 End Property 45 46 Public Property Let Right(Value As Long) 47 mRect.Right = Value 48 End Property 49 50 Public Property Get Top() As Long 51 Top = mRect.Top 52 End Property 53 54 Public Property Let Top(Value As Long) 55 mRect.Top = Value 56 End Property 57 58 Public Property Get Bottom() As Long 59 Bottom = mRect.Bottom 60 End Property 61 62 Public Property Let Bottom(Value As Long) 63 mRect.Bottom = Value 64 End Property 65 66 Public Property Get Width() As Long 67 Width = Abs(mRect.Right - mRect.Left) 68 End Property 69 70 Public Property Get Height() As Long 71 Height = Abs(mRect.Bottom - mRect.Top) 72 End Property 73 74 Public Property Get IsMouseOn() As Boolean 75 IsMouseOn = mIsMouseOn 76 End Property 77 78 Public Property Let IsMouseOn(Value As Boolean) 79 mIsMouseOn = Value 80 End Property 81 82 Public Property Get Selected() As Boolean 83 Selected = mSelected 84 End Property 85 86 Public Property Let Selected(Value As Boolean) 87 mSelected = Value 88 End Property
有些属性我在前面没有提到，而在代码里又有，比如Width、Height，这个是宽度、高度，这个都是根据其他属性值来计算得到的。当然这里我再给大家提一下类模块的属性建立问题。 前面有很多私有变量声明，我这里把它们叫做类模块的字段，它们都是以m开头的，之后我所有的代码都是以m开头来代表类模块中的字段，与这些字段对应的Get/Let属性方法表示对这些字段的读取/写入操作。类模块中建立字段、属性的标准范式就是如此，应该避免使用公用变量。如果你对类模块的属性建立不是很清楚，还请在论坛或百度查阅相关的内容。
第二部分 构建Tabs集合
前面第一部分大家已经看到了clsAccTabBar的代码，内容是不是比较简单？确实比较简单，因为很多东西我都把它放到了TabControl里面实现了。大家对于clsAccTabBar这个类模块牢记2点:其一：这个类模块与之前所分析的模型中Tab对应，它将是某个具体Tab对象的模板代码；
其二:这个类模块所实现的功能就是用于记录每一个Tab的信息，在运行时，这个类模块帮助我们把这些信息存储在内存中；当要进行重画时，我们又可以使用这个类模块读取数据，用GDI把所有Tab画出来，或者画其中某几个Tab；
下面我们就来看看TabControl跟Tabs的实现吧，关于绘图的内容我将会在后面再单独说，因为后面我们还会将绘图部分的功能单独写入一个类模块中。我们先从最简单的Tabs来分析吧，稍后再看TabControl。Tabs是一个Tab的集合，我们直接使用Collection对象，虽然可能使用这个集合对象对于集合项目数较多时，性能会下降，但是我想谁也不可能在一个程序界面里出来个成百上千的Tab标签页吧！对于一个集合，我们所需要的功能包括添加、删除以及查找，而Collection对象都有现成的，确实方便多了。
首先我们要在TabControl窗体代码里面声明一个mTabBars的Collection对象：
1 Private mTabBars As New Collection
这里我直接用New声明了，也就是说这个TabControl“控件”被初始化时，就会在内存里分配空间给mTabBars(当然大家也可以不这么做，而是在添加TabBar方法里面对mTabBars进行检测，如果是nothing，就使用Set mTabBars=New Collection)。然后在窗体的UnLoad事件里面将mTabBars置为Nothing。这里啰嗦一句，实际编程的时候，大家要养成习惯，对需要进行清理的对象变量或者API中的一些资源对象，当存在调用代码时，立即在相应处添加清理代码，这样可以减少很多莫名奇妙的错误，特别是在VBA中使用API进行GDI编程时，这个好习惯可以帮助你减少很多不必要的调试麻烦。例如下面的ReleaseDC，它是GDI操作中的一个API函数，用于清除设备环境(DC)引用,mFormMainHwnd是对应的窗口句柄，mMainDC就是这个设备环境，设备环境是Windows非常珍贵的系统资源，如果用了不记得及时“还回”给系统，会造成程序莫名其妙出错，而且没有任何错误提示，甚至造成系统崩溃！
1 Private Sub Form_Unload(Cancel As Integer) 2 ReleaseDC mFormMainHwnd, mMainDC 3 Set mTabBars = Nothing 4 End Sub
下面我们再来看看如何向这个集合对象添加TabBar进去：
1 Public Sub AddTabBar(ByVal Key As String, ByVal Text As String, ByVal TargetForm As String) 2 Dim mTabBar As New clsAccTabBar 3 Dim lngText As Long 4 Dim mTextSize As Size 5 6 lngText = LenB(StrConv(Text, vbFromUnicode)) 7 GetTextExtentPoint32 mMainDC, Text, lngText, mTextSize 8 9 If TabCount = 0 Then 10 mTabBar.Left = 0 11 mTabBar.Top = 0 12 mTabBar.Right = mTextSize.cx + 16 13 mTabBar.Bottom = 30 14 Else 15 mTabBar.Left = mTabBars(TabCount).Right + 0.6 16 mTabBar.Top = 0 17 mTabBar.Right = mTabBar.Left + mTextSize.cx + 16 18 mTabBar.Bottom = 30 19 End If 20 mTabBar.Text = Text 21 mTabBars.Add mTabBar 22 ReDrawTabBar mTabBars.count 23 End Sub
方法有3个参数，前2个通过英文名就知道是什么意思，里面的代码我还没有使用到Key，只使用了Text，最后一个参数是个预留参数，暂时也没有用到。下面讲下代码内容，声明了3个变量，第一个mTabBar用于保存需要添加的TabBar的相关数据，第二个lngText保存Text字符串的长度，这个参数传递给API函数GetTextExtentPoint32，用于获取字符串的实际显示像素宽度；第三个mTextSize用于保存GetTextExtentPoint32函数运算后，所获得的字符串实际显示像素宽高值，它是一个Size的数据结构，代码如下：
1 Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" ( _ 2 ByVal hdc As Long, _ 3 ByVal lpsz As String, _ 4 ByVal cbString As Long, _ 5 lpSize As Size) As Long 6 7 Public Type Size 8 cx As Long 9 cy As Long 10 End Type
需要提醒的是，GetTextExtentPoint32的声明最好放在TabControl的代码窗口中，Size的声明最好放在单独的模块代码中。GetTextExtentPoint32函数所使用mMainDC参数指的是主体窗口的设备环境DC，大家只需要知道这个东西就可以了，因为只有得到这个才能调用GDI进行绘图，关于绘图我再专门讲述，所以这里大家不用纠结这个，记住它是个与主体相关的画图用的设备环境就行了。然后后面的代码意图是当mTabBars没有TabBar时，直接写入首个TabBar的数据，其中的Right值是字符宽度加上16(左右边距合计16个像素)，当有TabBar时，根据前一个TabBar的数据设置当前添加TabBar的数据。随后将这个TabBar添加到集合中，并调用ReDrawTabBar方法把这个TabBar画出来。
下面我们再来说下TabBar的删除操作，删除TabBar不仅仅是将其从mTabBars集合中清除掉，还要将窗体上的图像进行重绘，用背景色填充掉原先TabBar所在的位置，给查看者的感觉就是被删除掉了。代码如下，其中有2行代码(首行与末行)被我注释掉了，因为关于GDI绘图的方法我暂时还是写在了TabControl的代码里面，还没有完成对clsAccGDI类模块的代码，后面在说到GDI绘图时我还是继续讲述TabControl中的代码，大家有兴趣可以自己写写clsAccGDI类模块。
1 Public Sub RemoveTabBar() 2 On Error GoTo Err_Handle 3 'Dim FormDrawer As New clsAccGDI 4 Dim mRect As Rect 5 Dim mLastIndex As Integer 6 7 mLastIndex = mTabBars.count 8 9 mRect.Left = mTabBars(mLastIndex).Left 10 mRect.Right = mTabBars(mLastIndex).Right 11 mRect.Bottom = mTabBars(mLastIndex).Bottom 12 mRect.Top = mTabBars(mLastIndex).Top 13 FillTargetRect RGB(255, 255, 255), mRect 14 mTabBars.Remove mLastIndex 15 GoTo Exit_Sub 16 Err_Handle: 17 MsgBox "出错！" 18 Exit_Sub: 19 'Set FormDrawer = Nothing 20 End Sub
接下来我们再来看看如何在mTabBars中找到制定的TabBar，由于我之前的代码没有使用到Key，所以这里也没有基于Key来定位TabBar，我也没有写一个专门用于定位TabBar的方法，只是使用了最通用的For循环来查找，如果大家觉得不好，可以自己写个定位TabBar的方法。我这里把主体的MouseMove事件代码列出来说明下我搜索的方法。
1 Private Sub 主体_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 2 Dim intX As Integer 3 Dim pX As Long, pY As Long 4 Dim mCurrentOn As Integer 5 6 pX = X / TwipsPerPixelX() 7 pY = Y / TwipsPerPixelY() 8 9 For intX = 1 To mTabBars.count 10 If pX >= mTabBars(intX).Left And pX <= mTabBars(intX).Right And _ 11 pY >= mTabBars(intX).Top And pY <= mTabBars(intX).Bottom Then 12 mTabBars(intX).IsMouseOn = True 13 ReDrawTabBar intX 14 mCurrentOn = intX 15 Exit For 16 End If 17 'Debug.Print "(x,y):(" & pX & "," & py & ")" & vbTab & "(Rx):(" & mTabBars(intX).Left & ")" 18 Next 19 If mPreTabBarOn <> mCurrentOn Then 20 If mPreTabBarOn > 0 Then 21 mTabBars(mPreTabBarOn).IsMouseOn = False 22 ReDrawTabBar mPreTabBarOn 23 End If 24 mPreTabBarOn = mCurrentOn 25 End If 26 'ReDraw 27 mMousePoint.X = pX 28 mMousePoint.Y = pY 29 End Sub
说明下以上代码的意思，intX是个循环变量，在For循环中作为Index来遍历mTabBars集合，px，py是鼠标的坐标位置(像素值)，VBA中MouseMove事件中返回X，Y是以Twip为单位的值，所以需要使用TwipsPerPixelX、TwipsPerPixelY自定义函数将其转换为像素值。建立一个模块mdlSysInfo，然后复制一下代码到模块中。随后以上的代码通过鼠标坐标值来判断其所在TabBar，找到时，完成一系列的设置操作，包括设置TabBar的IsMouseOn属性，重画TabBar并保存当前所处TabBar在mTabBars中的序号。随后再对之前鼠标所在的TabBar重画，并修改其IsMouseOn属性、保存之前鼠标所在TabBar的序号。最后保存鼠标当前位置数据，这个数据会在Click事件中使用到。
1 Option Compare Database 2 Option Explicit 3 4 Public Type Size 5 cx As Long 6 cy As Long 7 End Type 8 9 Private Declare Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long 10 Private Declare Function ReleaseDC Lib "user32" (ByVal Hwnd As Long, ByVal hdc As Long) As Long 11 Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long 12 13 Private Const HWND_DESKTOP As Long = 0 14 Private Const LOGPIXELSX As Long = 88 15 Private Const LOGPIXELSY As Long = 90 16 17 'Returns the width of a pixel, in twips. 18 Public Function TwipsPerPixelX() As Single 19 Dim lngDC As Long 20 21 lngDC = GetDC(HWND_DESKTOP) 22 TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX) 23 ReleaseDC HWND_DESKTOP, lngDC 24 End Function 25 26 'Returns the height of a pixel, in twips. 27 Public Function TwipsPerPixelY() As Single 28 Dim lngDC As Long 29 30 lngDC = GetDC(HWND_DESKTOP) 31 TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY) 32 ReleaseDC HWND_DESKTOP, lngDC 33 End Function
