读书人

无际框自绘界面,拖拉窗体大小

发布时间: 2012-12-17 09:31:40 作者: rapoo

无边框自绘界面,拖拉窗体大小!
当Borderstyle=None 时

我用图片控件画的界面,但窗体上下左右都使用了图片界面,完全挡住窗体了,

请教如何实现 拖拉窗体大小,

网上找了好几个代码,可以拖拉窗体大小 ,但当窗体四边都布满图件控件挡住,就不行了,

请指点,谢谢!

下面是我的拖拉窗体大小代码

Option Explicit

Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Const HTTOP = 12
Private Const HTBOTTOM = 15
Private Const HTTOPLEFT = 13
Private Const HTTOPRIGHT = 14
Private Const HTBOTTOMLEFT = 16
Private Const HTBOTTOMRIGHT = 17

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 PicSize(X As Single, Y As Single)
'改变画布的大小+++++++++++++++
Dim nParam As Long

With Me
If X > 0 And X < 3 Then
nParam = HTLEFT
End If

If X > .ScaleWidth - 3 And X < .ScaleWidth Then
nParam = HTRIGHT
End If

If Y > 0 And Y < 3 Then
nParam = HTTOP
End If

If Y > .ScaleHeight - 4 And Y < .ScaleHeight Then
nParam = HTBOTTOM
End If

If X > 0 And X < 4 And Y > 0 And Y < 4 Then
nParam = HTTOPLEFT
End If

If X > .ScaleWidth - 4 And X < .ScaleWidth And Y > 0 And Y < 4 Then
nParam = HTTOPRIGHT
End If

If X > 0 And X < 4 And Y > .ScaleHeight - 4 And Y < .ScaleHeight Then
nParam = HTBOTTOMLEFT
End If

If X > .ScaleWidth - 4 And X < .ScaleWidth And Y > .ScaleHeight - 4 And Y < .ScaleHeight Then
nParam = HTBOTTOMRIGHT
End If

If nParam Then
ReleaseCapture
SendMessage .hwnd, &HA1, nParam, 0
End If
End With
End Sub

'改变鼠标形状
Private Sub MouseDraw(X As Single, Y As Single)
With Me
'如果鼠标在绘图框内
If X > 4 And X < .ScaleWidth - 4 And Y > 4 And Y < .ScaleHeight - 4 Then


.MousePointer = vbDefault
Else '如果鼠标在绘图框的四周边缘
If (X > 0 And X < 3) Or (X > .ScaleWidth - 3 And X < .ScaleWidth) Then
.MousePointer = vbSizeWE
End If

If (Y > 0 And Y < 3) Or (Y > .ScaleHeight - 3 And Y < .ScaleHeight) Then
.MousePointer = vbSizeNS
End If

If X > 0 And X < 4 And Y > 0 And Y < 4 Then
.MousePointer = vbSizeNWSE
End If

If X > .ScaleWidth - 4 And X < .ScaleWidth And Y > 0 And Y < 4 Then
.MousePointer = vbSizeNESW
End If

If X > 0 And X < 4 And Y > .ScaleHeight - 4 And Y < .ScaleHeight Then
.MousePointer = vbSizeNESW
End If

If X > .ScaleWidth - 4 And X < .ScaleWidth And Y > .ScaleHeight - 4 And Y < .ScaleHeight Then
.MousePointer = vbSizeNWSE
End If
End If
End With
End Sub

Private Sub Form_Load()
Me.ScaleMode = vbPixels
Me.BorderStyle = vbFixedSingle
Me.Caption = ""
'将窗口的ControlBox属性设置为False
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
PicSize X, Y

If Button = 1 Then
ReleaseCapture
SendMessage Me.hwnd, &HA1, 2, 0
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseDraw X, Y '改变鼠标形状
End Sub
[解决办法]
想想头都大,坐享成果...
[解决办法]
真是蛋疼,折腾好多天了
[解决办法]
每天顶一下,希望有高手给上实例
[解决办法]
每天顶一下,希望有高手给上实例
------解决方案--------------------


帮顶吧
[解决办法]
真是蛋疼,折腾好多天了

读书人网 >VB

热点推荐