Access中自繪自定義“控件”

站到終點(diǎn)站

       在論壇也混了蠻長時(shí)間了，一直沒有發(fā)表過什么專題性質(zhì)的文章。主要是論壇上高手如云，很多學(xué)習(xí)過程中的問題在論壇上都能找到答案，特別是論壇的精華帖。通過不斷學(xué)習(xí)，我也開始對一些問題形成了些自己的想法。比如最近一段時(shí)間碰到一個(gè)問題：關(guān)于Access中動態(tài)添加控件的問題，Access中要給Form動態(tài)添加控件之類的，必須切換到窗體的設(shè)計(jì)模式，即使通過VBA代碼也必須這么做。以往碰到這個(gè)問題，一般的做法是在窗體中先添加固定數(shù)目的控件，然后窗體加載時(shí)將其隱藏，當(dāng)需要動態(tài)添加時(shí)就將其顯示出來，但是這個(gè)方法一旦超出當(dāng)初添加控件的數(shù)目時(shí)，就沒辦法解決了，并且控件添加多了對窗體加載速度也有一定影響。另外的話也可以通過一些ActiveX控件來做到這些，不過要找到適合Access且適合自己需求的ActiveX控件并不是件容易的事情，鑒于此我就想怎么才能在窗體上動態(tài)添加控件。
       其實(shí)這個(gè)問題糾結(jié)了差不多有1年了，當(dāng)初也想到來自繪這個(gè)途徑，但是有好幾個(gè)問題都不懂，所以解決不了。這些問題包括：
1、自繪的話，用什么在窗體上自繪？      肯定不能用Access的控件，線條、框什么的都不能用，因?yàn)檫@些都不能動態(tài)添加到窗體上。只有選擇通過API來繪圖，可以使用的包括GDI、GDI+。但是我那時(shí)對GDI和GDI+是一點(diǎn)了解都沒有，所以畫了很長時(shí)間研究VBA中用API、GDI跟GDI+。
2、要用API繪圖就要有窗體句柄、要獲得設(shè)備環(huán)境(DC)，Access里怎么獲取這些了？
     可能有些人馬上會想到Access窗體有個(gè)hwnd屬性啊，不就可以了嗎？其實(shí)這里面還有些曲折，后面我會詳細(xì)說。這里大家所要了解的是Access的窗體下面還包含了好幾個(gè)，包括窗體頁眉、主體跟窗體頁腳，它們都有句柄，要進(jìn)行繪圖的話，你得獲取對應(yīng)的句柄，而不是直接使用Access窗體的hwnd屬性。
3、以上2個(gè)問題解決了，還只是完成了在窗體上自繪，要怎樣才能將這些自繪窗體像控件一樣使用到其他窗體上了？
     可能大家看完這個(gè)問題，對Access有些了解的朋友會馬上想到子窗體。但是當(dāng)時(shí)我是想了1個(gè)星期才想到用子窗體，因?yàn)楫?dāng)初對這個(gè)問題我的想法是怎么在Access中做自定義控件，而沒有想到怎么將窗體放到窗體里面這個(gè)方法。使用子窗體作為類似“控件”容器的承載體，這就解決的自定義控件的“容器”問題。
     好了，說完這幾個(gè)問題，那么我再總結(jié)下要讀懂本文內(nèi)容所需要儲備的知識，如果你還對以下內(nèi)容完全不了解的話，我建議你首先百度下或者找找相關(guān)的書什么的了解下，當(dāng)然你也可以繼續(xù)讀下去，因?yàn)槲視�盡力講的通俗易懂。不過如果你感覺閱讀的很吃力的話，那你最好還是補(bǔ)一補(bǔ)相關(guān)的內(nèi)容再來。
1、VBA中如何使用API？
2、GDI是用來干什么的？如何使用GDI？GDI句柄跟設(shè)備環(huán)境的關(guān)系，如何用GDI繪圖？
3、Access窗體的構(gòu)成。
4、Access子窗體是什么？怎么使用子窗體？
5、VBA中的類模塊是什么？怎么使用類模塊？類模塊屬性、方法、事件怎么建立？
6、Access窗體與類模塊的關(guān)系；
7、使用VBA代碼怎么調(diào)用自定義“控件”？
8、集合在類模塊中的使用；
     另外我也想說明一下，由于本貼內(nèi)容可能會比較長，我會分批將所寫內(nèi)容更新進(jìn)來，由于平時(shí)工作比較忙，可能一次更新的內(nèi)容也不會太多，所以希望大家也不要急躁，慢慢看慢慢消化。另外相應(yīng)的代碼部分也有很多在調(diào)試之中，但是大部分主體的代碼已經(jīng)完成，我暫時(shí)不把源代碼隨帖子一起發(fā)布，我會將其中的大部分代碼寫到本貼里面并講解，希望有興趣的將貼看下去。

下面我們就開始講怎么在Access來做一個(gè)類似TabControl的“控件”。
首先，我們來看下最終的效果，示例中包含了2個(gè)窗體，frmTest是個(gè)測試窗體,TabControl就是我們所謂的當(dāng)作控件來使用的子窗體。另外還有些模塊跟類模塊，有些模塊是無用的，因?yàn)槲以谧鲞@個(gè)的時(shí)候，借鑒了部分代碼，只是沒有刪除，我在后面會說到有哪些模塊跟代碼會使用到的，所以這里就不再說明各個(gè)模塊的作用了。
雙擊打開frmTest，默認(rèn)會建立3個(gè)框，相當(dāng)于3個(gè)Tab，點(diǎn)擊添加按鈕，會自動添加Tab，點(diǎn)刪除按鈕會從最后依次刪除Tab，在某個(gè)Tab上點(diǎn)擊，會彈出一個(gè)對話框顯示當(dāng)前Tab的序號。


實(shí)例附件已上傳，可以下載，部分代碼還需要修改：

站到終點(diǎn)站

     在動手編寫代碼前，首先我們得分析下TabControl控件的結(jié)構(gòu)，搞清楚我們需要建立什么樣的模塊、類模塊以及窗體模塊。從上面我們已經(jīng)看到了我們用了一個(gè)子窗體作為TabControl的容器，那么TabControl里面還包括了很多Tab，這些Tab會構(gòu)成一個(gè)集合Tabs，所以這個(gè)控件的層級關(guān)系就是：
TabControl
+---Tabs
      +----Tab
      之所以要理清楚這個(gè)關(guān)系，是因?yàn)榛�于這個(gè)結(jié)構(gòu)建立我們的“控件”，會大大方便對我們控件的訪問。這里的TabControl對應(yīng)我們的窗體，Tabs的話我們將在TabControl的窗體代碼中建立一個(gè)私有集合變量mTabBars，而Tab這個(gè)東西就需要我們自己來寫類模塊了。我將這個(gè)類模塊命名為clsAccTabBar,cls代碼是類模塊，Acc表示是Access中的，TabBar就是這個(gè)類模塊的含義。
      下面我們來分析下這個(gè)類模塊的內(nèi)容，這個(gè)類模塊所代表的是TabControl中的一個(gè)TabBar：
1、與屬性相關(guān)的：包括TabBar的位置信息(Top、Left、Right、Bottom)、鼠標(biāo)是否在其上(IsMouseOn)、是否被單擊(Selected)、顯示文字內(nèi)容(Text)、標(biāo)識字符串(Key)�？赡艽蠹疫�會說有與顏色相關(guān)的屬性，這些我都放在了TabControl里面了，因?yàn)檫@些顏色是所有Tab共用的，而不是某一個(gè)Tab專屬的，即使是選中色、鼠標(biāo)移動其上的顏色。
2、與方法相關(guān)：Tab重畫，這個(gè)方法我將它寫在了TabControl里面了，當(dāng)然你如果有興趣可以為Tab建立一個(gè)ReDraw的方法；
3、與事件相關(guān)：TabBar被單擊事件，TabBar鼠標(biāo)移動事件，這2個(gè)事件的實(shí)現(xiàn)有些特殊，按道理應(yīng)該在Tab類模塊里建立這2個(gè)事件，但是鼠標(biāo)的移動跟單擊觸發(fā)都是在TabControl里面，所以這2個(gè)事件我都把實(shí)現(xiàn)做到了TabControl窗體的事件代碼里面了，后面講述TabControl的時(shí)候我會再講；
     從上面的描述來看，我基本上把這個(gè)clsAccTabBar類模塊只讓其用于保存各個(gè)Tab相關(guān)信息，下面是類模塊里面的代碼：

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

復(fù)制代碼

     有些屬性我在前面沒有提到，而在代碼里又有，比如Width、Height，這個(gè)是寬度、高度，這個(gè)都是根據(jù)其他屬性值來計(jì)算得到的。當(dāng)然這里我再給大家提一下類模塊的屬性建立問題。     前面有很多私有變量聲明，我這里把它們叫做類模塊的字段，它們都是以m開頭的，之后我所有的代碼都是以m開頭來代表類模塊中的字段，與這些字段對應(yīng)的Get/Let屬性方法表示對這些字段的讀取/寫入操作。類模塊中建立字段、屬性的標(biāo)準(zhǔn)范式就是如此，應(yīng)該避免使用公用變量。如果你對類模塊的屬性建立不是很清楚，還請?jiān)谡搲�或百度查閱相關(guān)的內(nèi)容。

站到終點(diǎn)站

     前面第一部分大家已經(jīng)看到了clsAccTabBar的代碼，內(nèi)容是不是比較簡單？確實(shí)比較簡單，因?yàn)楹芏鄸|西我都把它放到了TabControl里面實(shí)現(xiàn)了。大家對于clsAccTabBar這個(gè)類模塊牢記2點(diǎn):其一：這個(gè)類模塊與之前所分析的模型中Tab對應(yīng)，它將是某個(gè)具體Tab對象的模板代碼；
其二:這個(gè)類模塊所實(shí)現(xiàn)的功能就是用于記錄每一個(gè)Tab的信息，在運(yùn)行時(shí)，這個(gè)類模塊幫助我們把這些信息存儲在內(nèi)存中；當(dāng)要進(jìn)行重畫時(shí)，我們又可以使用這個(gè)類模塊讀取數(shù)據(jù)，用GDI把所有Tab畫出來，或者畫其中某幾個(gè)Tab；
     下面我們就來看看TabControl跟Tabs的實(shí)現(xiàn)吧，關(guān)于繪圖的內(nèi)容我將會在后面再單獨(dú)說，因?yàn)楹竺嫖覀冞�會將繪圖部分的功能單獨(dú)寫入一個(gè)類模塊中。我們先從最簡單的Tabs來分析吧，稍后再看TabControl。Tabs是一個(gè)Tab的集合，我們直接使用Collection對象，雖然可能使用這個(gè)集合對象對于集合項(xiàng)目數(shù)較多時(shí)，性能會下降，但是我想誰也不可能在一個(gè)程序界面里出來個(gè)成百上千的Tab標(biāo)簽頁吧！對于一個(gè)集合，我們所需要的功能包括添加、刪除以及查找，而Collection對象都有現(xiàn)成的，確實(shí)方便多了。
      首先我們要在TabControl窗體代碼里面聲明一個(gè)mTabBars的Collection對象：

1. Private mTabBars As New Collection

復(fù)制代碼

      這里我直接用New聲明了，也就是說這個(gè)TabControl“控件”被初始化時(shí)，就會在內(nèi)存里分配空間給mTabBars(當(dāng)然大家也可以不這么做，而是在添加TabBar方法里面對mTabBars進(jìn)行檢測，如果是nothing，就使用Set mTabBars=New Collection)。然后在窗體的UnLoad事件里面將mTabBars置為Nothing。這里啰嗦一句，實(shí)際編程的時(shí)候，大家要養(yǎng)成習(xí)慣，對需要進(jìn)行清理的對象變量或者API中的一些資源對象，當(dāng)存在調(diào)用代碼時(shí)，立即在相應(yīng)處添加清理代碼，這樣可以減少很多莫名奇妙的錯誤，特別是在VBA中使用API進(jìn)行GDI編程時(shí)，這個(gè)好習(xí)慣可以幫助你減少很多不必要的調(diào)試麻煩。例如下面的ReleaseDC，它是GDI操作中的一個(gè)API函數(shù)，用于清除設(shè)備環(huán)境(DC)引用,mFormMainHwnd是對應(yīng)的窗口句柄，mMainDC就是這個(gè)設(shè)備環(huán)境，設(shè)備環(huán)境是Windows非常珍貴的系統(tǒng)資源，如果用了不記得及時(shí)“還回”給系統(tǒng)，會造成程序莫名其妙出錯，而且沒有任何錯誤提示，甚至造成系統(tǒng)崩潰！

1. Private Sub Form_Unload(Cancel As Integer)
   
2.     ReleaseDC mFormMainHwnd, mMainDC
   
3.     Set mTabBars = Nothing
   
4. End Sub

復(fù)制代碼

     下面我們再來看看如何向這個(gè)集合對象添加TabBar進(jìn)去：

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

復(fù)制代碼

     方法有3個(gè)參數(shù)，前2個(gè)通過英文名就知道是什么意思，里面的代碼我還沒有使用到Key，只使用了Text，最后一個(gè)參數(shù)是個(gè)預(yù)留參數(shù)，暫時(shí)也沒有用到。下面講下代碼內(nèi)容，聲明了3個(gè)變量，第一個(gè)mTabBar用于保存需要添加的TabBar的相關(guān)數(shù)據(jù)，第二個(gè)lngText保存Text字符串的長度，這個(gè)參數(shù)傳遞給API函數(shù)GetTextExtentPoint32，用于獲取字符串的實(shí)際顯示像素寬度；第三個(gè)mTextSize用于保存GetTextExtentPoint32函數(shù)運(yùn)算后，所獲得的字符串實(shí)際顯示像素寬高值，它是一個(gè)Size的數(shù)據(jù)結(jié)構(gòu)，代碼如下：

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

復(fù)制代碼

      需要提醒的是，GetTextExtentPoint32的聲明最好放在TabControl的代碼窗口中，Size的聲明最好放在單獨(dú)的模塊代碼中。GetTextExtentPoint32函數(shù)所使用mMainDC參數(shù)指的是主體窗口的設(shè)備環(huán)境DC，大家只需要知道這個(gè)東西就可以了，因?yàn)橹挥械玫竭@個(gè)才能調(diào)用GDI進(jìn)行繪圖，關(guān)于繪圖我再專門講述，所以這里大家不用糾結(jié)這個(gè)，記住它是個(gè)與主體相關(guān)的畫圖用的設(shè)備環(huán)境就行了。然后后面的代碼意圖是當(dāng)mTabBars沒有TabBar時(shí)，直接寫入首個(gè)TabBar的數(shù)據(jù)，其中的Right值是字符寬度加上16(左右邊距合計(jì)16個(gè)像素)，當(dāng)有TabBar時(shí)，根據(jù)前一個(gè)TabBar的數(shù)據(jù)設(shè)置當(dāng)前添加TabBar的數(shù)據(jù)。隨后將這個(gè)TabBar添加到集合中，并調(diào)用ReDrawTabBar方法把這個(gè)TabBar畫出來。
     下面我們再來說下TabBar的刪除操作，刪除TabBar不僅僅是將其從mTabBars集合中清除掉，還要將窗體上的圖像進(jìn)行重繪，用背景色填充掉原先TabBar所在的位置，給查看者的感覺就是被刪除掉了。代碼如下，其中有2行代碼(首行與末行)被我注釋掉了，因?yàn)殛P(guān)于GDI繪圖的方法我暫時(shí)還是寫在了TabControl的代碼里面，還沒有完成對clsAccGDI類模塊的代碼，后面在說到GDI繪圖時(shí)我還是繼續(xù)講述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

復(fù)制代碼

     接下來我們再來看看如何在mTabBars中找到制定的TabBar，由于我之前的代碼沒有使用到Key，所以這里也沒有基于Key來定位TabBar，我也沒有寫一個(gè)專門用于定位TabBar的方法，只是使用了最通用的For循環(huán)來查找，如果大家覺得不好，可以自己寫個(gè)定位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

復(fù)制代碼

     說明下以上代碼的意思，intX是個(gè)循環(huán)變量，在For循環(huán)中作為Index來遍歷mTabBars集合，px，py是鼠標(biāo)的坐標(biāo)位置(像素值)，VBA中MouseMove事件中返回X，Y是以Twip為單位的值，所以需要使用TwipsPerPixelX、TwipsPerPixelY自定義函數(shù)將其轉(zhuǎn)換為像素值。建立一個(gè)模塊mdlSysInfo，然后復(fù)制一下代碼到模塊中。隨后以上的代碼通過鼠標(biāo)坐標(biāo)值來判斷其所在TabBar，找到時(shí)，完成一系列的設(shè)置操作，包括設(shè)置TabBar的IsMouseOn屬性，重畫TabBar并保存當(dāng)前所處TabBar在mTabBars中的序號。隨后再對之前鼠標(biāo)所在的TabBar重畫，并修改其IsMouseOn屬性、保存之前鼠標(biāo)所在TabBar的序號。最后保存鼠標(biāo)當(dāng)前位置數(shù)據(jù)，這個(gè)數(shù)據(jù)會在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

復(fù)制代碼

站到終點(diǎn)站

     上一個(gè)部分我們已經(jīng)講了Tabs的功能實(shí)現(xiàn)，功能和代碼部分可能還比較粗糙，有興趣的可以自行完善下，下面我們來講整個(gè)自定義“控件”的重點(diǎn)之一：TabControl子窗體容器的功能實(shí)現(xiàn)。TabControl子窗體是我們所謂的自定義“控件”的容器，同之前我們對Tab一樣，我們也首先來分析下TabControl的各種特征。
