移动无边框（无标题栏）窗体

2008-06-07 11:45:37

看到很多人问这个，我就总结了这个问题，现抽时间写了以下三种方法供参考，希望大家拿出更多方法：

先给两种，呵呵

CODE:

方法1：给出原理的
Option Explicit
Dim Oldx As Single
Dim Oldy As Single

Private Sub Form_Load()
    Me.BorderStyle = 0
    '如果没有下一句，窗体样式不会立即显示出来，要用setwindowpos
    '这里引用nikee的方法，呵呵 ^_^
    '不信你去掉试试，如果呈现无边框，我把IDE砸了^_^
    Me.Caption = ""
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ōldx = X
    ōldy = Y
    If Button = vbLeftButton Then
        Me.MousePointer = 15
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        Me.Move Me.Left + X - Oldx, Me.Top + Y - Oldy
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.MousePointer = 0
End Sub

CODE:

方法2：这也是经常大家用到的 ，貌似nikee做那个什么标尺用了，呵呵
Option Explicit

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 Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1

Private Sub Form_Load()
    Me.BorderStyle = 0
    '如果没有下一句，窗体样式不会立即显示出来，要用setwindowpos
    '这里引用nikee的方法，呵呵 ^_^
    '不信你去掉试试，如果呈现无边框，我把IDE砸了^_^
    Me.Caption = ""
End Sub

'可以移动无边框窗体
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture  '释放鼠标捕获
    SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
End Sub

大家猜猜我第三种会怎么用，用什么方法？

论坛模式推荐收藏等级(3) 编辑管理 查看(681) 评论(23)

TAG:

hexinchun 发布于2008-06-10 11:29:10: 回复 #23 yimins 的帖子
我是发现网络上的资源在这个查询上是错误的

yimins 发布于2008-06-10 11:21:38: QUOTE:
原帖由 hexinchun 于 2008-6-10 11:08 发表
’要这样才正确
Private Const SC_MOVE = &HF010&

'Private Const SC_MOVE = &HF012 '这个是网络上的的搜索结果，貌似不正确，大家看看是不这样？
API浏览器也是 &HF010&

hexinchun 发布于2008-06-10 11:08:06: ’要这样才正确
Private Const SC_MOVE = &HF010&

'Private Const SC_MOVE = &HF012 '这个是网络上的的搜索结果，貌似不正确，大家看看是不这样？

yidie 发布于2008-06-10 10:24:35: 我用第二种,不过参数有点不同

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
if button=vbleftbutton then
ReleaseCapture
SendMessage hWnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, ByVal 0&
endif
End Sub

[ 本帖最后由 yidie 于 2008-6-10 10:26 编辑 ]

yimins 发布于2008-06-10 10:12:14: 第四种是子类化，然后将鼠标移动消息转换掉。

dolphins发布于2008-06-10 09:31:22: 第一种有时候会闪烁，所以还是第二种好点

jay36 发布于2008-06-10 07:53:20: 推荐使用第二种方法
方便直接

建议不要使用第一种当鼠标移动过快的时候会发现窗体移动会略慢于鼠标移动的位置

qiaodali发布于2008-06-09 23:47:30: 学习了，不错，尽管三个方法全用过

cwa9958 发布于2008-06-09 12:28:47: QUOTE:
原帖由 hexinchun 于 2008-6-7 11:42 发表
Option Explicit
Dim Oldx As Single
Dim Oldy As Single

Private Sub Form_Load()
Me.BorderStyle = 0
'如果没有下一句，窗体样式不会立即显示出来，要用setwindowpos
'这里引用nikee的方法，呵呵 ^_^
'不信你去掉试试，如果呈现无边框，我把IDE砸了^_^
Me.Caption = ""
End Sub

Pri ...
这样可以在任务栏里显示标题

Private Sub Form_Load()
Me.BorderStyle = 0
'如果没有下一句，窗体样式不会立即显示出来，要用setwindowpos
'这里引用nikee的方法，呵呵 ^_^
'不信你去掉试试，如果呈现无边框，我把IDE砸了^_^
Me.Caption = "标题"
End Sub

如果直接在属性里改为0,任务栏里会没有显示呢

[ 本帖最后由 cwa9958 于 2008-6-9 13:08 编辑 ]

reker发布于2008-06-09 11:12:10: 第四种是基于windows7的触摸技术

永夜的极光发布于2008-06-09 10:11:41: 多顶几下LZ是不是公布第四种呢?

54jb 发布于2008-06-09 00:39:56: 期望越大失望就越大...
换汤不换药...不过还是支持支持下...为公布第三种顶~~

reker发布于2008-06-08 23:10:36: movewindow。。。和第一种一样，只不过换成api。。。
失望ing…………

icecept 发布于2008-06-08 20:08:08: 好东西，下来学习

VBProFan 发布于2008-06-08 19:10:50: 原来是 MoveWindow

haohello 发布于2008-06-08 15:46:04: 第一种和第三种基本一样.
不过是一个使用API,一个不使用API

都是以获取鼠标位置和窗体位置为基础的.

hexinchun 发布于2008-06-08 11:37:14: 公布第三种：
CODE:
Option Explicit '====================================== '功能：实现移动无边框窗体 '作者：hexinchun '====================================== '一定得记住在API中使用的都是像素为单位 Private Type POINTAPI X As Long Y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Dim Rct As RECT Dim Lpoint As POINTAPI Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) GetWindowRect Me.hwnd, Rct GetCursorPos Lpoint End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim point As POINTAPI If Button = vbLeftButton Then GetCursorPos point MoveWindow Form1.hwnd, Rct.Left + point.X - Lpoint.X, Rct.Top + point.Y - Lpoint.Y, Rct.Right - Rct.Left, Rct.Bottom - Rct.Top, True End If End Sub Private Sub Form_Load() Me.BorderStyle = 0 Me.Caption = "" End Sub

54jb 发布于2008-06-08 08:46:03: 怎么还没出来第三的啊？今天都端午节了...明天可就不是端午节礼物了哦

dragonvb发布于2008-06-08 01:28:33: LZ别卖关子了,说出来吧,等不及了呵呵~

reker发布于2008-06-07 23:38:59: 2种都知道,第三种是什么?

进入论坛，查看全部评论