旧事重提：如何让窗体最置顶？（不是弹出）

cyber-bobo

三个窗体都打开时，如何让窗体1最置顶可输入数据，其它两个窗体要点也没反应。
另问：如何让整个窗体失效，就像Enabled = False一样。

Grant

VB中让窗体始终处于最前面 和 VB中设置窗体总在最底
API帮我们实现这个愿望~
我们先来看看SetWindowPos函数的定义和参数：

　　 使用API函数之前必须先在程序中声明如下：

Private 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

　　 其中各参数的意义如下:

参数 意义
hwnd Long 欲定位的窗口
hWndInsertAfter Long 窗口句柄。在窗口列表中，窗口hwnd会置于这个窗口句柄的后面
x，y Long 窗口新的x,y坐标
cx，cy Long 指定新的窗口宽度和高度
wFlags Long 包含了旗标的一个整数，是下列之一
返回值 Long 非零表示成功，零表示失败

　　 下面是部分wFlags参数和它们的意义：

参数 意义和使用方法
SWP_DRAWFRAME 围绕窗口画一个框
SWP_HIDEWINDOW 隐藏窗口
SWP_NOACTIVATE 不激活窗口
SWP_NOMOVE 保持当前位置 (x和y设定将被忽略) &H2
SWP_NOREDRAW 窗口不自动重画
SWP_NOSIZE 保持当前大小 (cx和cy会被忽略) &H1
SWP_NOZORDER 保持窗口在列表的当前位置 (hWndInsertAfter将被忽略)
SWP_SHOWWINDOW 显示窗口 &H40
SWP_FRAMECHANGED 强迫一条WM_NCCALCSIZE消息进入窗口，即使窗口的大小没有改变

　　 函数的使用很简单，我们只须在Form_Load中加入如下语句即可：

retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 300, 300, SWP_SHOWWINDOW)

　　 这样窗体就能保持在所有窗体的前面了。

　　 为了学习方便，下面提供了源码：

注释：-------------------------------------------
注释： 让一个窗体总是处于最前的例子
注释：-------------------------------------------
注释：程序说明：
注释：本例应用SetWindowPos函数，设置窗体的显示属性
注释：来实现让一个窗体总是处于其他窗体的前面而不会
注释：被其他窗体所遮住。
注释：-------------------------------------------
Option Explicit

注释：【VB声明】
注释： Private 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

注释：【说明】
注释： 这个函数能为窗口指定一个新位置和状态。它也可改变窗口在内部窗口列表中的位置。该函数与DeferWindowPos函数相似，只是它的作用是立即表现出来的（在vb里使用：针对vb窗体，如它们在win32下屏蔽或最小化，则需重设最顶部状态。如有必要，请用一个子类处理模块来重设最顶部状态

注释：【返回值】
注释： Long，非零表示成功，零表示失败。会设置GetLastError

注释：【备注】
注释： 窗口成为最顶级窗口后，它下属的所有窗口也会进入最顶级。一旦将其设为非最顶级，则它的所有下属和物主窗口也会转为非最顶级。Z序列用垂直于屏幕的一根假想Z轴量化这种从顶部到底部排列的窗口顺序

注释：【参数表】
注释： hwnd ----------- Long，欲定位的窗口

注释： hWndInsertAfter - Long，窗口句柄。在窗口列表中，窗口hwnd会置于这个窗口句柄的后面。也可能选用下述值之一：
注释： HWND_BOTTOM 将窗口置于窗口列表底部
注释： HWND_TOP 将窗口置于Z序列的顶部；Z序列代表在分级结构中，窗口针对一个给定级别的窗口显示的顺序
注释： HWND_TOPMOST 将窗口置于列表顶部，并位于任何最顶部窗口的前面 -1
注释： HWND_NOTOPMOST 将窗口置于列表顶部，并位于任何最顶部窗口的后面 -2

注释： x -------------- Long，窗口新的x坐标。如hwnd是一个子窗口，则x用父窗口的客户区坐标表示