1、必要的字段：窗體的各種句柄(子窗體句柄、窗體頁眉句柄、窗體主體句柄、窗體頁腳句柄)、設(shè)備環(huán)境(窗體主體的設(shè)備環(huán)境)、各種顏色相關(guān)的設(shè)置(鼠標(biāo)在其上背/前景色、被選中背/前景色、默認(rèn)背/前景色)、前一個(gè)鼠標(biāo)移動到的TabBar序號、前一個(gè)被選中的TabBar序號、TabBar的集合以及鼠標(biāo)當(dāng)前位置；
      這里的設(shè)備環(huán)境我只使用了窗體主體的設(shè)備環(huán)境，因?yàn)樵趯?shí)例中我只使用主體，頁眉頁腳都隱藏了。其他還有部分字段并非是必要的，只是為了擴(kuò)充完善功能新加入的，這里我就不再說明了，你可以自行根據(jù)需要添加修改。
2、與方法相關(guān)：添加與刪除TabBar(這2個(gè)方法在前面講Tabs集合的時(shí)候已經(jīng)詳細(xì)說了)、畫TabBar方法(包括畫所有Tab與畫單個(gè)Tab)、前面這些方法都是共有的，就是使用這個(gè)控件時(shí)，我們可以看到這些方法，另外還有一個(gè)私有方法FillTargetRect，這個(gè)方法是用于畫一個(gè)實(shí)心矩形的，它被畫TabBar方法所調(diào)用，當(dāng)使用TabControl這個(gè)控件時(shí)，這個(gè)方法是不可見的。
3、與事件相關(guān)：“控件”的初始化事件(就是TabControl窗體的Load事件，完成各種內(nèi)置字段的初始化以及添加3個(gè)默認(rèn)TabBar)、“控件”的銷毀事件(就是TabControl窗體的UnLoad事件，完成各種對象和設(shè)備環(huán)境的清理工作)、“控件”的單擊事件(通過主體的Click事件實(shí)現(xiàn))用于根據(jù)鼠標(biāo)單擊位置觸發(fā)TabBar單擊事件、“控件”的鼠標(biāo)移動事件(通過主體的MouseMove事件實(shí)現(xiàn))、“控件”重繪事件(通過主體的Paint事件實(shí)現(xiàn))用于重繪所有TabBar，以上所有事件都借助于窗體的事件來實(shí)現(xiàn)，另外還有一個(gè)自定義事件TabClick，該事件在“控件”的單擊事件中被觸發(fā)，同時(shí)反饋一個(gè)被單擊TabBar的序號。      由于帖子內(nèi)容過長，代碼無法放下，我將TabControl的代碼分成2段放了。這里面的代碼還是有些Bug，大家自己可以參照著修改下，我一時(shí)半會兒還沒法去調(diào)試這些Bug，當(dāng)然大致的問題都不多，可能會是添加刪除，以及鼠標(biāo)移動時(shí)，可能會因?yàn)閙PreTabBarSelected、mPreTabBarOn找不到而出現(xiàn)錯誤。

1. Option Compare Database
   
2. 
   
3. '****************************************************************************
   
4. '發(fā)布日期：2015/03/16
   
5. '描    述：在Access中通過子窗體實(shí)現(xiàn)自繪TabControl控件
   
6. 'E-mail  ：alex_ywt@163.com
   
7. 'QQ      ：21959068
   
8. '          如需引用源代碼，請注釋代碼出處
   
9. '****************************************************************************
   
10. 
    
11. Private Declare Function SetBkMode Lib "gdi32" ( _
    
12.     ByVal hdc As Long, _
    
13.     ByVal nBkMode As Long) As Long
    
14. Private Declare Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long
    
15. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    
16. Private Declare Function ReleaseDC Lib "user32" ( _
    
17.     ByVal Hwnd As Long, _
    
18.     ByVal hdc As Long) As Long
    
19. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    
20. Private Declare Function GetWindowDC Lib "user32" (ByVal Hwnd As Long) As Long
    
21. Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
    
22.     ByVal hWnd1 As Long, _
    
23.     ByVal hWnd2 As Long, _
    
24.     ByVal lpsz1 As String, _
    
25.     ByVal lpsz2 As String) As Long
    
26.    
    
27. Private Declare Function Polygon Lib "gdi32" ( _
    
28.     ByVal hdc As Long, _
    
29.     lpPoint As POINTAPI, _
    
30.     ByVal nCount As Long) As Long
    
31. Private Declare Function Rectangle Lib "gdi32" ( _
    
32.     ByVal hdc As Long, _
    
33.     ByVal X1 As Long, _
    
34.     ByVal Y1 As Long, _
    
35.     ByVal X2 As Long, _
    
36.     ByVal Y2 As Long) As Long
    
37. Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" ( _
    
38.     ByVal hInst As Long, _
    
39.     ByVal lpsz As String, _
    
40.     ByVal un1 As Long, _
    
41.     ByVal n1 As Long, _
    
42.     ByVal n2 As Long, _
    
43.     ByVal un2 As Long) As Long
    
44. Private Declare Function BitBlt Lib "gdi32" ( _
    
45.     ByVal hDestDC As Long, _
    
46.     ByVal x As Long, _
    
47.     ByVal y As Long, _
    
48.     ByVal nWidth As Long, _
    
49.     ByVal nHeight As Long, _
    
50.     ByVal hSrcDC As Long, _
    
51.     ByVal xSrc As Long, _
    
52.     ByVal ySrc As Long, _
    
53.     ByVal dwRop As Long) As Long
    
54. Private Declare Function CreateBitmap Lib "gdi32" ( _
    
55.     ByVal nWidth As Long, _
    
56.     ByVal nHeight As Long, _
    
57.     ByVal nPlanes As Long, _
    
58.     ByVal nBitCount As Long, _
    
59.     lpBits As Any) As Long
    
60. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
    
61. Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitMap As Long) As Long
    
