It has seen such controls for the SQL Server view design or Access query design, and the control of the control is a form, there is a border, title bar, icon, shutdown button, drag, change, etc.
I was doing a custom query for a long time, I want to make the interface as the design view of SQL Server, I finally found some information in MSDN.
Some URLs of MSDN (change the MSDN installation path to your own path):
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
First, add a USER Control, the control structure is as follows
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 II Statement
'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 = HTBOTTOMRIGHTConst 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
Third, code
'Drag 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 kil = 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 SubPrivate 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 Ten cmdback.mousepointer = 7 elseif cmdback.Height - Y <= 60 and x> 60 And cmdback.width - x> 60 Ten 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