注释： y -------------- Long，窗口新的y坐标。如hwnd是一个子窗口，则y用父窗口的客户区坐标表示

注释： cx ------------- Long，指定新的窗口宽度

注释： cy ------------- Long，指定新的窗口高度

注释： wFlags --------- Long，包含了旗标的一个整数，是下列之一：
注释： SWP_DRAWFRAME 围绕窗口画一个框
注释： SWP_HIDEWINDOW 隐藏窗口
注释： SWP_NOACTIVATE 不激活窗口 &H10
注释： SWP_NOMOVE 保持当前位置 (x和y设定将被忽略) &H2
注释： SWP_NOREDRAW 窗口不自动重画
注释： SWP_NOSIZE 保持当前大小 (cx和cy会被忽略) &H1
注释： SWP_NOZORDER 保持窗口在列表的当前位置 (hWndInsertAfter将被忽略)
注释： SWP_SHOWWINDOW 显示窗口 &H40
注释： SWP_FRAMECHANGED 强迫一条WM_NCCALCSIZE消息进入窗口，即使窗口的大小没有改变
Private 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
　 Const HWND_TOPMOST = -1
　 Const SWP_SHOWWINDOW = &H40
　 Private Sub Form_load()
　　 Dim retValue As Long
　　 注释：将窗体设置为处于所有窗口的顶层，注意在 VB 中运行时，
　　 '可能不行，但编译成EXE后就可以了
　　 retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX,
　　　　　　　 Me.CurrentY, 300, 300, SWP_SHOWWINDOW)
End Sub

.....................................................................................................................................................................


'Module1
Option Explicit
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Const GWL_WNDPROC = (-4&)
Public Const WM_WINDOWPOSCHANGING = &H46&
Public Type WINDOWPOS
hwnd As Long
hWndInsertAfter As Long
x As Long
y As Long
cx As Long
cy As Long
flags As Long
End Type
Public Const HWND_BOTTOM = &H1&
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Function WinPropBag_ProcAddress(ByVal hwnd As Long, ByVal fStoreValue As Boolean, Optional ByVal lProcAddress As Long = 0, Optional ByVal fRemoveProp As Boolean = False) As Long
If fStoreValue Then
''保存属性
SetProp hwnd, "MY_WINPROP_PROCADDRESS", lProcAddress
Else
''取出属性
WinPropBag_ProcAddress = GetProp(hwnd, "MY_WINPROP_PROCADDRESS")
If fRemoveProp Then
''删除属性
RemoveProp hwnd, "MY_WINPROP_PROCADDRESS"
End If
End If
End Function
Public Sub Subclassing(ByVal hWndTarget As Long, Optional ByVal fUnsubclassing As Boolean = False)
If fUnsubclassing Then
WinPropBag_ProcAddress hWndTarget, True, SetWindowLong(hWndTarget, GWL_WNDPROC, AddressOf MyWindowProc)
Else
SetWindowLong hWndTarget, GWL_WNDPROC, WinPropBag_ProcAddress(hwnd:=hWndTarget, fStoreValue:=False, fRemoveProp:=True)
End If
End Sub
Public Function MyWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_WINDOWPOSCHANGING Then
''可以这样写
Dim ut As WINDOWPOS
CopyMemory ut, ByVal lParam, Len(ut)
ut.hWndInsertAfter = HWND_BOTTOM
CopyMemory ByVal lParam, ut, Len(ut)
''也可以这接这样写
''CopyMemory ByVal lParam + 4, HWND_BOTTOM, 4
End If
MyWindowProc = CallWindowProc(WinPropBag_ProcAddress(hwnd, False), hwnd, uMsg, wParam, lParam)
End Function

''Form1
Private Sub Form_Load()
Subclassing Me.hwnd, True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Subclassing Me.hwnd, False
End Sub

andymark

http://www.office-cn.net/forum.p ... p%3Bfilter%3Ddigest