VB移动及改变无标题窗体的大小(二)

这篇博客介绍了如何在VB6中通过设置窗体BorderStyle属性和使用API函数实现窗体的自由拖拽与边界缩放。通过捕获鼠标、设置鼠标指针样式以及判断鼠标位置,用户可以自由调整窗体大小,提供了详细的代码实现过程。
摘要由CSDN通过智能技术生成

在这里插入图片描述

先将窗体的BorderStyle属性值设为0,然后添加一个标准模块,模块代码如下:
Option Explicit
'将鼠标捕获设置到指定的窗口。在鼠标按钮按下的时候,这个窗口会为当前应用程序或整个系统接收所有鼠标输入.
Private Declare Function SetCapture Lib “user32” (ByVal hwnd As Long) As Long
'为当前的应用程序释放鼠标捕获.
Public Declare Function ReleaseCapture Lib “user32” () As Long
'获取窗体焦点
Private Declare Function GetActiveWindow Lib “user32” () As Long
'获得的坐标
Private Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
'窗体四边四角按下的状态
Public LWTH As Long
'鼠标按下获取窗体的当前位置
Dim LW1 As Long, LW2 As Long, TH1 As Long, TH2 As Long
'边框预留的宽度位置(鼠标经过时显示样式)
Const Smove = 50

'获取鼠标的坐标位置
Private Function PrintCursorPos() As POINTAPI
Dim dl As Long
Dim MyPoint As POINTAPI
dl& = GetCursorPos(MyPoint)
PrintCursorPos.X = Str(MyPoint.X) * 15
PrintCursorPos.Y = Str(MyPoint.Y) * 15
End Function

