求教：如何制作用户控件？

对控件开发小弟是一窍不通，在网上找了个仿XP侧边栏的菜单，写在窗体里的，各位老师指教一下，如何将它更改成控件呢？
'Download by http://www.codefans.net
Option ExplicitPrivate Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As LongDim OrgHeight As Long
Dim DFI_Height As Long
Dim CWidth As Long
Dim SettingNewWidth As Boolean
Dim Animation As BooleanConst Margin = 15Private Sub chkAnim_Click()
     Animation = CBool(chkAnim.Value)
End SubPrivate Sub Command2_Click()
     CWidth = CInt(txWidth.Text)
     
     DetFrame.Width = CWidth * Screen.TwipsPerPixelX
     
     SettingNewWidth = True
     
     Call FixIt
     Call DetFrame_Resize
     
     SettingNewWidth = False
End SubPrivate Sub Form_Load()
     'DetFrame.BackColor = RGB(117, 152, 227)
     
     Header(0).Tag = 1
     Header(1).Tag = 0
     Header(2).Tag = 1
     Header(3).Tag = 0
     Header(4).Tag = 1
     
     CWidth = 250
     
     DetFrame.Width = CWidth * Screen.TwipsPerPixelX
     
     Animation = CBool(chkAnim.Value)
     
     Call FixIt
     Call DetFrame_Resize
End SubPrivate Sub Form_Resize()
     'DetFrame.Move 0, 0
     'DetFrame.Height = ScaleHeight
End Sub'----- IMPORTANT CODES --------------------------------------------------------
Private Sub Details_Resize(Index As Integer)
     igid(Index).Move 0, 0
     Btn(Index).Left = Details(Index).Width - Btn(Index).Width
     
     Header(Index).Left = igid(0).Width
     Header(Index).Width = Btn(Index).Left
     
     shpFrme(Index).Top = 0 'Header(Index).Top + Header(Index).Height - (1 * Screen.TwipsPerPixelY)
     shpFrme(Index).Left = 0
     shpFrme(Index).Width = Details(Index).ScaleWidth
     shpFrme(Index).Height = Details(Index).ScaleHeight '- shpFrme(Index).Top
End SubPrivate Sub DetFrame_Resize()
     Dim ScrlMax As Long
     Dim i As Integer
     
     'remove the single quote
     'and resizing will slower if your using
     '500mhz Intel Celeron (thats my processor)
     
     'FadeUp.Move 0, 0, DetFrame.ScaleWidth, DetFrame.ScaleHeight
     
     Scroll.Move DetFrame.ScaleWidth - Scroll.Width, 0
     Scroll.Height = DetFrame.ScaleHeight
     
     ScrlMax = ((DetFrmIn.Height + ((Margin * 2) * Screen.TwipsPerPixelY)) - DetFrame.Height)
     
     If InStr(1, CStr(ScrlMax), "-") <> 0 Then
          Scroll.Visible = False
          
          For i = 0 To Details.Count - 1
               Details(i).Width = DetFrame.Width - ((Margin * 2) * Screen.TwipsPerPixelX)
          Next i
     Else
          Scroll.Left = DetFrame.Width - Scroll.Width
          Scroll.Visible = True
          Scroll.Max = ScrlMax
          
          DetFrmIn.Width = DetFrame.ScaleWidth - Scroll.Width - ((Margin * 2) * Screen.TwipsPerPixelX)
          
          For i = 0 To Details.Count - 1
               Details(i).Width = DetFrmIn.Width
          Next i
     End If
          
     DetFrmIn.Move Margin * Screen.TwipsPerPixelX, Margin * Screen.TwipsPerPixelY
     DetFrmIn.Width = Details(0).Width
     DetFrmIn.Height = Details(0).Top + Details(Details.Count - 1).Top + Details(Details.Count - 1).Height