62. Private Declare Function SelectObject Lib "gdi32" ( _
    
63.     ByVal hdc As Long, _
    
64.     ByVal hObject As Long) As Long
    
65. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" ( _
    
66.     ByVal hObject As Long, _
    
67.     ByVal nCount As Long, _
    
68.     lpObject As Any) As Long
    
69. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    
70. Private Declare Function InvalidateRectAsAny Lib "user32" Alias "InvalidateRect" ( _
    
71.     ByVal Hwnd As Long, _
    
72.     lpRect As Any, _
    
73.     ByVal bErase As Long) As Long
    
74. Private Declare Function FillRect Lib "user32" ( _
    
75.     ByVal hdc As Long, _
    
76.     lpRect As Rect, _
    
77.     ByVal hBrush As Long) As Long
    
78. Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" ( _
    
79.     ByVal hdc As Long, _
    
80.     ByVal lpsz As String, _
    
81.     ByVal cbString As Long, _
    
82.     lpSize As Size) As Long
    
83. Private Declare Function DrawText Lib "user32" Alias "DrawTextA" ( _
    
84.     ByVal hdc As Long, _
    
85.     ByVal lpStr As String, _
    
86.     ByVal nCount As Long, _
    
87.     lpRect As Rect, _
    
88.     ByVal wFormat As Long) As Long
    
89. 
    
90. Private Const IMAGE_BITMAP = 0
    
91. Private Const LR_LOADFROMFILE = &H10
    
92. Private Const LR_CREATEDIBSECTION = &H2000
    
93. 
    
94. Private Const TRANSPARENT = 1
    
95. 
    
96. 'wFormat文字輸出格式，DT即Draw Text
    
97. Private Const DT_BOTTOM = &H8 '靠底輸出，必須與DT_SINGLELINE配合（用OR）
    
98. Private Const DT_CENTER = &H1  '居中
    
99. Private Const DT_CALCRECT = &H400  '自動計(jì)算（調(diào)整）輸出區(qū)域的大小
    
100. Private Const DT_EXPANDTABS = &H40   '將Tab字符視為定位點(diǎn)
     
101. Private Const DT_EXTERNALLEADING = &H200 '包含行間距
     
102. Private Const DT_LEFT = &H0           '居左
     
103. Private Const DT_NOCLIP = &H100    '文字輸出不受限于輸出區(qū)域
     
104. Private Const DT_NOPREFIX = &H800 '不處理前導(dǎo)字符&。若不指定，會把緊跟的字母加下劃線（類似定義菜單快捷鍵）
     
105. Private Const DT_RIGHT = &H2       '居右
     
106. Private Const DT_SINGLELINE = &H20  '單行輸出
     
107. Private Const DT_TABSTOP = &H80   '設(shè)置定位點(diǎn)，wFormat中高字節(jié)8-15位表示定位點(diǎn)的寬度（默認(rèn)8）
     
108. Private Const DT_TOP = &H0       '居上，須與DT_SINGLELINE配合
     
109. Private Const DT_VCENTER = &H4   '垂直居中，須與DT_SINGLELINE配合
     
110. Private Const DT_WORDBREAK = &H10 '超過右邊界時(shí)，自動換行
     
111. 
     
112. Private mFormHwnd As Long
     
113. Private mFormHeaderHwnd As Long
     
114. Private mFormMainHwnd As Long
     
115. Private mFormFooterHwnd As Long
     
116. Private mMainDC As Long
     
117. Private mCurrentDrawTarget As ENUM_DrawTarget
     
118. 
     
119. Private mMouseLeaveBackColor As OLE_COLOR   '鼠標(biāo)移開后顯示的背景色
     
120. Private mMouseOnBackColor As OLE_COLOR      '鼠標(biāo)在其上顯示的背景色
     
121. Private mSelectedBackColor As OLE_COLOR     '當(dāng)前項(xiàng)被選中時(shí)的背景色
     
122. 
     
123. Private mMouseLeaveFontColor As OLE_COLOR   '鼠標(biāo)移開后顯示的前景色
     
124. Private mMouseOnFontColor As OLE_COLOR      '鼠標(biāo)在其上顯示的前景色
     
125. Private mSelectedFontColor As OLE_COLOR     '當(dāng)前項(xiàng)被選中時(shí)的前景色
     
126. 
     
127. Private mMouseLeaveBorderColor As OLE_COLOR '鼠標(biāo)移開后顯示的邊框色
     
128. Private mMouseOnBorderColor As OLE_COLOR    '鼠標(biāo)在其上顯示的邊框色
     
129. Private mSelectedBorderColor As OLE_COLOR   '當(dāng)前項(xiàng)被選中時(shí)的邊框色
     
130. 
     
131. Private mBorderWidth As Long                '邊框的寬度
     
132. 
     
133. Private mTabBars As New Collection
     
134. Private mPreTabBarOn As Integer
     
135. Private mPreTabBarSelected As Integer
     
136. 
     
137. Private mMousePoint As POINTAPI
     
138. 
     
139. Public Event TabClick(Index As Integer)

復(fù)制代碼

站到終點(diǎn)站

1. Private Sub Form_Load()
   
2.     mMouseLeaveBackColor = RGB(155, 155, 155)   '鼠標(biāo)移開后顯示的背景色
   
3.     mMouseOnBackColor = RGB(0, 255, 255)      '鼠標(biāo)在其上顯示的背景色
   
4.     mSelectedBackColor = RGB(255, 0, 0)    '當(dāng)前項(xiàng)被選中時(shí)的背景色
   
5.    
   
6.     mMouseLeaveFontColor = RGB(255, 255, 255)   '鼠標(biāo)移開后顯示的前景色
   
7.     mMouseOnFontColor = RGB(0, 0, 255)          '鼠標(biāo)在其上顯示的前景色
   
8.     mSelectedFontColor = RGB(0, 0, 0)           '當(dāng)前項(xiàng)被選中時(shí)的前景色
   
9. 
   
