如何在属性窗口显示About? 用鼠标点选About的子程序，然后点过程属性菜单，选Advanced,Programe ID选AboutBox即可！ 同样，如果要使控件的属性能绑定数据库，以及要能使控件在对象浏览器为显示属性、事件、方法的相关说明，也是使用这一菜单弹出的对话框。 控件开发的原则控件开发的原则首先是，控件中不可以再用Activex控件。因此，我们最多只能以基本控件做控件组件。但是，事实上，有时我们用这些反而不好！ 因为有时不用基本控件也行！ 运行以下代码，你可以看出，代码一样可以生成我们所要的组件：Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type' flags for DrawFrameControlPrivate Const DFC_CAPTION = 1 'Title bar Private Const DFC_MENU = 2 'Menu Private Const DFC_SCROLL = 3 'Scroll bar Private Const DFC_BUTTON = 4 'Standard buttonPrivate Const DFCS_CAPTIONCLOSE = &H0 'Close button Private Const DFCS_CAPTIONMIN = &H1 'Minimize button Private Const DFCS_CAPTIONMAX = &H2 'Maximize button Private Const DFCS_CAPTIONRESTORE = &H3 'Restore button Private Const DFCS_CAPTIONHELP = &H4 'Windows 95 only: 'Help buttonPrivate Const DFCS_MENUARROW = &H0 'Submenu arrow Private Const DFCS_MENUCHECK = &H1 'Check Private Const DFCS_MENUBULLET = &H2 'Bullet Private Const DFCS_MENUARROWRIGHT = &H4Private Const DFCS_SCROLLUP = &H0 'Up arrow of scroll 'bar Private Const DFCS_SCROLLDOWN = &H1 'Down arrow of 'scroll bar Private Const DFCS_SCROLLLEFT = &H2 'Left arrow of 'scroll bar Private Const DFCS_SCROLLRIGHT = &H3 'Right arrow of 'scroll bar Private Const DFCS_SCROLLCOMBOBOX = &H5 'Combo box scroll 'bar Private Const DFCS_SCROLLSIZEGRIP = &H8 'Size grip Private Const DFCS_SCROLLSIZEGRIPRIGHT = &H10 'Size grip in 'bottom-right 'corner of windowPrivate Const DFCS_BUTTONCHECK = &H0 'Check boxPrivate Const DFCS_BUTTONRADIO = &H4 'Radio button Private Const DFCS_BUTTON3STATE = &H8 'Three-state button Private Const DFCS_BUTTONPUSH = &H10 'Push buttonPrivate Const DFCS_INACTIVE = &H100 'Button is inactive '(grayed) Private Const DFCS_PUSHED = &H200 'Button is pushed Private Const DFCS_CHECKED = &H400 'Button is checkedPrivate Const DFCS_ADJUSTRECT = &H2000 'Bounding rectangle is 'adjusted to exclude the 'surrounding edge of the 'push buttonPrivate Const DFCS_FLAT = &H4000 'Button has a flat border Private Const DFCS_MONO = &H8000 'Button has a monochrome 'borderPrivate Declare Function DrawFrameControl Lib "user32" (ByVal _ hDC&, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) _ As Boolean'******************************************************************** ' Helper function that allows a you to load a rect on one line '******************************************************************** Private Function MakeRect(l As Long, t As Long, w As Long, _ h As Long) As RECT With MakeRect .Left = l .Top = t .Right = l + w .Bottom = t + h End WithEnd FunctionPrivate Sub Form_Load() ScaleMode = vbPixels AutoRedraw = True'Captions DrawFrameControl hDC, MakeRect(10, 10, 15, 15), DFC_CAPTION, _ DFCS_CAPTIONCLOSEDrawFrameControl hDC, MakeRect(10, 30, 15, 15), DFC_CAPTION, _ DFCS_CAPTIONRESTOREDrawFrameControl hDC, MakeRect(10, 50, 15, 15), DFC_CAPTION, _ DFCS_CAPTIONMAX Or DFCS_INACTIVE' Menus DrawFrameControl hDC, MakeRect(30, 10, 15, 15), DFC_MENU, _ DFCS_MENUARROWDrawFrameControl hDC, MakeRect(30, 30, 15, 15), DFC_MENU, _ DFCS_MENUCHECKDrawFrameControl hDC, MakeRect(30, 50, 15, 15), DFC_MENU, _ DFCS_MENUBULLET' Scrollbars DrawFrameControl hDC, MakeRect(50, 10, 15, 15), DFC_SCROLL, _ DFCS_SCROLLUPDrawFrameControl hDC, MakeRect(50, 30, 15, 15), DFC_SCROLL, _ DFCS_SCROLLSIZEGRIPDrawFrameControl hDC, MakeRect(50, 50, 15, 15), DFC_SCROLL, _ DFCS_SCROLLRIGHT Or DFCS_INACTIVE' Checkboxes DrawFrameControl hDC, MakeRect(70, 10, 15, 15), DFC_BUTTON, _ DFCS_BUTTONCHECKDrawFrameControl hDC, MakeRect(70, 30, 15, 15), DFC_BUTTON, _ DFCS_BUTTONCHECK Or DFCS_CHECKEDDrawFrameControl hDC, MakeRect(70, 50, 15, 15), DFC_BUTTON, _ DFCS_BUTTONCHECK Or DFCS_CHECKED Or DFCS_BUTTON3STATE' Option Buttons DrawFrameControl hDC, MakeRect(90, 10, 15, 15), DFC_BUTTON, _ DFCS_BUTTONRADIODrawFrameControl hDC, MakeRect(90, 30, 15, 15), DFC_BUTTON, _ DFCS_BUTTONRADIO Or DFCS_CHECKEDDrawFrameControl hDC, MakeRect(90, 50, 15, 15), DFC_BUTTON, _ DFCS_BUTTONRADIO Or DFCS_CHECKED Or DFCS_FLAT' Push Button DrawFrameControl hDC, MakeRect(110, 10, 50, 20), DFC_BUTTON, _ DFCS_BUTTONPUSHDrawFrameControl hDC, MakeRect(110, 40, 50, 20), DFC_BUTTON, _ DFCS_BUTTONPUSH Or DFCS_PUSHEDEnd Sub 由此，如果你要做一个观象ComboBox的控件，你是否要用ComboBox加Hook或者DriveBox加Hook?一定不需要，你只要一个TextBox或者一个PictureBox就足够了！ 可以吗？你试试，一定能做出来的！ 好了，我们已经说了各种原料的加工过程。那么，现在我们就做一个“汉堡坯”，将PictureBox用代码改为ComboBox的外观：模块： Option ExplicitPrivate Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type' flags for DrawFrameControl Private Const DFC_SCROLL = 3 'Scroll barPrivate Const DFCS_SCROLLCOMBOBOX = &H5 'Combo box scroll Private Const DFCS_INACTIVE = &H100 'Button is inactive '(grayed) Private Const DFCS_PUSHED = &H200 'Button is pushedPrivate Const DFCS_FLAT = &H4000 'Button has a flat border Private Const DFCS_MONO = &H8000 'Button has a monochrome 'borderPrivate Declare Function DrawFrameControl Lib "user32" (ByVal _ hDC&, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) _ As BooleanPrivate Declare Function GetClientRect Lib "user32" (ByVal _ hwnd As Long, lpRect As RECT) As LongPublic Sub DrawComboBtn(Ctl As Control, bPushed As Boolean, bFlat As Boolean)Dim BtnFlags As LongCtl.ScaleMode = vbPixelsBtnFlags = DFCS_SCROLLCOMBOBOX Or (-bPushed * DFCS_PUSHED) _ Or (-bPushed * DFCS_FLAT) Or (-bFlat * DFCS_MONO)DrawFrameControl Ctl.hDC, _ MakeRect(Ctl.Width - 20, 0, 16, Ctl.Height - 4), _ DFC_SCROLL, BtnFlags Ctl.Refresh End SubPrivate Function MakeRect(l As Long, t As Long, w As Long, _ h As Long) As RECT With MakeRect .Left = l .Top = t .Right = l + w .Bottom = t + h End WithEnd Function 窗体部分只要处理三个事件：Private Sub Form_Load()DrawComboBtn Picture1, False, FalseEnd SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Sin gle, Y As Single) If X >= Picture1.Width - 20 And X <= Picture1.Width - 4 And _ Y > 0 And Y <= Picture1.Height - 4 ThenDrawComboBtn Picture1, True, False End IfEnd SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Singl e, Y As Single) If X >= Picture1.Width - 20 And X <= Picture1.Width - 4 And _ Y > 0 And Y <= Picture1.Height - 4 Then DrawComboBtn Picture1, False, False End If End Sub运行一下，看看，是不是一个可用的坯子？你还可以改为浮动的！ 由此，我们不再需要用HOOK改造ComboBox或DriveBox了。
那个HOOK代码如何写呢： 以下即是： Option ExplicitPublic Declare Function CallWindowProc Lib "user32" Alias "Ca llWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "Set WindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public m_FrmhWnd As Long Public m_Hook As Boolean Private m_PrevWndProc As Long Public Sub Hook() If Not m_Hook Then m_PrevWndProc = SetWindowLong(m_FrmhWnd, GWL_WNDPROC, AddressOf Wind owProc) m_Hook = True End If End SubPublic Sub Unhook() If m_Hook Then Call SetWindowLong(m_FrmhWnd, GWL_WNDPROC, m_PrevWndProc) m_Hook = False End If End SubPrivate Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wPar am As Long, ByVal lParam As Long) As LongSelect Case uMsgCase WM_NCACTIVATE WindowProc = CallWindowProc(m_PrevWndProc, hw, uMsg, 1, lParam)Case Else WindowProc = CallWindowProc(m_PrevWndProc, hw, uMsg, wParam, lPa ram)End Select End Function只要你在前面的窗体获取焦点前Hook父窗体，则一切就能如何所愿了。 如何我们再看看这个原工程，就会发现，工具条窗口中的标题栏是用label加上按钮做的 一个假的标题栏。同样DreamWaver也是这样！这当然节省资源。不过如果你要做得逼真，则你需要用PictureBox，这样可以进行色彩渐变，同时用我们 上面的API生成标题栏按钮，则就是真的标题栏了。如果你还有想法，则还可以加上图标 ，并显示系统菜单！ 须要注意的是，标题栏的色彩渐变是HLS模式峭是RGB，你得使用相关的API函数。接下来，我们再谈一个问题： 关于枚举的使用。控件中为什么要用枚举？因为使用枚举，则使用户在录入属性时不会 录入非法属性。同时也可以与系统中的其它控件的属性设置保持一致。 但是，有很多控件就是实现不了这个一致，因为，变量不可以数字开头，则 3D 这个A ppearance属性的枚举就不允许存在，同样， Fixed Single 这种中问有空格的也不行。 然而你又不能用上系统中缺省的枚举，怎么办？事实上你忘了标点符号的用法了，如果你记得，有这么一个特殊的标点：[] 用这一对标点，你就可以实现了！ 我们定义以下枚举：Public Enum cApperance [Flat] = 0 [3D] = 1 End EnumPublic Enum cBorderStyle [None] = 0 [Fixed Single] = 1 End Enum然后你可以用此来设定你的控件的Appearance与BorderStyle属性， 在使用你的控件时，你一定会发现，与系统中的一样！ 其实，写ActiveX控件最难的地方是，别人写不出来的你要能写出来。 通常，我们编程只要需要，找控件用就行了。但是Activex中你不能再调用ActiveX，这 样会使你的控件失去稳定性以及实用性，并增加了对你所用的ActveX的依赖性。所以， 所有的一切，你都得自己去写。比如，高级的控件中，选项卡随处可见。就如VB开发环 境中的色彩下拉，其中就有选项卡，难道还要引用选项卡控件？ 如果这样，前者注册不成功，则后者运行不了！ 因此，我们这里给一个选项卡的例子：（工程见光盘中的源程序）Private Sub Form_Load() TabCtl_loadEnd Sub Private Sub LabTit_Click(Index As Integer) TabCtlSet IndexEnd Sub Sub Draw3dCtl(F As Form, C As Control, Optional b3Line As String = "0&q uot;)Const White = &HFFFFFF Const DarkGrey = &H80000015 Dim X1 As Integer Dim X2 As Integer Dim Y1 As Integer Dim Y2 As Integer Dim cHeight As Integer Dim cWidth As Integer Dim cLeft As Integer Dim cTop As Integer Dim LForColor As LongLForColor = C.BackColor F.DrawWidth = 3cLeft = C.Left cTop = C.Top cHeight = C.Height cWidth = C.Width'Top X1 = cLeft X2 = cLeft + cWidth Y1 = cTop Y2 = cTop If b3Line = "4" Then F.ForeColor = LForColor Else F.ForeColor = White End If F.Line (X1, Y1)-(X2, Y2)'Left X1 = cLeft X2 = cLeft Y1 = cTop Y2 = cTop + cHeight If b3Line = "4" Then F.ForeColor = LForColor Else F.ForeColor = White End If F.Line (X1, Y1)-(X2, Y2) 'Buttom X1 = cLeft X2 = cLeft + cWidth Y1 = cTop + cHeight Y2 = cTop + cHeight If b3Line = "0" Then F.ForeColor = DarkGrey ElseIf b3Line = "1" Then F.ForeColor = LForColor ElseIf b3Line = "2" Then F.ForeColor = White End If F.Line (X1, Y1)-(X2, Y2)'Right X1 = cLeft + cWidth X2 = cLeft + cWidth Y1 = cTop If b3Line = "2" Then Y2 = cTop + cHeight - 35 Else Y2 = cTop + cHeight End If If b3Line = "4" Then F.ForeColor = LForColor Else F.ForeColor = DarkGrey End If F.Line (X1, Y1)-(X2, Y2) End Sub Private Sub Pictab_Click(Index As Integer)TabCtlSet IndexEnd Sub
Private Sub TabCtlSet(Optional Index As Integer = 0) Dim i As Integer Static sIndex As Integer If Index = sIndex Then Exit Sub End If PicTab(sIndex).Tag = "2"PicTab(Index).Tag = "1"Fratab(sIndex).Visible = False MakeCtlSize PicTab(sIndex), False MakeCtlSize PicTab(Index), True For i = 0 To 3 Draw3dCtl Me, Fratab(i) Next i For i = 0 To 3 Draw3dCtl Me, PicTab(i), PicTab(i).Tag Next i Fratab(Index).Visible = TruesIndex = Index Fratab(Index).ZOrder PicTab(Index).ZOrder LabTit(Index).ZOrder Refresh End Sub Private Sub TabCtl_load() Dim i As Integer For i = 0 To 3 PicTab(i).BackColor = Me.BackColor Fratab(i).BackColor = Me.BackColor Fratab(i).Left = 180 Fratab(i).Top = 570 Next i MakeCtlSize PicTab(0), True For i = 1 To 3 PicTab(i).Height = 310 MakeCtlSize PicTab(i), False Next i PicTab(0).Tag = "1" For i = 0 To 3 Draw3dCtl Me, Fratab(i) Draw3dCtl Me, PicTab(i), PicTab(i).Tag Next i Fratab(0).Visible = True Fratab(0).ZOrder PicTab(0).ZOrder LabTit(0).ZOrder Refresh End SubPrivate Sub MakeCtlSize(C As Control, Optional ByVal IsGranda As Boolean = F alse) If IsGranda = False Then If C.Height = 370 Then Draw3dCtl Me, C, "4" C.Height = 310 C.Top = C.Top + 35 C.Left = C.Left + 35 C.Width = C.Width - 35 Else Exit Sub End If Else If C.Height = 370 Then Exit Sub Else Draw3dCtl Me, C, "4" C.Height = 370 C.Top = C.Top - 35 C.Left = C.Left - 35 C.Width = C.Width + 35 End If End If End Sub注意，这一例子，Form的AutoRedraw属性为True 同样，ListBox有时可以用现成的，有时同样要你自己写。用什么：PictureBox 农历控件中日期显示部分实际就是一个list，不过不是List控件。这样，你的Activex中 所用的控件才会少，占用资源才会少！ 真正开发，说起来是很简单。新建一个控件工程，按需要，可以增加UserControl类，然 后写代码，再用控件界面向导生成属性、方法与事件，如果需要，还可以运行属性页向 导，让你的控件有属性页。 但是，一个商业的控件，一定不能有任何Bug,这就要使你的程序数据随时保证有效。 由此，属性不能用Public变量代替，因为在属性过程中你可以检则并设置数据的有效性 ！ 当然，除了在属性过程中检查外，还可以在相应过程中再更改，比如： 你可以对控件的大小这样处理：Private Sub UserControl_Resize() ' Check to see if the control is larger or smaller than the preset ' minimum or maximum size. ' If it is larger or smaller, set the size of the control. Select Case Height Case Is < 2400 Height = 2400 Case Is > 3600 Height = 3600 End SelectSelect Case Width Case Is < 2400 Width = 2400 Case Is > 3600 Width = 3600 End Select ' The label reports the height and width of the control in ' twips even if the container has a different scalemode. Label1.Caption = "Height: " & Height Label2.Caption = "Width: " & Width End Sub再有，好的控件有时同样需要有帮助，有时甚致要有What's this 的帮助！怎么加呢？你可以查MSDN的KB，我不再多讲了！同样，由于控件是由多个部件组成的，因此，你要对控件的大小以及Enabled属性一一设置。否则，你只用UserControl.Enabled=False，实际上你的控件仍是可用的！说起属性，还有两个问题： 其一是缺省属性的问题。VB6的控件全部都有缺省属性，比如我们可以用label="Hello",实际调用的即是Caption这个缺省属性。 那么，如何作缺省属性呢？ 你只要选中Get属性过程，然后点击过程属性菜单，再点Advanced按钮，在Procedure ID中选择Default，这样这一属性就是缺省属性了！另一个是:List属性如何做？（当然，你同样可以做成List方法，不过，确实有控件存在List属性） 其实，类向导只生成单一参数的属性，平常我们都用不到多参属性，事实上多参数的属性是可以的！以下即是CLASS类中List属性的代码：Option Explicit Private mvarList() As VariantPrivate Sub Class_Initialize() ReDim Preserve mvarList(0) End SubPublic Property Let List(ByVal Index As Long, ByVal vData As Variant) If Index > UBound(mvarList) Then ReDim Preserve mvarList(Index) End If mvarList(Index) = vData End Property Public Property Get List(ByVal Index As Long) As Variant If Index > UBound(mvarList) Then Exit Property End If List = mvarList(Index)End Property实际上，List属性可以不只是一个下标！那么，所有下标都要放在前面，而Let中要传值的参数则要放到最后。 那么在控件中如何去实现呢？你需要用一个变体的变量保存其属性。 这一属性应当是不可见的私有属性。比如，vList，然后你调用vList=mvarList，属性就存了下来！ 因为还要读出来，所以前者一样要用变体。属性如何不可见？ 还是使用过程属性菜单，在其对话框中设置即可！好了，我们再谈窗体，我曾经在某网站提问，如果去掉标题栏中的最大化/还原按钮。然而，我得到的是以下答复： “Form.MaxButton=False 啊啊” 回复人意思说，看你这样是可能太初级了！我想他一定是如此。否则不会有两个“啊”字。 可是到最后实际还是没有人答出来。另一角度说，大都程序员考虑问题从没有向深处想。有更多的则是处于抄袭。当然，通常的代码都是可以抄的。实际上，编程时大多代码也是固定的的。所以首先就当会抄。但是，非常复杂的问题常需要有独创性。比如，找素数这个问题。算法与效率一定是因人而异的。因为其中的创造性太强了！ 换句话说，也只有创造性的东西才是最有价值的。我常常收到很多人要源代码的邮件！这些人有没有想想，你是程序员，还是程序工匠？我觉得，充其量只不过是一个熟练工罢了！而且不时还想抄别人的东西！就是抄，你也得看是否可抄。说白了，这些人是自己将自己的人格放低了！ 所以，编程、做人、做学问是一致的，一个人程序写得好不好，首先要看其为人。这里虽然讲的是开发控件。实际上，编任何程序都是如此。我们可以好好看看，OFFICE，这个最普及的软件，其中有多少独创？你为什么不发邮件向微软要源代码呢？ 反过来，如果你真有创造性，那你的工资自然就高了！那么，你能解决这个问题吗？ 如果你认真看懂了前面的，解决此问题我想你是有办法了： 因为，我们可以完全去掉Form中的标题条，因为我们知道，标题条按钮是如何做出来的。由此，我们即可以按自己的要求做标题条。要去掉的按钮自然就不在了，而外观与原Form并元二样！ 现在有很多Skin控件，可是多数都没有加上标题条按钮，这也是因为，API函数太多了，另一方面也说明，没有人为此付出时间去真正解决过这类问题。
用鼠标点选About的子程序，然后点过程属性菜单，选Advanced,Programe ID选AboutBox即可！ 同样，如果要使控件的属性能绑定数据库，以及要能使控件在对象浏览器为显示属性、事件、方法的相关说明，也是使用这一菜单弹出的对话框。 控件开发的原则控件开发的原则首先是，控件中不可以再用Activex控件。因此，我们最多只能以基本控件做控件组件。但是，事实上，有时我们用这些反而不好！
因为有时不用基本控件也行！
运行以下代码，你可以看出，代码一样可以生成我们所要的组件：Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type' flags for DrawFrameControlPrivate Const DFC_CAPTION = 1 'Title bar
Private Const DFC_MENU = 2 'Menu
Private Const DFC_SCROLL = 3 'Scroll bar
Private Const DFC_BUTTON = 4 'Standard buttonPrivate Const DFCS_CAPTIONCLOSE = &H0 'Close button
Private Const DFCS_CAPTIONMIN = &H1 'Minimize button
Private Const DFCS_CAPTIONMAX = &H2 'Maximize button
Private Const DFCS_CAPTIONRESTORE = &H3 'Restore button
Private Const DFCS_CAPTIONHELP = &H4 'Windows 95 only:
'Help buttonPrivate Const DFCS_MENUARROW = &H0 'Submenu arrow
Private Const DFCS_MENUCHECK = &H1 'Check
Private Const DFCS_MENUBULLET = &H2 'Bullet
Private Const DFCS_MENUARROWRIGHT = &H4Private Const DFCS_SCROLLUP = &H0 'Up arrow of scroll
'bar
Private Const DFCS_SCROLLDOWN = &H1 'Down arrow of
'scroll bar
Private Const DFCS_SCROLLLEFT = &H2 'Left arrow of
'scroll bar
Private Const DFCS_SCROLLRIGHT = &H3 'Right arrow of
'scroll bar
Private Const DFCS_SCROLLCOMBOBOX = &H5 'Combo box scroll
'bar
Private Const DFCS_SCROLLSIZEGRIP = &H8 'Size grip
Private Const DFCS_SCROLLSIZEGRIPRIGHT = &H10 'Size grip in
'bottom-right
'corner of windowPrivate Const DFCS_BUTTONCHECK = &H0 'Check boxPrivate Const DFCS_BUTTONRADIO = &H4 'Radio button
Private Const DFCS_BUTTON3STATE = &H8 'Three-state button
Private Const DFCS_BUTTONPUSH = &H10 'Push buttonPrivate Const DFCS_INACTIVE = &H100 'Button is inactive
'(grayed)
Private Const DFCS_PUSHED = &H200 'Button is pushed
Private Const DFCS_CHECKED = &H400 'Button is checkedPrivate Const DFCS_ADJUSTRECT = &H2000 'Bounding rectangle is
'adjusted to exclude the
'surrounding edge of the
'push buttonPrivate Const DFCS_FLAT = &H4000 'Button has a flat border
Private Const DFCS_MONO = &H8000 'Button has a monochrome
'borderPrivate Declare Function DrawFrameControl Lib "user32" (ByVal _
hDC&, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) _
As Boolean'********************************************************************
' Helper function that allows a you to load a rect on one line
'********************************************************************
Private Function MakeRect(l As Long, t As Long, w As Long, _
h As Long) As RECT
With MakeRect
.Left = l
.Top = t
.Right = l + w
.Bottom = t + h
End WithEnd FunctionPrivate Sub Form_Load()
ScaleMode = vbPixels
AutoRedraw = True'Captions
DrawFrameControl hDC, MakeRect(10, 10, 15, 15), DFC_CAPTION, _
DFCS_CAPTIONCLOSEDrawFrameControl hDC, MakeRect(10, 30, 15, 15), DFC_CAPTION, _
DFCS_CAPTIONRESTOREDrawFrameControl hDC, MakeRect(10, 50, 15, 15), DFC_CAPTION, _
DFCS_CAPTIONMAX Or DFCS_INACTIVE' Menus
DrawFrameControl hDC, MakeRect(30, 10, 15, 15), DFC_MENU, _
DFCS_MENUARROWDrawFrameControl hDC, MakeRect(30, 30, 15, 15), DFC_MENU, _
DFCS_MENUCHECKDrawFrameControl hDC, MakeRect(30, 50, 15, 15), DFC_MENU, _
DFCS_MENUBULLET' Scrollbars
DrawFrameControl hDC, MakeRect(50, 10, 15, 15), DFC_SCROLL, _
DFCS_SCROLLUPDrawFrameControl hDC, MakeRect(50, 30, 15, 15), DFC_SCROLL, _
DFCS_SCROLLSIZEGRIPDrawFrameControl hDC, MakeRect(50, 50, 15, 15), DFC_SCROLL, _
DFCS_SCROLLRIGHT Or DFCS_INACTIVE' Checkboxes
DrawFrameControl hDC, MakeRect(70, 10, 15, 15), DFC_BUTTON, _
DFCS_BUTTONCHECKDrawFrameControl hDC, MakeRect(70, 30, 15, 15), DFC_BUTTON, _
DFCS_BUTTONCHECK Or DFCS_CHECKEDDrawFrameControl hDC, MakeRect(70, 50, 15, 15), DFC_BUTTON, _
DFCS_BUTTONCHECK Or DFCS_CHECKED Or DFCS_BUTTON3STATE' Option Buttons
DrawFrameControl hDC, MakeRect(90, 10, 15, 15), DFC_BUTTON, _
DFCS_BUTTONRADIODrawFrameControl hDC, MakeRect(90, 30, 15, 15), DFC_BUTTON, _
DFCS_BUTTONRADIO Or DFCS_CHECKEDDrawFrameControl hDC, MakeRect(90, 50, 15, 15), DFC_BUTTON, _
DFCS_BUTTONRADIO Or DFCS_CHECKED Or DFCS_FLAT' Push Button
DrawFrameControl hDC, MakeRect(110, 10, 50, 20), DFC_BUTTON, _
DFCS_BUTTONPUSHDrawFrameControl hDC, MakeRect(110, 40, 50, 20), DFC_BUTTON, _
DFCS_BUTTONPUSH Or DFCS_PUSHEDEnd Sub
由此，如果你要做一个观象ComboBox的控件，你是否要用ComboBox加Hook或者DriveBox加Hook?一定不需要，你只要一个TextBox或者一个PictureBox就足够了！
可以吗？你试试，一定能做出来的！
好了，我们已经说了各种原料的加工过程。那么，现在我们就做一个“汉堡坯”，将PictureBox用代码改为ComboBox的外观：模块：
Option ExplicitPrivate Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type' flags for DrawFrameControl
Private Const DFC_SCROLL = 3 'Scroll barPrivate Const DFCS_SCROLLCOMBOBOX = &H5 'Combo box scroll
Private Const DFCS_INACTIVE = &H100 'Button is inactive
'(grayed)
Private Const DFCS_PUSHED = &H200 'Button is pushedPrivate Const DFCS_FLAT = &H4000 'Button has a flat border
Private Const DFCS_MONO = &H8000 'Button has a monochrome
'borderPrivate Declare Function DrawFrameControl Lib "user32" (ByVal _
hDC&, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) _
As BooleanPrivate Declare Function GetClientRect Lib "user32" (ByVal _
hwnd As Long, lpRect As RECT) As LongPublic Sub DrawComboBtn(Ctl As Control, bPushed As Boolean, bFlat As Boolean)Dim BtnFlags As LongCtl.ScaleMode = vbPixelsBtnFlags = DFCS_SCROLLCOMBOBOX Or (-bPushed * DFCS_PUSHED) _
Or (-bPushed * DFCS_FLAT) Or (-bFlat * DFCS_MONO)DrawFrameControl Ctl.hDC, _
MakeRect(Ctl.Width - 20, 0, 16, Ctl.Height - 4), _
DFC_SCROLL, BtnFlags
Ctl.Refresh
End SubPrivate Function MakeRect(l As Long, t As Long, w As Long, _
h As Long) As RECT
With MakeRect
.Left = l
.Top = t
.Right = l + w
.Bottom = t + h
End WithEnd Function
窗体部分只要处理三个事件：Private Sub Form_Load()DrawComboBtn Picture1, False, FalseEnd SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Sin
gle, Y As Single)
If X >= Picture1.Width - 20 And X <= Picture1.Width - 4 And _
Y > 0 And Y <= Picture1.Height - 4 ThenDrawComboBtn Picture1, True, False
End IfEnd SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Singl
e, Y As Single)
If X >= Picture1.Width - 20 And X <= Picture1.Width - 4 And _
Y > 0 And Y <= Picture1.Height - 4 Then
DrawComboBtn Picture1, False, False
End If
End Sub运行一下，看看，是不是一个可用的坯子？你还可以改为浮动的！
由此，我们不再需要用HOOK改造ComboBox或DriveBox了。
以下即是：
Option ExplicitPublic Declare Function CallWindowProc Lib "user32" Alias "Ca
llWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal
Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "Set
WindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong
As Long) As Long
Public m_FrmhWnd As Long
Public m_Hook As Boolean
Private m_PrevWndProc As Long
Public Sub Hook()
If Not m_Hook Then
m_PrevWndProc = SetWindowLong(m_FrmhWnd, GWL_WNDPROC, AddressOf Wind
owProc)
m_Hook = True
End If
End SubPublic Sub Unhook()
If m_Hook Then
Call SetWindowLong(m_FrmhWnd, GWL_WNDPROC, m_PrevWndProc)
m_Hook = False
End If
End SubPrivate Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wPar
am As Long, ByVal lParam As Long) As LongSelect Case uMsgCase WM_NCACTIVATE
WindowProc = CallWindowProc(m_PrevWndProc, hw, uMsg, 1, lParam)Case Else
WindowProc = CallWindowProc(m_PrevWndProc, hw, uMsg, wParam, lPa
ram)End Select
End Function只要你在前面的窗体获取焦点前Hook父窗体，则一切就能如何所愿了。
如何我们再看看这个原工程，就会发现，工具条窗口中的标题栏是用label加上按钮做的
一个假的标题栏。同样DreamWaver也是这样！这当然节省资源。不过如果你要做得逼真，则你需要用PictureBox，这样可以进行色彩渐变，同时用我们
上面的API生成标题栏按钮，则就是真的标题栏了。如果你还有想法，则还可以加上图标
，并显示系统菜单！
须要注意的是，标题栏的色彩渐变是HLS模式峭是RGB，你得使用相关的API函数。接下来，我们再谈一个问题：
关于枚举的使用。控件中为什么要用枚举？因为使用枚举，则使用户在录入属性时不会
录入非法属性。同时也可以与系统中的其它控件的属性设置保持一致。
但是，有很多控件就是实现不了这个一致，因为，变量不可以数字开头，则 3D 这个A
ppearance属性的枚举就不允许存在，同样， Fixed Single 这种中问有空格的也不行。
然而你又不能用上系统中缺省的枚举，怎么办？事实上你忘了标点符号的用法了，如果你记得，有这么一个特殊的标点：[]
用这一对标点，你就可以实现了！
我们定义以下枚举：Public Enum cApperance
[Flat] = 0
[3D] = 1
End EnumPublic Enum cBorderStyle
[None] = 0
[Fixed Single] = 1
End Enum然后你可以用此来设定你的控件的Appearance与BorderStyle属性，
在使用你的控件时，你一定会发现，与系统中的一样！
其实，写ActiveX控件最难的地方是，别人写不出来的你要能写出来。
通常，我们编程只要需要，找控件用就行了。但是Activex中你不能再调用ActiveX，这
样会使你的控件失去稳定性以及实用性，并增加了对你所用的ActveX的依赖性。所以，
所有的一切，你都得自己去写。比如，高级的控件中，选项卡随处可见。就如VB开发环
境中的色彩下拉，其中就有选项卡，难道还要引用选项卡控件？
如果这样，前者注册不成功，则后者运行不了！
因此，我们这里给一个选项卡的例子：（工程见光盘中的源程序）Private Sub Form_Load()
TabCtl_loadEnd Sub
Private Sub LabTit_Click(Index As Integer)
TabCtlSet IndexEnd Sub
Sub Draw3dCtl(F As Form, C As Control, Optional b3Line As String = "0&q
uot;)Const White = &HFFFFFF
Const DarkGrey = &H80000015
Dim X1 As Integer
Dim X2 As Integer
Dim Y1 As Integer
Dim Y2 As Integer
Dim cHeight As Integer
Dim cWidth As Integer
Dim cLeft As Integer
Dim cTop As Integer
Dim LForColor As LongLForColor = C.BackColor
F.DrawWidth = 3cLeft = C.Left
cTop = C.Top
cHeight = C.Height
cWidth = C.Width'Top
X1 = cLeft
X2 = cLeft + cWidth
Y1 = cTop
Y2 = cTop
If b3Line = "4" Then
F.ForeColor = LForColor
Else
F.ForeColor = White
End If
F.Line (X1, Y1)-(X2, Y2)'Left
X1 = cLeft
X2 = cLeft
Y1 = cTop
Y2 = cTop + cHeight
If b3Line = "4" Then
F.ForeColor = LForColor
Else
F.ForeColor = White
End If
F.Line (X1, Y1)-(X2, Y2)
'Buttom
X1 = cLeft
X2 = cLeft + cWidth
Y1 = cTop + cHeight
Y2 = cTop + cHeight
If b3Line = "0" Then
F.ForeColor = DarkGrey
ElseIf b3Line = "1" Then
F.ForeColor = LForColor
ElseIf b3Line = "2" Then
F.ForeColor = White
End If
F.Line (X1, Y1)-(X2, Y2)'Right
X1 = cLeft + cWidth
X2 = cLeft + cWidth
Y1 = cTop
If b3Line = "2" Then
Y2 = cTop + cHeight - 35
Else
Y2 = cTop + cHeight
End If
If b3Line = "4" Then
F.ForeColor = LForColor
Else
F.ForeColor = DarkGrey
End If
F.Line (X1, Y1)-(X2, Y2)
End Sub
Private Sub Pictab_Click(Index As Integer)TabCtlSet IndexEnd Sub
Dim i As Integer
Static sIndex As Integer
If Index = sIndex Then
Exit Sub
End If
PicTab(sIndex).Tag = "2"PicTab(Index).Tag = "1"Fratab(sIndex).Visible = False
MakeCtlSize PicTab(sIndex), False
MakeCtlSize PicTab(Index), True
For i = 0 To 3
Draw3dCtl Me, Fratab(i)
Next i
For i = 0 To 3
Draw3dCtl Me, PicTab(i), PicTab(i).Tag
Next i
Fratab(Index).Visible = TruesIndex = Index
Fratab(Index).ZOrder
PicTab(Index).ZOrder
LabTit(Index).ZOrder
Refresh
End Sub
Private Sub TabCtl_load()
Dim i As Integer
For i = 0 To 3
PicTab(i).BackColor = Me.BackColor
Fratab(i).BackColor = Me.BackColor
Fratab(i).Left = 180
Fratab(i).Top = 570
Next i
MakeCtlSize PicTab(0), True
For i = 1 To 3
PicTab(i).Height = 310
MakeCtlSize PicTab(i), False
Next i
PicTab(0).Tag = "1"
For i = 0 To 3
Draw3dCtl Me, Fratab(i)
Draw3dCtl Me, PicTab(i), PicTab(i).Tag
Next i
Fratab(0).Visible = True
Fratab(0).ZOrder
PicTab(0).ZOrder
LabTit(0).ZOrder
Refresh
End SubPrivate Sub MakeCtlSize(C As Control, Optional ByVal IsGranda As Boolean = F
alse)
If IsGranda = False Then
If C.Height = 370 Then
Draw3dCtl Me, C, "4"
C.Height = 310
C.Top = C.Top + 35
C.Left = C.Left + 35
C.Width = C.Width - 35
Else
Exit Sub
End If
Else
If C.Height = 370 Then
Exit Sub
Else
Draw3dCtl Me, C, "4"
C.Height = 370
C.Top = C.Top - 35
C.Left = C.Left - 35
C.Width = C.Width + 35
End If
End If
End Sub注意，这一例子，Form的AutoRedraw属性为True
同样，ListBox有时可以用现成的，有时同样要你自己写。用什么：PictureBox
农历控件中日期显示部分实际就是一个list，不过不是List控件。这样，你的Activex中
所用的控件才会少，占用资源才会少！
真正开发，说起来是很简单。新建一个控件工程，按需要，可以增加UserControl类，然
后写代码，再用控件界面向导生成属性、方法与事件，如果需要，还可以运行属性页向
导，让你的控件有属性页。
但是，一个商业的控件，一定不能有任何Bug,这就要使你的程序数据随时保证有效。
由此，属性不能用Public变量代替，因为在属性过程中你可以检则并设置数据的有效性
！
当然，除了在属性过程中检查外，还可以在相应过程中再更改，比如：
你可以对控件的大小这样处理：Private Sub UserControl_Resize()
' Check to see if the control is larger or smaller than the preset
' minimum or maximum size.
' If it is larger or smaller, set the size of the control.
Select Case Height
Case Is < 2400
Height = 2400
Case Is > 3600
Height = 3600
End SelectSelect Case Width
Case Is < 2400
Width = 2400
Case Is > 3600
Width = 3600
End Select
' The label reports the height and width of the control in
' twips even if the container has a different scalemode.
Label1.Caption = "Height: " & Height
Label2.Caption = "Width: " & Width
End Sub再有，好的控件有时同样需要有帮助，有时甚致要有What's this 的帮助！怎么加呢？你可以查MSDN的KB，我不再多讲了！同样，由于控件是由多个部件组成的，因此，你要对控件的大小以及Enabled属性一一设置。否则，你只用UserControl.Enabled=False，实际上你的控件仍是可用的！说起属性，还有两个问题：
其一是缺省属性的问题。VB6的控件全部都有缺省属性，比如我们可以用label="Hello",实际调用的即是Caption这个缺省属性。
那么，如何作缺省属性呢？
你只要选中Get属性过程，然后点击过程属性菜单，再点Advanced按钮，在Procedure ID中选择Default，这样这一属性就是缺省属性了！另一个是:List属性如何做？（当然，你同样可以做成List方法，不过，确实有控件存在List属性）
其实，类向导只生成单一参数的属性，平常我们都用不到多参属性，事实上多参数的属性是可以的！以下即是CLASS类中List属性的代码：Option Explicit
Private mvarList() As VariantPrivate Sub Class_Initialize()
ReDim Preserve mvarList(0)
End SubPublic Property Let List(ByVal Index As Long, ByVal vData As Variant)
If Index > UBound(mvarList) Then
ReDim Preserve mvarList(Index)
End If
mvarList(Index) = vData
End Property
Public Property Get List(ByVal Index As Long) As Variant
If Index > UBound(mvarList) Then
Exit Property
End If
List = mvarList(Index)End Property实际上，List属性可以不只是一个下标！那么，所有下标都要放在前面，而Let中要传值的参数则要放到最后。
那么在控件中如何去实现呢？你需要用一个变体的变量保存其属性。
这一属性应当是不可见的私有属性。比如，vList，然后你调用vList=mvarList，属性就存了下来！
因为还要读出来，所以前者一样要用变体。属性如何不可见？
还是使用过程属性菜单，在其对话框中设置即可！好了，我们再谈窗体，我曾经在某网站提问，如果去掉标题栏中的最大化/还原按钮。然而，我得到的是以下答复：
“Form.MaxButton=False 啊啊”
回复人意思说，看你这样是可能太初级了！我想他一定是如此。否则不会有两个“啊”字。
可是到最后实际还是没有人答出来。另一角度说，大都程序员考虑问题从没有向深处想。有更多的则是处于抄袭。当然，通常的代码都是可以抄的。实际上，编程时大多代码也是固定的的。所以首先就当会抄。但是，非常复杂的问题常需要有独创性。比如，找素数这个问题。算法与效率一定是因人而异的。因为其中的创造性太强了！
换句话说，也只有创造性的东西才是最有价值的。我常常收到很多人要源代码的邮件！这些人有没有想想，你是程序员，还是程序工匠？我觉得，充其量只不过是一个熟练工罢了！而且不时还想抄别人的东西！就是抄，你也得看是否可抄。说白了，这些人是自己将自己的人格放低了！
所以，编程、做人、做学问是一致的，一个人程序写得好不好，首先要看其为人。这里虽然讲的是开发控件。实际上，编任何程序都是如此。我们可以好好看看，OFFICE，这个最普及的软件，其中有多少独创？你为什么不发邮件向微软要源代码呢？
反过来，如果你真有创造性，那你的工资自然就高了！那么，你能解决这个问题吗？
如果你认真看懂了前面的，解决此问题我想你是有办法了：
因为，我们可以完全去掉Form中的标题条，因为我们知道，标题条按钮是如何做出来的。由此，我们即可以按自己的要求做标题条。要去掉的按钮自然就不在了，而外观与原Form并元二样！
现在有很多Skin控件，可是多数都没有加上标题条按钮，这也是因为，API函数太多了，另一方面也说明，没有人为此付出时间去真正解决过这类问题。