End SubSub FixIt()
     On Error Resume Next 'error message for <Max=I+1> coz array doesnt exist
     Dim i As Integer
     
     Scroll.Move DetFrame.ScaleWidth - Scroll.Width, 0
     Scroll.Height = DetFrame.ScaleHeight
     
     'put them in their proper place
     For i = 0 To Details.Count - 1
          Details(i).Left = 0
          Details(i).Width = DetFrmIn.Width 'CWidth * Screen.TwipsPerPixelX
          
          igid(i).Move 0, 0
          
          Header(i).MousePointer = vbCustom
          Header(i).MouseIcon = LoadResPicture(102, vbResCursor)
          Header(i).Move igid(i).Left + igid(i).Width, 0
          
          Btn(i).Move 0, 0
          Btn(i).MousePointer = vbCustom
          Btn(i).MouseIcon = LoadResPicture(102, vbResCursor)
          
          DetTitle(i).MousePointer = vbCustom
          DetTitle(i).MouseIcon = LoadResPicture(102, vbResCursor)
          
          DetTitle(i).Top = (Header(i).Height - DetTitle(i).Height) \ 2
          DetTitle(i).Left = 12 * Screen.TwipsPerPixelX
          DetTitle(i).ForeColor = vbHighlight
          
          shpFrme(i).Top = Header(i).Top + Header(i).Height - (1 * Screen.TwipsPerPixelY)
          shpFrme(i).Left = 0
          shpFrme(i).Width = Details(i).ScaleWidth
          shpFrme(i).Height = Details(i).ScaleHeight - shpFrme(i).Top
          
          shpFrme(i).ZOrder vbBringToFront
          igid(i).ZOrder vbBringToFront
          Header(i).ZOrder vbBringToFront
          Btn(i).ZOrder vbBringToFront
          DetTitle(i).ZOrder vbBringToFront
          
          If Not SettingNewWidth Then
               If Header(i).Tag = 0 Then
                    Details(i).Tag = Details(i).Height
                    Details(i).Height = Header(i).Height
               
                    Btn(i).Picture = DwnBtn(0).Picture
                    Btn(i).Move Header(i).Left + Header(i).Width, Header(i).Top
               ElseIf Header(i).Tag = 1 Then
                    Btn(i).Picture = UpBtn(0).Picture
                    Btn(i).Move Header(i).Left + Header(i).Width, Header(i).Top
               End If
          End If
          
          Details(i + 1).Top = Details(i).Top + Details(i).Height + (Margin * Screen.TwipsPerPixelY)
          
          Btn(i).Left = Details(i).ScaleWidth - Btn(i).Width
          
          Header(i).Width = Btn(i).Left
          
          DoEvents
     Next i
End Sub

