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

2012-12-17

无边框自绘界面,拖拉窗体大小！当BorderstyleNone 时我用图片控件画的界面，但窗体上下左右都使用了图片界

无边框自绘界面,拖拉窗体大小！
当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

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