如何模拟一个象窗体一样的控件(标题栏、焦点、拖动、
2008-05-01 05:39
423 查看
用过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
我前一段时间在做一个自定义查询,想把界面做成象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
相关文章推荐
- 如何遍历一个窗体中的某一种控件 c#实现
- js如何判断一个控件是否获得焦点
- C#如何在Form启动时控制焦点落在某一个控件上?
- 【Android】如何让一个控件能主动获取到焦点
- C# winform中一个类中如何调用另一个窗体的控件或方法
- 如何遍历一个窗体中的某一种控件 c#实现
- 如何在一个窗体中加载另一个窗体上的控件?
- C#如何在Form启动时控制焦点落在某一个控件上?
- 来自MSDN的一个Sample:如何自定义 Windows 窗体 DataGridView 控件中的数据格式设置
- 如何防止拖动窗体大小时控件闪烁的问题
- 如何安全地跨窗体调用Timer控件 从一个窗体调用控制另外一个窗体的控件
- MFC 客户区 模拟标题栏 功能 ,实现窗体拖动
- Qt 如何把一个按钮控件放在窗体的左上脚
- 如何实现能像windows 窗体一样改变大小的控件 Silverlight
- 【Android】如何让一个控件能主动获取到焦点
- 如何在一个窗体中调用另一个窗体的控件或方法
- 用C#如何遍历一个窗体中的某一种控件
- 如何把一个窗体添加到容器控件中
- [Gabriel的专栏] 用C#如何遍历一个窗体中的某一种控件
- C# winform中一个类中如何调用另一个窗体的控件或方法