无边框窗体的拉伸问题

Question

在网上找到如下代码，
http://www.ccw.com.cn/htm/app/aprog/01_4_10_2.asp
但不好用，拉伸不了，不知道我什么地方没弄对？
以前的文章我也看了，还是不好用，我就纳了闷了？

Answer 1

我刚下了一个，要不要发给你
联系：[email protected]

Answer 2

只要判断一下Form上MouseMove时的位置，在Button = 0时根据不同的位置改变鼠标的形状。
在有Button = VBLeftButton时根据X,Y的值，以及MouseDown并且Button = vbLeftButton时记录下的X,Y的值来对Form进行Move方法就可以实现窗体的拉伸了。Api还是要用的，用SetCapture和ReleaseCapture就可以了，SetCapture是用来在鼠标形状改变并且没有发生MouseDown事件的时候使用的。当鼠标超出可以拉伸的范围的时候使用ReleaseCapture释放鼠标。

Answer 3

to ljhdi() :
不如你告诉我网址，我看看是否已经下过。
我下了不少类是的代码，也不知道为什么，都不能实现它所描述的功能。to yunyu97() :
其实你说的方法我也用过，但控制起来太麻烦，做出的效果也不好（当然，我也没有尽全力去做）。
因为我觉得网上流传的那个方法若可以用，则许多其它相关的效果都能迎刃而解。现在用不了，不知是为什么，我想知道为什么我的不可以用？差在哪？不过还是谢谢两位。

Answer 4

用SendMessage API函数发送消息给窗体。
===========================================
'----------------------------------------------------------------------
'常量定义
Private Const WM_NCLBUTTONDOWN = &HA1Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Const HTTOP = 12
Private Const HTBOTTOM = 15
Private Const HTRIGHTBOTTOM = 17
'----------------------------------------------------------------------
'sendmessage函数声明
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 Declare Function ReleaseCapture Lib "user32" () As Long
'----------------------------------------------------------------------
'调用举例（右边框拉伸）
ReleaseCapture
SendMessage PrenFrm.hWnd, WM_NCLBUTTONDOWN, HTRIGHT, 0

Answer 5

用最土的办法，在窗体四面放上个Borderstyle=0的PictrueBox，改变其MousePointer为7或9，在其MouseDown事件中记录窗体的Left、Top、Height、Width，在MouseMove中改变这些值（如果内部控件较多时会闪烁），或在MouseUp中改变这些值（不会闪烁）。

Answer 6

看一下我的写的代码:
Option ExplicitPrivate Const WM_NCLBUTTONDOWN = &HA1
Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Const HTTOP = 12
Private Const HTBOTTOM = 15
Private Const HTBOTTOMRIGHT = 17
Private Const HTBOTTOMLEFT = 16
Private Const HTTOPLEFT = 13
Private Const HTTOPRIGHT = 14'sendmessage函数声明
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 Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As LongPrivate intEdge As Integer   '临界距离，鼠标在离边框距离小于等于该值则判定在边框上……Private Sub Form_Load()
   '相当于三个象素
   intEdge = Me.ScaleX(3, vbPixels, Me.ScaleMode)
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   'Critical:将处理四角的代码放在前面
   If X + intEdge >= ScaleWidth And Y + intEdge >= ScaleHeight Then     '右下角
      ReleaseCapture
      SendMessage hwnd, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0
   ElseIf Y + intEdge >= ScaleHeight And X <= intEdge Then          '左下角
      ReleaseCapture
      SendMessage hwnd, WM_NCLBUTTONDOWN, HTBOTTOMLEFT, 0
   ElseIf Y <= intEdge And X <= intEdge Then                    '左上角
      ReleaseCapture
      SendMessage hwnd, WM_NCLBUTTONDOWN, HTTOPLEFT, 0
   ElseIf Y <= intEdge And X + intEdge <= ScaleWidth Then            '右上边
      ReleaseCapture
      SendMessage hwnd, WM_NCLBUTTONDOWN, HTTOPRIGHT, 0
   ElseIf X + intEdge >= ScaleWidth And Y <= ScaleHeight Then      '右边
      ReleaseCapture
      SendMessage hwnd, WM_NCLBUTTONDOWN, HTRIGHT, 0
   ElseIf Y + intEdge >= ScaleHeight And X <= ScaleWidth Then       '下边
      ReleaseCapture
      SendMessage hwnd, WM_NCLBUTTONDOWN, HTBOTTOM, 0
   ElseIf X <= intEdge And Y <= ScaleHeight Then               '左边
      ReleaseCapture
      SendMessage hwnd, WM_NCLBUTTONDOWN, HTLEFT, 0
   ElseIf Y <= intEdge And X <= ScaleWidth Then                '上边
      ReleaseCapture
      SendMessage hwnd, WM_NCLBUTTONDOWN, HTTOP, 0
   End If
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   'Critical:将处理四角的代码放在前面
   Label1.Caption = X & "  " & Y
   If (X + intEdge >= ScaleWidth And Y + intEdge >= ScaleHeight) Or (Y <= intEdge And X <= intEdge) Then           '右下\左上角
      MousePointer = vbSizeNWSE
   ElseIf Y + intEdge >= ScaleHeight And X <= intEdge Or Y <= intEdge And X + intEdge <= ScaleWidth Then           '左下\右上角
      MousePointer = vbSizeNESW
   ElseIf X + intEdge >= ScaleWidth And Y <= ScaleHeight Or X <= intEdge And Y <= ScaleHeight Then   '左、右
      MousePointer = vbSizeWE
   ElseIf Y + intEdge >= ScaleHeight And X <= ScaleWidth Or Y <= intEdge And X <= ScaleWidth Then    '上边下边
      MousePointer = vbSizeNS
   Else
      MousePointer = vbNormal
   End If
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   SetCapture hwnd
End Sub

Answer 7

子类化窗体，自己去处理WM_NCHITTEST,效果和以前有边框时是一样的。

Answer 8

无论是设置热区还是窗体划区，效果都不好，编程也麻烦。偶什么方法都用过，还是用最土的方法（添加PictrueBox）最省事，效果也最好。

Answer 9

'获得鼠标位置，用来改变窗体大小的
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
        X As Long
        Y As Long
End Type
'
Private Sub image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
image1.Tag = ""
End Sub
Private Sub image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
image1.Tag = "1"
End Sub
Private Sub image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If image1.Tag <> "" Then
Dim pos As POINTAPI
GetCursorPos pos
gg = pos.X * 15 - Me.Left
gg2 = pos.Y * 15 - Me.Top
If gg > 2500 Then Me.Width = gg
If gg2 > 1500 Then Me.Height = gg2End IfEnd SubPrivate Sub Form_Load()
image1.Left = Form1.Width - image1.Width
image1.Top = Form1.Height - image1.Height
End Sub
Private Sub Form_Resize()
On Error Resume Next
image1.Left = Me.Width - image1.Width
image1.Top = Me.Height - image1.Height
End Sub