AW: Info Leiste
29.10.2005 23:16:26
chris
Hiermit geht das.
Rückmeldung wäre nett !
Code ist nicht von mir aber geht :)
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'-------
Private Declare Function GetSystemMenu Lib "user32" ( _
ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias _
"GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias _
"SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
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 IsWindow Lib "user32" _
(ByVal hwnd 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 Declare Function GetParent Lib "user32" (ByVal hwnd As Long) _
As Long
Private Declare Function SetParent Lib "user32" ( _
ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
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 RemoveMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Private Const SC_CLOSE As Long = &HF060&
Private Const SC_MAXIMIZE As Long = &HF030&
Private Const SC_MINIMIZE As Long = &HF020&
Private Const xSC_CLOSE As Long = -10&
Private Const xSC_MAXIMIZE As Long = -11&
Private Const xSC_MINIMIZE As Long = -12&
Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const hWnd_NOTOPMOST = -2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_FRAMECHANGED = &H20
Private Const MIIM_STATE As Long = &H1&
Private Const MIIM_ID As Long = &H2&
Private Const MFS_GRAYED As Long = &H3&
Private Const WM_NCACTIVATE As Long = &H86
Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Public Function EnableCloseButton(ByVal hwnd As Long, Enable As Boolean) As Integer
EnableSystemMenuItem hwnd, SC_CLOSE, xSC_CLOSE, Enable, "EnableCloseButton"
End Function
Public Sub EnableMinButton(ByVal hwnd As Long, Enable As Boolean)
EnableSystemMenuItem hwnd, SC_MINIMIZE, xSC_MINIMIZE, Enable, "EnableMinButton"
Dim lngFormStyle As Long
lngFormStyle = GetWindowLong(hwnd, GWL_STYLE)
If Enable Then
lngFormStyle = lngFormStyle Or WS_MINIMIZEBOX
Else
lngFormStyle = lngFormStyle And Not WS_MINIMIZEBOX
End If
SetWindowLong hwnd, GWL_STYLE, lngFormStyle
SetParent hwnd, GetParent(hwnd)
SetWindowPos hwnd, hWnd_NOTOPMOST, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED
End Sub
Public Sub EnableMaxButton(ByVal hwnd As Long, Enable As Boolean)
EnableSystemMenuItem hwnd, SC_MAXIMIZE, xSC_MAXIMIZE, Enable, "EnableMaxButton"
Dim lngFormStyle As Long
lngFormStyle = GetWindowLong(hwnd, GWL_STYLE)
If Enable Then
lngFormStyle = lngFormStyle Or WS_MAXIMIZEBOX
Else
lngFormStyle = lngFormStyle And Not WS_MAXIMIZEBOX
End If
SetWindowLong hwnd, GWL_STYLE, lngFormStyle
SetParent hwnd, GetParent(hwnd)
SetWindowPos hwnd, hWnd_NOTOPMOST, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED
End Sub
Private Sub FixWindows(ByVal hwnd As Long)
Dim SysMenu As Long
Dim Ret As Long
'Wenn wert True kann fenster wieder bewegt werden !
SysMenu = GetSystemMenu(hwnd, False)
Ret = RemoveMenu(SysMenu, &HF010&, &H0&)
End Sub
Private Sub EnableSystemMenuItem(hwnd As Long, Item As Long, Dummy As Long, Enable As Boolean, FuncName As String)
If IsWindow(hwnd) = 0 Then
Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _
"modCloseBtn::" & FuncName & "() - Invalid Window Handle"
Exit Sub
End If
Dim hMenu As Long
hMenu = GetSystemMenu(hwnd, 0)
Dim MII As MENUITEMINFO
MII.cbSize = Len(MII)
MII.dwTypeData = String$(80, 0)
MII.cch = Len(MII.dwTypeData)
MII.fMask = MIIM_STATE
If Enable Then
MII.wID = Dummy
Else
MII.wID = Item
End If
If GetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then
Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _
"modCloseBtn::" & FuncName & "() - Menu Item Not Found"
Exit Sub
End If
Dim lngMenuID As Long
lngMenuID = MII.wID
If Enable Then
MII.wID = Item
Else
MII.wID = Dummy
End If
MII.fMask = MIIM_ID
If SetMenuItemInfo(hMenu, lngMenuID, False, MII) = 0 Then
Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _
"modCloseBtn::" & FuncName & "() - Error encountered " & _
"changing ID"
Exit Sub
End If
If Enable Then
MII.fState = MII.fState And Not MFS_GRAYED
Else
MII.fState = MII.fState Or MFS_GRAYED
End If
MII.fMask = MIIM_STATE
If SetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then
Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _
"modCloseBtn::" & FuncName & "() - Error encountered " & _
"changing state"
Exit Sub
End If
SendMessage hwnd, WM_NCACTIVATE, True, 0
End Sub
Sub START()
'wHandle = FindWindow(vbNullString, Masdfe)
wHandle = GetForegroundWindow
Dim x As Boolean
' Wenn true wird Aktiviert , bei false deaktiviert !
x = True
EnableCloseButton wHandle, x
EnableMinButton wHandle, x
EnableMaxButton wHandle, x
'Muss im Sub selbst umgestellt werden von false auf True und umgekehrt !
FixWindows wHandle
End Sub