----请问大家----如何移动没有标题栏的窗体？？

[dxw]

如何移动没有标题栏的窗体？？

[vansoft]

up

[lihonggen0]

http://www.csdn.net/develop/read_article.asp?id=18774


无标题栏的窗体的拖动问题

在特殊窗体的应用中，我们有时需要把窗体的标题栏屏蔽掉，以窗体换上自己的外壳。是，当去掉了窗体标题栏后，移动窗体就成了一个问题。

我们还是来看一下在VB6中的实现，VB6中实现（借助API函数SendMessage）

在设计时将窗体的BorderStyle属性设置为0-none

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long

Private Declare Sub ReleaseCapture Lib "User32" ()

Const WM_NCLBUTTONDOWN = &HA1

Const HTCAPTION = 2

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

Dim lngReturnValue As Long

If Button = 1 Then

'Release capture

Call ReleaseCapture()

'Send a 'left mouse button down on caption'-message to our form

lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)

End If

End Sub

Private Sub Form_Paint()

Me.Print("Click on the form, hold the mouse button and drag it")

End Sub

[aalei]

我不多说，因为他们都说了，还要说“调用API函数”，他们也说了
55555555555，我要分！

[xayzmb]

'给你一段类代码
'在窗体的鼠标事件中(up和down)使用类的相应的方法即可
'******************************************************
Option Explicit
'---------------------------------------------
' 移动无标题栏窗体
'---------------------------------------------
'变量声明
Private MoveScreen As Boolean

'鼠标位置
Private MousX As Integer
Private MousY As Integer
'窗体位置
Private CurrX As Integer
Private CurrY As Integer

'当鼠标在窗体上按下时(mouseDown)
Public Sub clsMouseDown(Button As Integer, X As Single, Y As Single)
'如果是鼠标左键按下
If Button = 1 Then
'标示为移动状态
MoveScreen = True
'得到鼠标在窗体上的位置（相对与窗体内部坐标）
MousX = X
MousY = Y
End If
End Sub

'当鼠标在窗体上移过时(mouseMove)
Public Sub clsMouseMove(Form As Form, X As Single, Y As Single)
'如果处于鼠标左键按下的状态，即MoveScreen = True时
If MoveScreen Then
'计算新的窗体坐标值
'仔细想一下，看看是不是这样
CurrX = Form.Left - MousX + X
CurrY = Form.Top - MousY + Y
'移动窗体到新的位置
Form.Move CurrX, CurrY
End If
End Sub

'如果鼠标松开(mouseUp)，则停止拖动
Public Sub clsMouxeUp()
MoveScreen = False
End Sub
'*****************************************************************

[qingming81]

代码还是热的(才往另一张帖上贴)!该代码类似实体拖动，拖不出屏幕外.

option explicit
dim mX as long
dim mY as long

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

'对象移动前的对象位置和鼠标位置相关值。
If Button = vbLeftButton Then
MousePointer = vbSizeAll
mX = X
mY = Y
End If

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim H As Long
Dim V As Long

On Error Resume Next

If (Button = vbLeftButton) And (me.WindowState = 0) Then

If (X = mY) And (Y = mY) Then Exit Sub

H = Me.Left + X - mX
V = Me.Top + Y - mY

If H <= 0 Then
H = 0
ElseIf H >= (Screen.Width - Me.Width) Then
H = Screen.Width - Me.Width
End If

If V <= 0 Then
V = 0
ElseIf V >= (Screen.Height - Me.Height) Then
V = Screen.Height - Me.Height
End If

Me.Move H, V

End If

End Sub

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

If MousePointer = vbSizeAll Then
MousePointer = vbDefault
Exit Sub
End If

'如有右键菜单，在这里弹出右键菜单。
If (Button = vbRightButton) Then
Call PopupMenu(mnuRight)
End If

End Sub

[cppsong]

通过mousemove事件控制Form.move

[LGYAN]

Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
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 Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
ReleaseCapture
SendMessage form1.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End If
End Sub

[csdngoodnight]

'拖动窗体的API--------------------------------------------------------
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
'---------------------------------------------------------------------


Private Sub 控件名_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'拖动窗体
If Button = 1 Then
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If

End Sub

[csdngoodnight]

Dim bb As Boolean '拖动窗体
Dim px As Integer, py As Integer


'IMBar是一个控件
Private Sub IMBar_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
bb = True
px = x
py = y
End Sub

Private Sub IMBar_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If bb Then
Move Me.Left + x - px, Me.Top + y - py
End If
End Sub

Private Sub IMBar_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
bb = False
End Sub

[babynocry]

LGYAN(情浓风寒) 帖的这个方法蛮好，
我就用的这个

[morinson]

移动没有标题栏的窗口
我们一般是用鼠标按住窗口的标题栏，然后移动窗口，当窗口没有标题栏时，我们可以用下面的方法来移动窗口：
　
在 BAS 文件中声明：
Declare Function ReleaseCapture Lib "user32" () As Long
Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
　
然后，在 Form_MouseDown 事件中：
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub

[HanZhu1]

'窗体拖动
Public Const RGN_OR = 2
' RGN_DIFF creates the intersection of combined regions

Public Const RGN_DIFF = 4
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long

Public Const SWP_NOMOVE = 2
Public Const SWP_NOSIZE = 1
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Sub Image1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
ReleaseCapture
SendMessage Form1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub

[pooryaya]

使用托动窗体API

代码楼上面的说过

[wintergoes]

Good

[Alicky]

Option Explicit

Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
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 Long) As Long

Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 1 Then ' Checking for Left Button only
Dim ReturnVal As Long
x = ReleaseCapture()
ReturnVal = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub

[csdngoodnight]

我的方法，在拖动时看起来最舒服