windowontop.bas

一个为公安系统接警中心控制软件,不错哦.

Attribute VB_Name = "windowsontop"
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
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000
Private Const WS_SYSMENU = &H80000
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1

Private Declare Function RemoveMenu Lib "user32" (ByVal hmenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

Private Const MF_BYPOSITION = &H400&
Private Const MF_BYCOMMAND = &H0&

'////////////////////////////////////////////////
'//bValid = True, 屏蔽窗口最大化、最小化按钮
'////////////////////////////////////////////////
Public Function PutWindowOnTop(pFrm As Form, bValid As Boolean)
    Dim lngWindowPosition As Long
    Dim ls As Long
    ls = GetWindowLong(pFrm.hwnd, GWL_STYLE)
    ls = ls Or WS_MAXIMIZEBOX
    ls = ls Or WS_MINIMIZEBOX
    ls = ls Or WS_THICKFRAME
'    ls = ls Or WS_SYSMENU
    
    If bValid Then
        ls = ls - WS_MINIMIZEBOX - WS_MAXIMIZEBOX ' - WS_SYSMENU
    End If
    ls = ls - WS_THICKFRAME
    ls = SetWindowLong(pFrm.hwnd, GWL_STYLE, ls)
    'lngWindowPosition = SetWindowPos(pFrm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Function

Public Sub DeleteMenuItem(frm As Form, nIndex As Integer)
    Dim hmenu As Long
    Dim result As Long
    hmenu = GetSystemMenu(frm.hwnd, False)
    result = RemoveMenu(hmenu, nIndex, MF_BYPOSITION)
End Sub

Public Sub RestoreMenu(frm As Form)
    Call GetSystemMenu(frm.hwnd, True)
End Sub