'MovForm函数(窗体,鼠标状态,鼠标在窗体的X值,鼠标在窗体的Y值,窗口宽度收缩最小限制值,窗口高度收缩最小限制值,)
Public Sub MoveForm(FormMe As Form, Button As Integer, X As Single, Y As Single, Optional FormWidth As Long = 2000, Optional FormHeight As Long = 500, Optional DM As Long = 0)
'If GetActiveWindow <> FormMe.hwnd Then Screen.MousePointer = vbDefault: DM = 0: Exit Sub '窗体失去焦点时拦截以下操作
'将鼠标捕获设置到指定的窗口
SetCapture FormMe.hwnd
If Button = 1 And DM = 1 Then
LW1 = FormMe.Left
LW2 = FormMe.Left + FormMe.Width
TH1 = FormMe.Top
TH2 = FormMe.Top + FormMe.Height
ElseIf Button = 1 And DM = 2 Then '鼠标弹起
Screen.MousePointer = vbDefault: DM = 0: ReleaseCapture '释放鼠标
End If
If LWTH <> 0 Then DoEvents '转让控制权,让操作系统处理其它的事件(如果忽略窗体控件会很闪)
'当鼠标经过窗口边框时的鼠标样式
Select Case True
Case (X < Smove And Y < Smove) Or (Y < Smove And X < Smove) '左上角
If Button <> 1 Then Screen.MousePointer = vbSizeNWSE
If DM = 1 Then LWTH = 1
Case (X < Smove And Y > FormMe.ScaleHeight - Smove) Or (Y > FormMe.ScaleHeight - Smove And X < Smove) '左下角
If Button <> 1 Then Screen.MousePointer = vbSizeNESW
If DM = 1 Then LWTH = 2
Case (X > FormMe.ScaleWidth - Smove And Y < Smove) Or (Y < Smove And X > FormMe.ScaleWidth - Smove) '右上角
If Button <> 1 Then Screen.MousePointer = vbSizeNESW
If DM = 1 Then LWTH = 3
Case (X > FormMe.ScaleWidth - Smove And Y > FormMe.ScaleHeight - Smove) Or (Y > FormMe.ScaleHeight - Smove And X > FormMe.ScaleWidth - Smove) '右下角
If Button <> 1 Then Screen.MousePointer = vbSizeNWSE
If DM = 1 Then LWTH = 4
Case (X < Smove Or X > FormMe.ScaleWidth - Smove) '左右
If Button <> 1 Then Screen.MousePointer = vbSizeWE
If DM = 1 Then LWTH = IIf(X > 0 And X < Smove, 5, IIf(X > FormMe.ScaleWidth - Smove, 6, 5))
Case (Y < Smove Or Y > FormMe.ScaleHeight - Smove) '上下
If Button <> 1 Then Screen.MousePointer = vbSizeNS
If DM = 1 Then LWTH = IIf(Y > 0 And Y < Smove, 7, IIf(Y > FormMe.ScaleHeight - Smove, 8, 7))
Case Else
If Button <> 1 Then Screen.MousePointer = vbDefault: LWTH = 0: ReleaseCapture '释放鼠标
End Select
'当鼠标松开且不在窗口内时
If Button <> 1 And (X < 0 Or X > FormMe.Width Or Y < 0 Or Y > FormMe.Height) Then Screen.MousePointer = vbDefault: DM = 0: ReleaseCapture '释放鼠标
'改变窗口大小
If Button = 1 Then
Select Case LWTH
Case 1 '左上角
FormMe.Move IIf((LW2 - PrintCursorPos.X) > 0 And (LW2 - PrintCursorPos.X) > FormWidth, PrintCursorPos.X, LW2 - FormWidth), IIf((TH2 - PrintCursorPos.Y) > 0 And (TH2 - PrintCursorPos.Y) > FormHeight, PrintCursorPos.Y, TH2 - FormHeight), LW2 - FormMe.Left, TH2 - FormMe.Top
Case 2 '左下角
FormMe.Move IIf((LW2 - PrintCursorPos.X) > 0 And (LW2 - PrintCursorPos.X) > FormWidth, PrintCursorPos.X, LW2 - FormWidth), TH1, LW2 - FormMe.Left, IIf(PrintCursorPos.Y - TH1 > FormHeight, PrintCursorPos.Y - TH1, FormMe.Height)
Case 3 '右上角
FormMe.Move LW1, IIf((TH2 - PrintCursorPos.Y) > 0 And (TH2 - PrintCursorPos.Y) > FormHeight, PrintCursorPos.Y, TH2 - FormHeight), IIf(PrintCursorPos.X - LW1 > FormWidth, PrintCursorPos.X - LW1, FormMe.Width), IIf(FormMe.Height + Y > FormHeight, TH2 - FormMe.Top, FormMe.Height)
Case 4 '右下角
FormMe.Move LW1, TH1, IIf(PrintCursorPos.X - LW1 > FormWidth, PrintCursorPos.X - LW1, FormMe.Width), IIf(PrintCursorPos.Y - TH1 > FormHeight, PrintCursorPos.Y - TH1, FormMe.Height)
Case 5 '左拉
FormMe.Move IIf((LW2 - PrintCursorPos.X) > 0 And (LW2 - PrintCursorPos.X) > FormWidth, PrintCursorPos.X, LW2 - FormWidth), TH1, LW2 - FormMe.Left
Case 6 '右拉
FormMe.Move LW1, TH1, IIf(PrintCursorPos.X - LW1 > FormWidth, PrintCursorPos.X - LW1, FormMe.Width)
Case 7 '上拉
FormMe.Move LW1, IIf((TH2 - PrintCursorPos.Y) > 0 And (TH2 - PrintCursorPos.Y) > FormHeight, PrintCursorPos.Y, TH2 - FormHeight), FormMe.Width, TH2 - FormMe.Top
Case 8 '下拉
FormMe.Move LW1, TH1, FormMe.Width, IIf(PrintCursorPos.Y - TH1 > FormHeight, PrintCursorPos.Y - TH1, FormMe.Height)
End Select
Else
LWTH = 0
End If
End Sub
'-----------------------------------------------------------------------------------------------------------------
窗体代码如下:
Option Explicit
Dim Xl As Single, Yt As Single '获得鼠标在对象的坐标

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MoveForm(Me, Button, X, Y, , , 1)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'当鼠标按住并移动时改变窗体位置
If Button = 1 And LWTH = 0 Then
Me.Move Me.Left + (X - Xl), Me.Top + (Y - Yt)
Else
Xl = X: Yt = Y
End If
'鼠标单击窗体四边四角时改变窗口大小
Call MoveForm(Me, Button, X, Y)
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'当鼠标弹起后将鼠标样式设为常规样式
Call MoveForm(Me, Button, X, Y, , , 2)
End Sub

Private Sub Form_Resize()
Me.Cls
Me.Line (50, 500)-(Me.ScaleWidth - 50, Me.ScaleHeight - 50), RGB(255, 255, 255), BF
End Sub

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

键盘上的舞指

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值