用过SQL Server视图设计或Access查询设计的都见过这样的控件，控件外形象一个窗体，有边框、标题栏、图标、关闭按钮，可拖动、改变大小等等
我前一段时间在做一个自定义查询，想把界面做成象SQL Server的设计视图那样，终于在MSDN里面找到了一些资料
MSDN的一些URL（把msdn的安装路径改成你自己的路径）：
mk:@MSITStore:d:/Program Files/Microsoft Visual Studio/MSDN/2001JAN/1033/winui.chm::/hh/winui/mousinpt_7ik4.htm
mk:@MSITStore:d:/Program Files/Microsoft Visual Studio/MSDN/2001JAN/1033/winui.chm::/hh/winui/mousinpt_6085.htm
一、添加一个User Control，控件结构如下
VERSION 5.00Begin VB.UserControl TableView AutoRedraw = -1 'True ClientHeight = 4260 ClientLeft = 0 ClientTop = 0 ClientWidth = 3855 EditAtDesignTime= -1 'True KeyPreview = -1 'True ScaleHeight = 4260 ScaleWidth = 3855 Begin VB.PictureBox picTitle BackColor = &H80000003& BorderStyle = 0 'None Height = 315 Left = 120 ScaleHeight = 315 ScaleWidth = 2715 TabIndex = 1 Top = 120 Width = 2715 Begin VB.Image imgClose Height = 210 Index = 1 Left = 2400 Picture = "TableView.ctx":0000 Top = 0 Width = 240 End Begin VB.Image imgTitle Height = 180 Left = 60 Picture = "TableView.ctx":02E2 Top = 60 Width = 180 End Begin VB.Image imgClose Height = 210 Index = 0 Left = 1560 Picture = "TableView.ctx":04D4 Top = 0 Width = 240 End Begin VB.Label lblTitle BackColor = &H80000003& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H8000000F& Height = 255 Left = 240 TabIndex = 3 Top = 120 Width = 1995 End End Begin VB.ListBox lstColumn Height = 1275 IntegralHeight = 0 'False ItemData = "TableView.ctx":07B6 Left = 360 List = "TableView.ctx":07B8 OLEDragMode = 1 'Automatic OLEDropMode = 1 'Manual Style = 1 'Checkbox TabIndex = 0 TabStop = 0 'False Top = 600 Width = 2175 End Begin VB.CommandButton cmdBack Height = 2655 Left = 0 TabIndex = 2 TabStop = 0 'False Top = 0 Width = 2895 EndEndAttribute VB_Name = "TableView"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = TrueAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = False
二、声明
' WM_NCHITTEST and MOUSEHOOKSTRUCT Mouse Position CodesConst HTERROR = (-2)Const HTTRANSPARENT = (-1)Const HTNOWHERE = 0Const HTCLIENT = 1Const HTCAPTION = 2Const HTSYSMENU = 3Const HTGROWBOX = 4Const HTSIZE = HTGROWBOXConst HTMENU = 5Const HTHSCROLL = 6Const HTVSCROLL = 7Const HTMINBUTTON = 8Const HTMAXBUTTON = 9Const HTLEFT = 10Const HTRIGHT = 11Const HTTOP = 12Const HTTOPLEFT = 13Const HTTOPRIGHT = 14Const HTBOTTOM = 15Const HTBOTTOMLEFT = 16Const HTBOTTOMRIGHT = 17Const HTBORDER = 18Const HTREDUCE = HTMINBUTTONConst HTZOOM = HTMAXBUTTONConst HTSIZEFIRST = HTLEFTConst HTSIZELAST = HTBOTTOMRIGHT
Const WM_SIZE = &H5
Const WM_NCLBUTTONDOWN = &HA1Const HTCAPTION = 2Const WM_CLOSE = &H10
Const WM_LBUTTONDOWN = &H201Const MK_LBUTTON = &H1Const WM_MOUSEMOVE = &H200Private Declare Function ReleaseCapture Lib "user32" () As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
三、代码
'拖动Private Sub picTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then ReleaseCapture SendMessage UserControl.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0& End IfEnd Sub
Private Sub UserControl_Resize() On Error Resume Next CloseBt = True cmdBack.left = 0 cmdBack.width = UserControl.width cmdBack.top = 0 cmdBack.height = UserControl.height picTitle.left = 60 picTitle.top = 60 picTitle.width = UserControl.width - 150 picTitle.height = 255 imgClose(0).top = 30 imgClose(0).left = picTitle.width - 240 imgClose(0).Visible = CloseBt imgClose(1).top = 30 imgClose(1).left = picTitle.width - 240 imgClose(1).Visible = (Not CloseBt) lstColumn.left = 60 lstColumn.top = picTitle.height + 60 lstColumn.width = UserControl.width - lstColumn.left - 60 lstColumn.height = UserControl.height - lstColumn.top - 60 lblTitle.top = 60 lblTitle.left = 300 lblTitle.width = picTitle.width - 720End SubPrivate Sub cmdBack_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim mvDir As Integer If Button <> 1 Then Exit Sub ReleaseCapture If (X <= 60 And Y <= 60) Then mvDir = HTTOPLEFT ElseIf (cmdBack.width - X <= 60 And cmdBack.height - Y <= 60) Then mvDir = HTBOTTOMRIGHT ElseIf (X <= 60 And cmdBack.height - Y <= 60) Then mvDir = HTBOTTOMLEFT ElseIf (Y <= 60 And cmdBack.width - X <= 60) Then mvDir = HTTOPRIGHT ElseIf Y <= 60 And X > 60 And cmdBack.width - X > 60 Then mvDir = HTTOP ElseIf cmdBack.height - Y <= 60 And X > 60 And cmdBack.width - X > 60 Then mvDir = HTBOTTOM ElseIf X <= 60 And Y > 60 And cmdBack.height - Y > 60 Then mvDir = HTLEFT ElseIf cmdBack.width - X <= 60 And Y > 60 And cmdBack.height - Y > 60 Then mvDir = HTRIGHT End If SendMessage UserControl.hwnd, WM_NCLBUTTONDOWN, mvDir, 0& SendMessage UserControl.hwnd, WM_SIZE, 0, 0 UserControl_Resize lstColumn.SetFocusEnd Sub
Private Sub cmdBack_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If (X <= 60 And Y <= 60) Then cmdBack.MousePointer = 8 ElseIf (cmdBack.width - X <= 60 And cmdBack.height - Y <= 60) Then cmdBack.MousePointer = 8 ElseIf (X <= 60 And cmdBack.height - Y <= 60) Then cmdBack.MousePointer = 6 ElseIf (Y <= 60 And cmdBack.width - X <= 60) Then cmdBack.MousePointer = 6 ElseIf Y <= 60 And X > 60 And cmdBack.width - X > 60 Then cmdBack.MousePointer = 7 ElseIf cmdBack.height - Y <= 60 And X > 60 And cmdBack.width - X > 60 Then cmdBack.MousePointer = 7 ElseIf X <= 60 And Y > 60 And cmdBack.height - Y > 60 Then cmdBack.MousePointer = 9 ElseIf cmdBack.width - X <= 60 And Y > 60 And cmdBack.height - Y > 60 Then cmdBack.MousePointer = 9 End IfEnd Sub