10.     mMouseLeaveBorderColor = RGB(155, 155, 155) '鼠標(biāo)移開后顯示的邊框色
    
11.     mMouseOnBorderColor = RGB(155, 155, 155)    '鼠標(biāo)在其上顯示的邊框色
    
12.     mSelectedBorderColor = RGB(155, 155, 155)   '當(dāng)前項(xiàng)被選中時(shí)的邊框色
    
13.    
    
14.     mFormHeaderHwnd = FindWindowEx(Me.Hwnd, 0&, "OFormSub", vbNullString)
    
15.     mFormMainHwnd = FindWindowEx(Me.Hwnd, mFormHeaderHwnd, "OFormSub", vbNullString)
    
16.     mMainDC = GetWindowDC(mFormMainHwnd)
    
17.    
    
18.     SetBkMode mMainDC, TRANSPARENT
    
19.    
    
20.     Me.InsideHeight = 30 * TwipsPerPixelY
    
21.     For I = 1 To 3
    
22.         AddTabBar "", "Tab" & I, ""
    
23.     Next
    
24.     'ReDraw
    
25. End Sub
    
26. 
    
27. Private Sub Form_Unload(Cancel As Integer)
    
28.     ReleaseDC mFormMainHwnd, mMainDC
    
29.     Set mTabBars = Nothing
    
30. End Sub
    
31. 
    
32. Private Sub 主體_Click()
    
33.     Dim intX As Integer
    
34.     Dim mCurrentSelected As Integer
    
35.    
    
36.     For intX = 1 To mTabBars.count
    
37.         If mMousePoint.x >= mTabBars(intX).Left And mMousePoint.x <= mTabBars(intX).Right And _
    
38.             mMousePoint.y >= mTabBars(intX).Top And mMousePoint.y <= mTabBars(intX).Bottom Then
    
39.             mTabBars(intX).Selected = True
    
40.             ReDrawTabBar intX
    
41.             mCurrentSelected = intX
    
42.             Exit For
    
43.         End If
    
44.         'Debug.Print "(x,y):(" & pX & "," & py & ")" & vbTab & "(Rx):(" & mTabBars(intX).Left & ")"
    
45.     Next
    
46.     If mPreTabBarSelected <> mCurrentSelected Then
    
47.         If mPreTabBarSelected > 0 And mCurrentSelected > 0 Then
    
48.             mTabBars(mPreTabBarSelected).Selected = False
    
49.             ReDrawTabBar mPreTabBarSelected
    
50.         End If
    
51.         mPreTabBarSelected = mCurrentSelected
    
52.         RaiseEvent TabClick(mCurrentSelected)
    
53.     End If
    
54. End Sub
    
55. 
    
56. Private Sub 主體_DblClick(Cancel As Integer)
    
57.     'Static dblClickCount As Long
    
58.     'dblClickCount = dblClickCount + 1
    
59.     'AddTabBar "", "雙擊添加Tab" & dblClickCount, ""
    
60.     'ReDraw
    
61. End Sub
    
62. 
    
63. Private Sub 主體_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    
64.     Dim intX As Integer
    
65.     Dim pX As Long, pY As Long
    
66.     Dim mCurrentOn As Integer
    
67.    
    
68.     pX = x / TwipsPerPixelX()
    
69.     pY = y / TwipsPerPixelY()
    
70.    
    
71.     For intX = 1 To mTabBars.count
    
72.         If pX >= mTabBars(intX).Left And pX <= mTabBars(intX).Right And _
    
73.             pY >= mTabBars(intX).Top And pY <= mTabBars(intX).Bottom Then
    
74.             mTabBars(intX).IsMouseOn = True
    
75.             ReDrawTabBar intX
    
76.             mCurrentOn = intX
    
77.             Exit For
    
78.         End If
    
79.         'Debug.Print "(x,y):(" & pX & "," & py & ")" & vbTab & "(Rx):(" & mTabBars(intX).Left & ")"
    
80.     Next
    
81.     If mPreTabBarOn <> mCurrentOn Then
    
82.         If mPreTabBarOn > 0 Then
    
83.             mTabBars(mPreTabBarOn).IsMouseOn = False
    
84.             ReDrawTabBar mPreTabBarOn
    
85.         End If
    
86.         If mCurrentOn > 0 Then
    
87.             mPreTabBarOn = mCurrentOn
    
88.         Else
    
89.             mPreTabBarOn = 0
    
90.         End If
    
91.     End If
    
92.     'ReDraw
    
93.     mMousePoint.x = pX
    
94.     mMousePoint.y = pY
    
95. End Sub
    
96. 
    
97. Private Sub 主體_Paint()
    
98.     ReDraw
    
99. End Sub
    
100. 
     
101. Public Property Get TabCount() As Long
     
102.     TabCount = mTabBars.count
     
103. End Property
     
104. 
     
105. Public Sub AddTabBar(ByVal Key As String, ByVal Text As String, ByVal TargetForm As String)
     
106.     Dim mTabBar As New clsAccTabBar
     
107.     Dim lngText As Long
     
108.     Dim mTextSize As Size
     
109.    
     
110.     lngText = LenB(StrConv(Text, vbFromUnicode))
     
111.     GetTextExtentPoint32 mMainDC, Text, lngText, mTextSize
     
112. 
     
113.     If TabCount = 0 Then
     
114.         mTabBar.Left = 0
     
115.         mTabBar.Top = 0
     
116.         mTabBar.Right = mTextSize.cx + 16
     
117.         mTabBar.Bottom = 30
     
118.     Else
     
119.         mTabBar.Left = mTabBars(TabCount).Right + 0.6
     
120.         mTabBar.Top = 0
     
121.         mTabBar.Right = mTabBar.Left + mTextSize.cx + 16
     
122.         mTabBar.Bottom = 30
     
123.     End If
     
124.     mTabBar.Text = Text
     
125.     mTabBars.Add mTabBar
     
126.     ReDrawTabBar mTabBars.count
     
127. End Sub
     
128. 
     