解决方案 »

  1.   

    续上
    [code=Private Sub Btn_Click(Index As Integer)
         Dim r As Integer, i As Integer, stepping As Integer
         Dim ScrlMax As Long
         Dim start, fin
         
         DFI_Height = 0
         
         start = Timer
         
         If Header(Index).Tag = "1" Then
              'save the height of the detials(index) in details(tag)
              ' - were going to use this later or look at the statements <For>..
              '   in <elseif 0>
              Details(Index).Tag = Details(Index).Height
              
              '--- booster ---
              '(try to change the value of stepping to 1 and see the effect.)
              stepping = 1 '(Btn.Count - Index) * Screen.TwipsPerPixelY
              'DetTitle(Index).Caption = stepping
              
              'syncronize (resizing the height and at the same time the
              '            the other Details at the bottom are moving down.)
              
              If Not Animation Then
                   Details(Index).Height = Header(Index).Height
                   
                   'Move up
                   For i = Index + 1 To Details.Count - 1
                        Details(i).Top = Details(i - 1).Top + Details(i - 1).Height + (Margin * Screen.TwipsPerPixelY)
                   Next i
                   
                   DoEvents
              ElseIf Animation Then
                   For r = Details(Index).Height To Header(Index).Height Step -stepping
                        'resize the height
                        Details(Index).Height = r
                   
                        DetFrmIn.Height = Details(0).Top + Details(Details.Count - 1).Top + Details(Details.Count - 1).Height
              
                        'move up
                        For i = Index + 1 To Details.Count - 1
                             Details(i).Top = Details(i - 1).Top + Details(i - 1).Height + (Margin * Screen.TwipsPerPixelY)
                        Next i
                   
                        DoEvents
                   Next r
              End If
              
              Btn(Index).Picture = DwnBtn(0).Picture
              Header(Index).Tag = "0"
         ElseIf Header(Index).Tag = "0" Then
              '--- booster ---
              '(try to change the value of stepping to 1 and see the effect.)
              stepping = 1 '(Btn.Count - Index) * Screen.TwipsPerPixelY
              'DetTitle(Index).Caption = stepping
              
              'syncronize (resizing the height and at the same time the
              '            the other Details at the bottom are moving up.)
              
              If Not Animation Then
                   Details(Index).Height = Details(Index).Tag
                   
                   'move down
                   For i = Index + 1 To Details.Count - 1
                        Details(i).Top = Details(i - 1).Top + Details(i - 1).Height + (Margin * Screen.TwipsPerPixelY)
                   Next i
              ElseIf Animation Then
                   For r = Details(Index).Height To Details(Index).Tag Step stepping
                        'resize the height
                        Details(Index).Height = r
                   
                        DetFrmIn.Height = Details(0).Top + Details(Details.Count - 1).Top + Details(Details.Count - 1).Height
                   
                        'move down
                        For i = Index + 1 To Details.Count - 1
                             Details(i).Top = Details(i - 1).Top + Details(i - 1).Height + (Margin * Screen.TwipsPerPixelY)
                        Next i
                   
                        DoEvents
                   Next r
              End If
              
              Btn(Index).Picture = UpBtn(0).Picture
              Header(Index).Tag = "1"
         End If
         
         Call DetFrame_Resize
         
         fin = Timer
         Caption = "Details View No. " & Index + 1 & ". time: " & Format(fin - start, "0.000")
    End SubPrivate Sub DetTitle_Click(Index As Integer)
         Call Btn_Click(Index)
    End SubPrivate Sub Header_Click(Index As Integer)
         Call Btn_Click(Index)
    End SubPrivate Sub Header_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
         If Header(Index).Tag = "1" Then
              Btn(Index).Picture = UpBtn(1).Picture
         ElseIf Header(Index).Tag = "0" Then
              Btn(Index).Picture = DwnBtn(1).Picture
         End If
         
         DetTitle(Index).ForeColor = vbInactiveTitleBar
    End SubPrivate Sub DetFrame_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
         Dim i As Integer
         
         For i = 0 To Header.Count - 1
              If Header(i).Tag = "1" Then
                   Btn(i).Picture = UpBtn(0).Picture
              ElseIf Header(i).Tag = "0" Then
                   Btn(i).Picture = DwnBtn(0).Picture
              End If
              
              DetTitle(i).ForeColor = vbHighlight
         Next i
    End SubPrivate Sub Btn_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
         Call Header_MouseMove(Index, Button, Shift, x, y)
    End SubPrivate Sub DetFrmIn_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
         Call DetFrame_MouseMove(Button, Shift, x, y)
    End SubPrivate Sub Details_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
         Call DetFrame_MouseMove(Button, Shift, x, y)
    End SubPrivate Sub Scroll_Change()
         Call Scroll_Scroll
    End SubPrivate Sub Scroll_Scroll()
         DetFrmIn.Top = (Margin * Screen.TwipsPerPixelY) + -Scroll.Value
    End SubPrivate Sub txWidth_Change()
         If txWidth.Text <> vbNullString Then
              If CInt(txWidth.Text) < 200 Then txWidth.Text = 200
         End If
    End SubVB][/code]
      

  2.   


    Private Sub Btn_Click(Index As Integer)
         Dim r As Integer, i As Integer, stepping As Integer
         Dim ScrlMax As Long
         Dim start, fin
         
         DFI_Height = 0
         
         start = Timer
         
         If Header(Index).Tag = "1" Then
              'save the height of the detials(index) in details(tag)
              ' - were going to use this later or look at the statements <For>..
              '   in <elseif 0>
              Details(Index).Tag = Details(Index).Height
              
              '--- booster ---
              '(try to change the value of stepping to 1 and see the effect.)
              stepping = 1 '(Btn.Count - Index) * Screen.TwipsPerPixelY
              'DetTitle(Index).Caption = stepping
              
              'syncronize (resizing the height and at the same time the
              '            the other Details at the bottom are moving down.)
              
              If Not Animation Then
                   Details(Index).Height = Header(Index).Height
                   
                   'Move up
                   For i = Index + 1 To Details.Count - 1
                        Details(i).Top = Details(i - 1).Top + Details(i - 1).Height + (Margin * Screen.TwipsPerPixelY)
                   Next i
                   
                   DoEvents
              ElseIf Animation Then
                   For r = Details(Index).Height To Header(Index).Height Step -stepping
                        'resize the height
                        Details(Index).Height = r
                   
                        DetFrmIn.Height = Details(0).Top + Details(Details.Count - 1).Top + Details(Details.Count - 1).Height
              
                        'move up
                        For i = Index + 1 To Details.Count - 1
                             Details(i).Top = Details(i - 1).Top + Details(i - 1).Height + (Margin * Screen.TwipsPerPixelY)
                        Next i
                   
                        DoEvents
                   Next r
              End If
              
              Btn(Index).Picture = DwnBtn(0).Picture
              Header(Index).Tag = "0"
         ElseIf Header(Index).Tag = "0" Then
              '--- booster ---
              '(try to change the value of stepping to 1 and see the effect.)
              stepping = 1 '(Btn.Count - Index) * Screen.TwipsPerPixelY
              'DetTitle(Index).Caption = stepping
              
              'syncronize (resizing the height and at the same time the
              '            the other Details at the bottom are moving up.)
              
              If Not Animation Then
                   Details(Index).Height = Details(Index).Tag
                   
                   'move down
                   For i = Index + 1 To Details.Count - 1
                        Details(i).Top = Details(i - 1).Top + Details(i - 1).Height + (Margin * Screen.TwipsPerPixelY)
                   Next i
              ElseIf Animation Then
                   For r = Details(Index).Height To Details(Index).Tag Step stepping
                        'resize the height
                        Details(Index).Height = r
                   
                        DetFrmIn.Height = Details(0).Top + Details(Details.Count - 1).Top + Details(Details.Count - 1).Height
                   
                        'move down
                        For i = Index + 1 To Details.Count - 1
                             Details(i).Top = Details(i - 1).Top + Details(i - 1).Height + (Margin * Screen.TwipsPerPixelY)
                        Next i
                   
                        DoEvents
                   Next r
              End If
              
              Btn(Index).Picture = UpBtn(0).Picture
              Header(Index).Tag = "1"
         End If
         
         Call DetFrame_Resize
         
         fin = Timer
         Caption = "Details View No. " & Index + 1 & ". time: " & Format(fin - start, "0.000")
    End SubPrivate Sub DetTitle_Click(Index As Integer)
         Call Btn_Click(Index)
    End SubPrivate Sub Header_Click(Index As Integer)
         Call Btn_Click(Index)
    End SubPrivate Sub Header_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
         If Header(Index).Tag = "1" Then
              Btn(Index).Picture = UpBtn(1).Picture
         ElseIf Header(Index).Tag = "0" Then
              Btn(Index).Picture = DwnBtn(1).Picture
         End If
         
         DetTitle(Index).ForeColor = vbInactiveTitleBar
    End SubPrivate Sub DetFrame_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
         Dim i As Integer
         
         For i = 0 To Header.Count - 1
              If Header(i).Tag = "1" Then
                   Btn(i).Picture = UpBtn(0).Picture
              ElseIf Header(i).Tag = "0" Then
                   Btn(i).Picture = DwnBtn(0).Picture
              End If
              
              DetTitle(i).ForeColor = vbHighlight
         Next i
    End SubPrivate Sub Btn_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
         Call Header_MouseMove(Index, Button, Shift, x, y)
    End SubPrivate Sub DetFrmIn_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
         Call DetFrame_MouseMove(Button, Shift, x, y)
    End SubPrivate Sub Details_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
         Call DetFrame_MouseMove(Button, Shift, x, y)
    End SubPrivate Sub Scroll_Change()
         Call Scroll_Scroll
    End SubPrivate Sub Scroll_Scroll()
         DetFrmIn.Top = (Margin * Screen.TwipsPerPixelY) + -Scroll.Value
    End SubPrivate Sub txWidth_Change()
         If txWidth.Text <> vbNullString Then
              If CInt(txWidth.Text) < 200 Then txWidth.Text = 200
         End If
    End Sub
      

  3.   


    这样就启动了ActiveX控件设计器，按照窗体的控件布局在控件设计器上照搬一遍，再把代码复制过去，基本就差不多了，因为不知道你的界面怎么样，你又想实现什么功能，所以很难说。