VB运行中实现用鼠标调节控件大小
VB运行中如何实现用鼠标调节控件大小.如Text1与Label交界的边缘,拖动可以按比例改变两者大小.以及text1与text2相接近的边缘,拖动可以按比例改变两者大小....
VB运行中如何实现用鼠标调节控件大小.
如Text1与Label交界的边缘,拖动可以按比例改变两者大小.
以及text1与text2相接近的边缘,拖动可以按比例改变两者大小.
求源代码.
谢谢.
用的是VB6.
无聊耍耍酷,你的方法好像不行,可以详细说明添加什么吗?> 展开
如Text1与Label交界的边缘,拖动可以按比例改变两者大小.
以及text1与text2相接近的边缘,拖动可以按比例改变两者大小.
求源代码.
谢谢.
用的是VB6.
无聊耍耍酷,你的方法好像不行,可以详细说明添加什么吗?> 展开
5个回答
展开全部
这是用鼠标调节的List和Textbox,改一下就成你的代码了
ListLeft,Splitter,TextRight 3个控件
Option Explicit
'variable to hold the width of the spltter bar
Private Const SPLT_WDTH As Integer = 3
'variable to hold the last-sized postion
Private currSplitPosX As Long
'variable to hold the horizontal and vertical offsets of the 2 controls
Dim CTRL_OFFSET As Integer
'variable to hold the Splitter bar colour
Dim SPLT_COLOUR As Long
Private Sub Form_Load()
'set the startup variables
CTRL_OFFSET = 5
SPLT_COLOUR = &H808080
'set the current splitter bar position to an arbitrary value that will always be outside
'the possibe range. This allows us to check for movement of the spltter bar in subsequent
'mousexxx subs.
currSplitPosX = &H7FFFFFFF
ListLeft.AddItem "列表项 1"
ListLeft.AddItem "列表项 2"
ListLeft.AddItem "列表项 3"
ListLeft.AddItem "列表项 4"
ListLeft.AddItem "列表项 5"
'note: VB3 users will need to substitute Chr$(13) & chr$(10) for the VB4 constant vbCrLf in the sentence below.
TextRight = "在一些流行的应用程序中,经常见到窗体上有二个相邻的列表框,可以用鼠标任意拉动中间分割条,改变列表框大小。"
End Sub
Private Sub Form_Resize()
Dim x1 As Integer
Dim x2 As Integer
Dim height1 As Integer
Dim width1 As Integer
Dim width2 As Integer
On Error Resume Next
'set the height of the controls
height1 = ScaleHeight - (CTRL_OFFSET * 2)
x1 = CTRL_OFFSET
width1 = ListLeft.Width
x2 = x1 + ListLeft.Width + SPLT_WDTH - 1
width2 = ScaleWidth - x2 - CTRL_OFFSET
'move the left list
ListLeft.Move x1% - 1, CTRL_OFFSET, width1, height1
'move the right list
TextRight.Move x2, CTRL_OFFSET, width2 + 1, height1
'move the splitter bar
Splitter.Move x1 + ListLeft.Width - 1, CTRL_OFFSET, SPLT_WDTH, height1
End Sub
Private Sub Splitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
'change the splitter colour
Splitter.BackColor = SPLT_COLOUR
'set the current position to x
currSplitPosX = CLng(X)
Else
'not the left button, so... if the current position <> default, cause a mouseup
If currSplitPosX <> &H7FFFFFFF Then Splitter_MouseUp Button, Shift, X, Y
'set the current position to the default value
currSplitPosX = &H7FFFFFFF
End If
End Sub
Private Sub Splitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'if the splitter has been moved...
If currSplitPosX& <> &H7FFFFFFF Then
'if the current position <> default, reposition the splitter and set this as the current value
If CLng(X) <> currSplitPosX Then
Splitter.Move Splitter.Left + X, CTRL_OFFSET, SPLT_WDTH, ScaleHeight - (CTRL_OFFSET * 2)
currSplitPosX = CLng(X)
End If
End If
End Sub
Private Sub Splitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'if the splitter has been moved...
If currSplitPosX <> &H7FFFFFFF Then
'if the current postition <> the last position do a final move of the splitter
If CLng(X) <> currSplitPosX Then
Splitter.Move Splitter.Left + X, CTRL_OFFSET, SPLT_WDTH, ScaleHeight - (CTRL_OFFSET * 2)
End If
'call this the default position
currSplitPosX = &H7FFFFFFF
'restore the normal splitter colour
Splitter.BackColor = &H8000000F
'and check for valid sizings.
'Either enforce the default minimum & maximum widths for the left list, or, if within range, set the width
If Splitter.Left > 60 And Splitter.Left < (ScaleWidth - 60) Then
ListLeft.Width = Splitter.Left - ListLeft.Left 'the pane is within range
ElseIf Splitter.Left < 60 Then 'the pane is too small
ListLeft.Width = 60
Else
ListLeft.Width = ScaleWidth - 60 'the pane is too wide
End If
'reposition both lists, and the splitter bar
Form_Resize
End If
End Sub
ListLeft,Splitter,TextRight 3个控件
Option Explicit
'variable to hold the width of the spltter bar
Private Const SPLT_WDTH As Integer = 3
'variable to hold the last-sized postion
Private currSplitPosX As Long
'variable to hold the horizontal and vertical offsets of the 2 controls
Dim CTRL_OFFSET As Integer
'variable to hold the Splitter bar colour
Dim SPLT_COLOUR As Long
Private Sub Form_Load()
'set the startup variables
CTRL_OFFSET = 5
SPLT_COLOUR = &H808080
'set the current splitter bar position to an arbitrary value that will always be outside
'the possibe range. This allows us to check for movement of the spltter bar in subsequent
'mousexxx subs.
currSplitPosX = &H7FFFFFFF
ListLeft.AddItem "列表项 1"
ListLeft.AddItem "列表项 2"
ListLeft.AddItem "列表项 3"
ListLeft.AddItem "列表项 4"
ListLeft.AddItem "列表项 5"
'note: VB3 users will need to substitute Chr$(13) & chr$(10) for the VB4 constant vbCrLf in the sentence below.
TextRight = "在一些流行的应用程序中,经常见到窗体上有二个相邻的列表框,可以用鼠标任意拉动中间分割条,改变列表框大小。"
End Sub
Private Sub Form_Resize()
Dim x1 As Integer
Dim x2 As Integer
Dim height1 As Integer
Dim width1 As Integer
Dim width2 As Integer
On Error Resume Next
'set the height of the controls
height1 = ScaleHeight - (CTRL_OFFSET * 2)
x1 = CTRL_OFFSET
width1 = ListLeft.Width
x2 = x1 + ListLeft.Width + SPLT_WDTH - 1
width2 = ScaleWidth - x2 - CTRL_OFFSET
'move the left list
ListLeft.Move x1% - 1, CTRL_OFFSET, width1, height1
'move the right list
TextRight.Move x2, CTRL_OFFSET, width2 + 1, height1
'move the splitter bar
Splitter.Move x1 + ListLeft.Width - 1, CTRL_OFFSET, SPLT_WDTH, height1
End Sub
Private Sub Splitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
'change the splitter colour
Splitter.BackColor = SPLT_COLOUR
'set the current position to x
currSplitPosX = CLng(X)
Else
'not the left button, so... if the current position <> default, cause a mouseup
If currSplitPosX <> &H7FFFFFFF Then Splitter_MouseUp Button, Shift, X, Y
'set the current position to the default value
currSplitPosX = &H7FFFFFFF
End If
End Sub
Private Sub Splitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'if the splitter has been moved...
If currSplitPosX& <> &H7FFFFFFF Then
'if the current position <> default, reposition the splitter and set this as the current value
If CLng(X) <> currSplitPosX Then
Splitter.Move Splitter.Left + X, CTRL_OFFSET, SPLT_WDTH, ScaleHeight - (CTRL_OFFSET * 2)
currSplitPosX = CLng(X)
End If
End If
End Sub
Private Sub Splitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'if the splitter has been moved...
If currSplitPosX <> &H7FFFFFFF Then
'if the current postition <> the last position do a final move of the splitter
If CLng(X) <> currSplitPosX Then
Splitter.Move Splitter.Left + X, CTRL_OFFSET, SPLT_WDTH, ScaleHeight - (CTRL_OFFSET * 2)
End If
'call this the default position
currSplitPosX = &H7FFFFFFF
'restore the normal splitter colour
Splitter.BackColor = &H8000000F
'and check for valid sizings.
'Either enforce the default minimum & maximum widths for the left list, or, if within range, set the width
If Splitter.Left > 60 And Splitter.Left < (ScaleWidth - 60) Then
ListLeft.Width = Splitter.Left - ListLeft.Left 'the pane is within range
ElseIf Splitter.Left < 60 Then 'the pane is too small
ListLeft.Width = 60
Else
ListLeft.Width = ScaleWidth - 60 'the pane is too wide
End If
'reposition both lists, and the splitter bar
Form_Resize
End If
End Sub
微测检测5.10
2023-05-10 广告
2023-05-10 广告
您好!建议咨 深圳市微测检测有限公司,已建立起十余个专业实验室,企业通过微测检测就可以获得一站式的测试与认 证解决方案;(EMC、RF、MFi、BQB、QI、USB、安全、锂电池、快充、汽车电子EMC、汽车手机互 联、语音通话质量),认证遇...
点击进入详情页
本回答由微测检测5.10提供
展开全部
Dim a As Boolean
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X > Picture1.Width - 150 And X < Picture1.Width Then
a = True
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If a = True Then
Picture1.Width = X
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
a = False
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X > Picture1.Width - 150 And X < Picture1.Width Then
a = True
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If a = True Then
Picture1.Width = X
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
a = False
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
用API函数得到,鼠标位置,如果在控件边沿就双向箭头,然后在,控件的鼠标按下事件中,改变控件大小.
Private Sub picture1_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move X, Y
End Sub
Private Sub picture1_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move X, Y
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
给你个思路吧,分就随便了,用鼠标的事件触发控件长宽的改变
vb6 也有默认的鼠标事件的,下拉框里选一下就自动出来的
vb6 也有默认的鼠标事件的,下拉框里选一下就自动出来的
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
给你个思路吧,分就随便了
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询