129. Public Sub RemoveTabBar()
     
130. On Error GoTo Err_Handle
     
131.     'Dim FormDrawer As New clsAccGDI
     
132.     Dim mRect As Rect
     
133.     Dim mLastIndex As Integer
     
134.    
     
135.     mLastIndex = mTabBars.count
     
136.    
     
137.     mRect.Left = mTabBars(mLastIndex).Left
     
138.     mRect.Right = mTabBars(mLastIndex).Right
     
139.     mRect.Bottom = mTabBars(mLastIndex).Bottom
     
140.     mRect.Top = mTabBars(mLastIndex).Top
     
141.     FillTargetRect RGB(255, 255, 255), mRect
     
142.     If mTabBars(mLastIndex).Selected Then mPreTabBarSelected = 0
     
143.     'rt = DrawText(mMainDC, mTabBars(Index).Text, LenB(StrConv(mTabBars(Index).Text, vbFromUnicode)), mRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE)
     
144.     mTabBars.Remove mLastIndex
     
145.     GoTo Exit_Sub
     
146. Err_Handle:
     
147.     MsgBox "出錯！"
     
148. Exit_Sub:
     
149.     'Set FormDrawer = Nothing
     
150. End Sub
     
151. 
     
152. Public Sub ReDraw()
     
153. On Error GoTo Err_Handle
     
154.     'Dim FormDrawer As New clsAccGDI
     
155.     Dim mRect As Rect
     
156.     Dim mTabCount As Long
     
157.    
     
158.     mTabCount = TabCount
     
159.    
     
160.     For I = 1 To mTabCount
     
161.         mRect.Left = mTabBars(I).Left
     
162.         mRect.Right = mTabBars(I).Right
     
163.         mRect.Bottom = mTabBars(I).Bottom
     
164.         mRect.Top = mTabBars(I).Top
     
165.         If mTabBars(I).Selected Then
     
166.             FillTargetRect RGB(255, 0, 0), mRect
     
167.         Else
     
168.             If mTabBars(I).IsMouseOn Then
     
169.                 FillTargetRect RGB(0, 255, 0), mRect
     
170.             Else
     
171.                 FillTargetRect RGB(255, 255, 0), mRect
     
172.             End If
     
173.         End If
     
174.         rt = DrawText(mMainDC, mTabBars(I).Text, LenB(StrConv(mTabBars(I).Text, vbFromUnicode)), mRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE)
     
175.     Next
     
176. 
     
177.     GoTo Exit_Sub
     
178. Err_Handle:
     
179.     MsgBox "出錯！"
     
180. Exit_Sub:
     
181.     'Set FormDrawer = Nothing
     
182. End Sub
     
183. 
     
184. Public Sub ReDrawTabBar(Index As Integer)
     
185. On Error GoTo Err_Handle
     
186.     'Dim FormDrawer As New clsAccGDI
     
187.     Dim mRect As Rect
     
188.    
     
189.     mRect.Left = mTabBars(Index).Left
     
190.     mRect.Right = mTabBars(Index).Right
     
191.     mRect.Bottom = mTabBars(Index).Bottom
     
192.     mRect.Top = mTabBars(Index).Top
     
193.     If mTabBars(Index).Selected Then
     
194.         FillTargetRect RGB(255, 0, 0), mRect
     
195.     Else
     
196.         If mTabBars(Index).IsMouseOn Then
     
197.             FillTargetRect RGB(0, 255, 0), mRect
     
198.         Else
     
199.             FillTargetRect RGB(255, 255, 0), mRect
     
200.         End If
     
201.     End If
     
202.     rt = DrawText(mMainDC, mTabBars(Index).Text, LenB(StrConv(mTabBars(Index).Text, vbFromUnicode)), mRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE)
     
203. 
     
204.     GoTo Exit_Sub
     
205. Err_Handle:
     
206.     MsgBox "出錯！"
     
207. Exit_Sub:
     
208.     'Set FormDrawer = Nothing
     
209. End Sub
     
210. 
     
211. Private Sub FillTargetRect(DrawColor As OLE_COLOR, TargetRect As Rect)
     
212.     Dim hOldBrush As Long
     
213.     Dim hBrush As Long
     
214.    
     
215.     hBrush = CreateSolidBrush(CLng(DrawColor))
     
216.     hOldBrush = SelectObject(mMainDC, hBrush)
     
217.     FillRect mMainDC, TargetRect, hBrush
     
218.     'Rectangle hdc, TargetRect.Left, TargetRect.Top, TargetRect.Right, TargetRect.Bottom
     
219.     SelectObject mMainDC, hOldBrush
     
220.     DeleteObject hBrush
     
221. End Sub

復(fù)制代碼

站到終點(diǎn)站

     到此為止，相關(guān)的一些核心代碼已經(jīng)全部貼出來了，TabControl窗體中的代碼包含了很多的API函數(shù)聲明，并在TabControl中通過GDI完成了繪圖操作，但是我暫時(shí)還不打算去解釋這些API函數(shù)以及Access中如何通過GDI進(jìn)行繪圖。我先說明下如何來使用這個(gè)TabControl控件。因?yàn)榧词故褂玫娜瞬恢�道TabControl是如何具體實(shí)現(xiàn)其功能的，也不妨礙使用它。通過我們所提供的屬性、方法以及事件就可以操作這個(gè)控件，這就是面向?qū)ο缶幊痰暮锰�。類模塊或者窗體封裝后，使用人只需要知道其公用的屬性、方法以及事件(也就是我們流行講的接口)，就可以輕松使用這些東西，跟我們Access內(nèi)置的其他控件一樣。
      好吧，那么我們就先來看看frmTest窗體是如何使用TabControl這個(gè)子窗體控件的。這個(gè)窗體的界面非常簡單，包括一個(gè)子窗體以及2個(gè)按鈕(添加喝刪除)，將之前所建立的TabControl窗體直接拖入frmTest窗體中就可以建立一個(gè)子窗體。下面我們來看看它的代碼：

1. Option Compare Database
   
