我试为什么不行,没有提示错误,只是没有任何反映
能具体介绍一下下面的api吗原文+++++++++++++++++++++++++++++++++++++++++++++++++++++++标题 拖动无系统标准标题栏的窗口
作者: 吴斌
来自:
更新日期: 2002年11月9日
大家知道,在VB中可以通过设置Form的属性,制作无系统标题栏的窗口。可是,由于失去了系统标题栏,如何使用鼠标拖动窗口便成了一个棘手的问题。其实,借助API函数ReleaseCapture和SendMessage,这个问题便可迎刃而解了。 首先,在module文件中加入下列声明语句: Declare Sub ReleaseCapture Lib"User"() Declare Function SendMessage Lib"User"(ByVal hWnd _As Integer,ByVal wMsg As Integer,ByVal wParam As Integer,_lParam As Any)As Long Public Const WM_SYSCOMMAND=&H112 Public Const SC_MOVE=&HF010 Public Const HTCAPTION=2 然后,在Form的MouseDown事件中加入下列代码: ReleaseCapture Ret&=SendMessage(Me.hWnd,WM_SYSCOMMAND,_SC_MOVE+HTCAPTION,0) …… 程序运行后,只要当光标落在Form区域时按住鼠标左键,便可以拖动窗口了。在一些要求生动活泼的界面的程序设计中,开发者常常希望自制风格独特的标题栏,以满足整个界面的要求。通过这个方法,就可以使自制的标题栏达到乱真的地步。不过,用作自制标题栏的控件,必须具有MouseDown事件以摆放上述代码。
能具体介绍一下下面的api吗原文+++++++++++++++++++++++++++++++++++++++++++++++++++++++标题 拖动无系统标准标题栏的窗口
作者: 吴斌
来自:
更新日期: 2002年11月9日
大家知道,在VB中可以通过设置Form的属性,制作无系统标题栏的窗口。可是,由于失去了系统标题栏,如何使用鼠标拖动窗口便成了一个棘手的问题。其实,借助API函数ReleaseCapture和SendMessage,这个问题便可迎刃而解了。 首先,在module文件中加入下列声明语句: Declare Sub ReleaseCapture Lib"User"() Declare Function SendMessage Lib"User"(ByVal hWnd _As Integer,ByVal wMsg As Integer,ByVal wParam As Integer,_lParam As Any)As Long Public Const WM_SYSCOMMAND=&H112 Public Const SC_MOVE=&HF010 Public Const HTCAPTION=2 然后,在Form的MouseDown事件中加入下列代码: ReleaseCapture Ret&=SendMessage(Me.hWnd,WM_SYSCOMMAND,_SC_MOVE+HTCAPTION,0) …… 程序运行后,只要当光标落在Form区域时按住鼠标左键,便可以拖动窗口了。在一些要求生动活泼的界面的程序设计中,开发者常常希望自制风格独特的标题栏,以满足整个界面的要求。通过这个方法,就可以使自制的标题栏达到乱真的地步。不过,用作自制标题栏的控件,必须具有MouseDown事件以摆放上述代码。
解决方案 »
- msflexgrid 与textbox问题
- 如何得到网页中的验证码图片?急!!!
- 如何求出各个字段中最长记录的长度????????????
- RichTextBox控件怎么在后面添加信息?控件中已经有图片插进去了
- 超市收银系统的打印问题,急用,太谢谢了。
- 我想让MSFlexGrid中的数据每一行都用不同的颜色显示,并且当左边和下边的滚动条走动的时候,msflexGrid中的数据也随之滚动,请问能实现吗
- 如果两个人对数据库中同一张表进行操作为报错应该怎么办
- 怎么样才能把内存全用上,或更多的利用?
- 想实现这样的界面要怎么做,需要什么控件..
- 关于VB的问题
- 请问MsFlexGrid带打印预览吗?
- 急问
Private Sub Form_Load()
proroc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim rv As Long
rv = SetWindowLong(hWnd, GWL_WNDPROC, proroc)
End Sub'Module1Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public 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 LongPublic proroc As Long
Public Const WM_NCHITTEST = &H84
Public Const HTCAPTION = 2
Public Const HTCLIENT = 1
Public Const GWL_WNDPROC = (-4)Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim rv As Long
If Msg = WM_NCHITTEST Then
rv = DefWindowProc(hWnd, Msg, wParam, lParam)
If rv = HTCLIENT Then
WindowProc = HTCAPTION
Else
WindowProc = rv
End If
Else
WindowProc = CallWindowProc(proroc, hWnd, Msg, wParam, lParam)
End IfEnd Function
Option Explicit
Private gX As Long, gY As LongPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
gX = X
gY = Y
End SubPrivate 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
模块中:
Option ExplicitPublic Const GWL_WNDPROC = (-4)Public Const WM_NCHITTEST = &H84
Public Const HTCLIENT = 1
Public Const HTCAPTION = 2Declare 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 LongPublic prevWndProc As LongFunction 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 ExplicitPrivate Sub Command1_Click()
Unload Me
End SubPrivate Sub Form_Load()
prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
End SubPrivate Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End SubPrivate Sub Form_Paint()
ForeColor = vbBlue
Cls
Print
Print "我虽然没有标题区,但您可以在工作区按下鼠标,"
Print "然后把我拖曳到其它地方."
End Sub
Option ExplicitPrivate Declare Sub ReleaseCapture Lib "User32" ()Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = &H2Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Call ReleaseCapture
Call SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub