如何模拟一个象窗体一样的控件（标题栏、焦点、拖动、

来源：互联网发布：焊接仿真软件对比编辑：程序博客网时间：2024/05/01 22:30

用过SQL Server视图设计或Access查询设计的都见过这样的控件，控件外形象一个窗体，有边框、标题栏、图标、关闭按钮，可拖动、改变大小等等

我前一段时间在做一个自定义查询，想把界面做成象SQL Server的设计视图那样，终于在MSDN里面找到了一些资料

MSDN的一些URL（把msdn的安装路径改成你自己的路径）：

mk:@MSITStore:d:Program%20FilesMicrosoft%20Visual%20StudioMSDN2001JAN1033winui.chm::/hh/winui/mousinpt_7ik4.htm

mk:@MSITStore:d:Program%20FilesMicrosoft%20Visual%20StudioMSDN2001JAN1033winui.chm::/hh/winui/mousinpt_6085.htm

一、添加一个User Control，控件结构如下

VERSION 5.00
Begin 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
   End
End
Attribute VB_Name = "TableView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

二、声明

' WM_NCHITTEST and MOUSEHOOKSTRUCT Mouse Position Codes
Const HTERROR = (-2)
Const HTTRANSPARENT = (-1)
Const HTNOWHERE = 0
Const HTCLIENT = 1
Const HTCAPTION = 2
Const HTSYSMENU = 3
Const HTGROWBOX = 4
Const HTSIZE = HTGROWBOX
Const HTMENU = 5
Const HTHSCROLL = 6
Const HTVSCROLL = 7
Const HTMINBUTTON = 8
Const HTMAXBUTTON = 9
Const HTLEFT = 10
Const HTRIGHT = 11
Const HTTOP = 12
Const HTTOPLEFT = 13
Const HTTOPRIGHT = 14
Const HTBOTTOM = 15
Const HTBOTTOMLEFT = 16
Const HTBOTTOMRIGHT = 17
Const HTBORDER = 18
Const HTREDUCE = HTMINBUTTON
Const HTZOOM = HTMAXBUTTON
Const HTSIZEFIRST = HTLEFT
Const HTSIZELAST = HTBOTTOMRIGHT

Const WM_SIZE = &H5

Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Const WM_CLOSE = &H10

Const WM_LBUTTONDOWN = &H201
Const MK_LBUTTON = &H1
Const WM_MOUSEMOVE = &H200
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private 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 If
End 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 - 720
End Sub
Private 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.SetFocus
End 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 If
End Sub