2. 
   
3. '****************************************************************************
   
4. '發(fā)布日期：2015/03/16
   
5. '描    述：自繪TabControl控件的測試窗體
   
6. 'E-mail  ：alex_ywt@163.com
   
7. 'QQ      ：21959068
   
8. '          如需引用源代碼，請注釋代碼出處
   
9. '****************************************************************************
   
10. 
    
11. Private WithEvents mTabControl As Form_TabControl
    
12. 
    
13. Private Sub cmdAdd_Click()
    
14.     Static iCount As Integer
    
15.     iCount = iCount + 1
    
16.     mTabControl.AddTabBar "", "UserTab" & iCount, ""
    
17. End Sub
    
18. 
    
19. Private Sub cmdDelete_Click()
    
20.     mTabControl.RemoveTabBar
    
21. End Sub
    
22. 
    
23. Private Sub mTabControl_TabClick(Index As Integer)
    
24.     MsgBox Index
    
25. End Sub
    
26. 
    
27. Private Sub 主體_Paint()
    
28.     Set mTabControl = Me.TabControl1.Form
    
29. End Sub
    

復(fù)制代碼

     窗體的代碼非常簡單，熟悉面向?qū)ο缶幊碳笆录�使用的朋友還會感覺代碼非常熟悉，那么下面我就來簡單的說下：     我們把TabControl視作控件后，并且要使用它的事件，所以我們需要聲明一個(gè)WithEvents標(biāo)識的Form_TabControl對象變量，并且將其聲明為私有的，這里不用New，因?yàn)槲覀円獙⑵渑c窗體上的那個(gè)子窗體關(guān)聯(lián)起來。那么關(guān)聯(lián)的時(shí)機(jī)這里需要注意下，因?yàn)樵贏ccess中窗體加載的時(shí)候不一定子窗體會同是完成加載，所以Set mTabControl = Me.TabControl1.Form這句不能放在窗體的Load事件中，我這里選擇了主體的Paint事件，這個(gè)時(shí)候子窗體必定完成了加載，所以此時(shí)的Me.TabControl1.Form必定不會為Nothing。
     2個(gè)按鈕的單擊事件非常簡單，直接調(diào)用TabControl控件的相應(yīng)方法即可，而TabClick事件直接通過事件選擇欄選擇出來就行(如果大家不知道如何弄出這個(gè)mTabControl_TabClick事件過程的話，可以百度或者論壇上去看看VBA中類模塊的自定義事件的內(nèi)容)。最后我在補(bǔ)充一句要獲取子窗體中的窗體對象，需要使用子窗體的Form屬性，Access的子窗體只是一個(gè)容器。

站到終點(diǎn)站

     帖子的一個(gè)重點(diǎn)內(nèi)容我們還沒有涉及到，這一部分我們就來研究下Access中如何進(jìn)行GDI繪圖。GDI是Windows中用于完成繪圖的API函數(shù)的集合總稱，大部分的函數(shù)都包含在gdi32.dll這個(gè)動態(tài)鏈接庫文件中。要說明的是在Windows中完成繪圖，并不止GDI一種API函數(shù)集合，還有其他的，不過這也是最基礎(chǔ)的。當(dāng)然，在Windows中無論是通過GDI還是其他的什么API函數(shù)集合，其界面最終都是畫出來的。畫一次是一個(gè)靜態(tài)的界面，不停的畫，不停的對變化區(qū)域畫就讓我們看到了動態(tài)的界面。我們通過自繪并結(jié)合鼠標(biāo)移動、雙擊等事件，不停的對窗體進(jìn)行重畫，就產(chǎn)生了能對用戶操作作出反應(yīng)的Windows界面，也就達(dá)成了自繪控件的目的。     使用GDI繪圖類似于我們畫畫，首先我們需要準(zhǔn)備好畫畫所需要的材料跟設(shè)備，包括畫布、畫筆、顏料、貼畫等，GDI中所對應(yīng)的就有設(shè)備環(huán)境DC(相當(dāng)于畫布)、畫筆、畫刷、字體、圖片等。然后我們需要構(gòu)思圖畫的內(nèi)容，安排下畫畫的動作次序以及一些畫畫的技巧，GDI中所對應(yīng)的就是明確最終圖形的外觀、使用哪些API函數(shù)以及函數(shù)的使用先后順序。
     首先我們來解決第一個(gè)問題，就是在Access中畫圖時(shí)，如何做好材料設(shè)備的準(zhǔn)備工作。首先我們需要一張畫布，既然我們需要在窗體中畫(我們可以把窗體看做是畫板)，那就得獲取“鋪”在窗體畫板上的畫布。這個(gè)畫布是依據(jù)窗體畫板量身定做的，所以我們得根據(jù)窗體畫板的標(biāo)識號來定制一個(gè)畫布，這個(gè)標(biāo)識號就是窗體的句柄。我們將窗體句柄傳遞給GetWindowDC這個(gè)函數(shù)就可以獲取一個(gè)與該窗體對應(yīng)的畫布。
     所以現(xiàn)在的問題就轉(zhuǎn)換為如何獲取窗體的標(biāo)識符即句柄了。Access的窗體比較特殊，它包括了窗體頁眉、窗體主體、窗體頁腳三個(gè)窗體，即使沒有顯示窗體頁眉和頁腳，它們也只是被隱藏了而已。通俗點(diǎn)說，就是Access窗體這個(gè)畫板上還放了三塊畫板，這三塊畫板你都撤不掉，它們一定放在那塊窗體畫板的上面，只是我們可以隱藏其中幾塊而已。如果我們通過Access窗體本身的hwnd屬性獲取畫布并畫內(nèi)容的話，這些畫的內(nèi)容將被窗體頁眉、窗體主體和窗體頁腳所遮擋，所以我們在Access中畫圖的時(shí)候通常會在主體上進(jìn)行繪畫。

站到終點(diǎn)站

占位用7

站到終點(diǎn)站

占位用8

站到終點(diǎn)站

占位用9