怎样拖动没有控制栏的窗体?

dz08039 2004-04-23 08:24:29
控制栏被取消了,但想通过拖动改变窗体在桌面上的位置,请教如何实现?
...全文
38 10 打赏 收藏 转发到动态 举报
写回复
用AI写文章
10 条回复
切换为时间正序
请发表友善的回复…
发表回复
leolan 2004-04-28
  • 打赏
  • 举报
回复
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 Sub ReleaseCapture Lib "User32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim lngReturnValue As Long
If Button = 1 Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
flyingZFX 2004-04-28
  • 打赏
  • 举报
回复
呵 呵,是呀,,
呵呵,,,
PasswordError 2004-04-28
  • 打赏
  • 举报
回复
用字类处理或者用钩子吧。这才是解决的更好的办法。

当然还有其他方法,像 online(龙卷风V2.0--再战江湖) 的也可以实现。但是编程的艺术不就是寻找更好更直接的解决之道吗?

(注:没有最好,只有更好!这就是我理解的程序设计)
lsftest 2004-04-28
  • 打赏
  • 举报
回复
没有控制栏????是指没有标题栏吧。。。下面是王国荣先生的例子,用子类捕捉wm_nchittest消息,并以返回值欺骗windows:
模块中:
Option Explicit

Public Const GWL_WNDPROC = (-4)

Public Const WM_NCHITTEST = &H84
Public Const HTCLIENT = 1
Public Const HTCAPTION = 2

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public prevWndProc As Long

Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
If Msg = WM_NCHITTEST And WndProc = HTCLIENT Then
WndProc = HTCAPTION
End If
End Function

程序中:
Option Explicit

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()
prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End Sub

Private Sub Form_Paint()
ForeColor = vbBlue
Cls
Print
Print "我虽然没有标题区,但您可以在工作区按下鼠标,"
Print "然后把我拖曳到其它地方."
End Sub

songhaoying 2004-04-28
  • 打赏
  • 举报
回复
If Button = 1 Then
PasswordError 2004-04-28
  • 打赏
  • 举报
回复
To "leolan(史留香)":

没有测试您的程序。但是直观来看,好像有些不恰当的地方。

如果是拖动,应该是按下鼠标左键不放开,然后移动鼠标,以达到拖动对象的目的。

不过你的代码是在 MouseMove 事件中执行的。也就是移动鼠标时向窗口发送 WM_NCLBUTTONDOWN 消息。会不会出现这样的后果:一旦移动了鼠标,窗体就会移动。

没有实践就没有发言权,但是我还是说了。如果说错了,请您多多包涵。
broown 2004-04-24
  • 打赏
  • 举报
回复
online(龙卷风V2.0--再战江湖) 高手就是高手!
online 2004-04-23
  • 打赏
  • 举报
回复
试试
Option Explicit
Private gX As Long, gY As Long

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
gX = X
gY = Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not Button = vbLeftButton Then Exit Sub
Dim dx As Long, dy As Long, ax As Long, ay As Long, t As Long, l As Long
dy = Y - gY
dx = X - gX
l = Left
t = Top
ax = (Screen.Width - l - Width)
ay = (Screen.Height - t - Height)
If dy > 0 And dy > ay Then dy = ay
If dy < 0 And Abs(dy) > t Then dy = -t
If dx > 0 And dx > ax Then dx = ax
If dx < 0 And Abs(dx) > l Then dx = -l
Move l + dx, t + dy
End Sub
老吹老吹 2004-04-23
  • 打赏
  • 举报
回复
你可以放一个图片框在顶上然后用图片框的事件和属性来做。
daisy8675 2004-04-23
  • 打赏
  • 举报
回复
如果你貼了張圖的話

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

否則你就用hook吧

1,453

社区成员

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