Window Module

Private Type wndClass
style As Long
lpfnwndproc As Long
cbClsextra As Long
cbWndExtra2 As Long
hInstance As Long
hIcon As Long
hCursor As Long
hbrBackground As Long
lpszMenuName As String
lpszClassName As String
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

'Don't exit mouse
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As Any) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
'*****************************************
'
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function TransparentForm Lib "SkinForm.dll" (ByVal sPathFile As String) As Long

Private Declare Function M_GetCapture Lib "user32" Alias "GetCapture" () As Long

Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function IsWindowEnabled Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function IsZoomed Lib "user32" (ByVal hWnd As Long) As Long

Public Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong 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 GetActiveWindow Lib "user32" () As Long

Private Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function GetForegroundWindow Lib "user32" () 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 GetClassInfo Lib "user32" Alias "GetClassInfoA" (ByVal hInstance As Long, ByVal lpClassName As String, lpWndClass As wndClass) As Long

Private Declare Function CloseWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long

Private Const WM_ACTIVATE = &H6
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOPMOST = -1
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2

Private Const WM_SETTEXT = &HC 'Set Caption
'Minimize all
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const VK_LWIN = &H5B
Private Const KEYEVENTF_KEYUP = &H2
'*****************************************
'Transparent window
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByValcrKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Boolean
'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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const LWA_ALPHA = 2
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
'*****************************************
'Lock Window Moving
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert 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_MOVE = &HF010&
Private Const MF_BYCOMMAND = &H0&
'*****************************************
Private Declare Function CreateRoundRectRgn Lib "gdi32.dll" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long 'MODULE 1152
'Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
'
Private Const MF_BYPOSITION = &H400& 'Disables Close Button
'


Function PutOnTop(H As Long, Stt As Boolean)
If Stt = True Then
SetWindowPos H, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
Else
SetWindowPos H, -2, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End If
End Function

Function Minimize_Window(H As Long)
CloseWindow H
End Function

Function Maximize_Window(H As Long)
Dim svar As Long
svar = ShowWindow(H, 3)
End Function

Function Restore_Window(H As Long)
Dim svar As Long
svar = ShowWindow(H, 9)
End Function

Function Invisible_Window(H As Long)
SetWindowPos H, HWND_RESIZE, 8000, 8000, 0, 0, SWP_MOVE Or SWP_SIZE
End Function

Function Activate_Window(H As Long)
BringWindowToTop H
End Function

Function Enabled_Window(H As Long, Stt As Long)
EnableWindow H, Stt
End Function

Function Set_caption(H As Long, New_caption)
SendMessage H, WM_SETTEXT, 0, ByVal New_caption
End Function

Function MinimizeAll()
Call keybd_event(VK_LWIN, 0, 0, 0)
Call keybd_event(&H4D, 0, 0, 0)
Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
End Function

Function TransparentWindow(H As Long, Trns As Byte)
SetWindowLong H, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes H, 0, Trns, LWA_ALPHA
End Function

Function LockWindowMove(H As Long, Stt As Boolean)
lhSysMenu = GetSystemMenu(H, Stt)
lRetVal = RemoveMenu(lhSysMenu, SC_MOVE, MF_BYCOMMAND)
End Function

Function RoundWindow(ByVal uObject As Object, ByVal v As Long, ByVal w As Long) 'Ex: RoundWindow Me, 20, 20
Dim lRight As Long
Dim lBottom As Long
Dim hRgn As Long
With uObject
lRight = .Width / Screen.TwipsPerPixelX
lBottom = .Height / Screen.TwipsPerPixelY
hRgn = CreateRoundRectRgn(0, 0, lRight, lBottom, v, w)
SetWindowRgn .hWnd, hRgn, True
End With
End Function

Public Sub DisableCloseWindowButton(H As Long)
Dim hSysMenu As Long
'Get the handle to this windows system menu
hSysMenu = GetSystemMenu(H, 0)
'Remove the Close menu item This will also disable the close button
RemoveMenu hSysMenu, 6, MF_BYPOSITION
'Lastly, we remove the seperator bar
RemoveMenu hSysMenu, 5, MF_BYPOSITION
End Sub

Function DisableMaxWindowButton(H As Long)
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Const SWP_FRAMECHANGED = &H20
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Dim nStyle As Long
nStyle = GetWindowLong(H, GWL_STYLE)
Call SetWindowLong(H, GWL_STYLE, nStyle And Not WS_MAXIMIZEBOX)
SetWindowPos H, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE
End Function

Function GetWindowCaption(H As Long) As String
Dim StrName As String * 255
GetWindowText H, StrName, Len(StrName)
GetWindowCaption = StrName
End Function

Function RestrictMouseRegion(Optional ByVal hWnd As Long = 0)
Dim recTargetWindow As RECT
If hWnd Then
GetClientRect hWnd, recTargetWindow
ClientToScreen hWnd, recTargetWindow
ClientToScreen hWnd, recTargetWindow.Right
ClipCursor recTargetWindow
Else
ClipCursor ByVal 0&
End If
End Function

Function GetActiveWindowHWND() As Long
GetActiveWindowHWND = GetForegroundWindow
End Function

Function MoveWindow(H As Long, X As Long, Y As Long, WDTH As Long, HGHT As Long)
SetWindowPos H, HWND_MOVE, X, Y, WDTH, HGHT, SWP_MOVE Or SWP_MOVE
End Function

Function Close_Window(H As Long)
Close_Window H
End Function

Function Find_Window(Window_Title As String) As Long 'Return hwnd
Find_Window = FindWindow(vbNullString, Window_Title)
End Function

Function GetWindowProcessID(H As Long) As Long
Dim svar As Long, S As Long
svar = GetWindowThreadProcessId(H, S)
GetWindowProcessID = S
End Function

Function GetWindowTop(H As Long) As Long
Dim rctTemp As RECT
GetWindowRect H, rctTemp
GetWindowTop = rctTemp.Top
End Function
Function GetWindowLeft(H As Long) As Long
Dim rctTemp As RECT
GetWindowRect H, rctTemp
GetWindowLeft = rctTemp.Left
End Function
Function GetWindowHeight(H As Long) As Long
Dim rctTemp As RECT
GetWindowRect H, rctTemp
GetWindowHeight = rctTemp.Bottom - rctTemp.Top
End Function
Function GetWindowRight(H As Long) As Long
Dim rctTemp As RECT
GetWindowRect H, rctTemp
GetWindowRight = rctTemp.Right - rctTemp.Left
End Function

Function IsMaximized(H As Long) As Boolean
IsMaximized = CBool(IsZoomed(H))
End Function

Function IsEnabled(H As Long) As Boolean
IsEnabled = IsWindowEnabled(H)
End Function

Function IsVisible(H As Long) As Boolean
IsVisible = IsWindowVisible(H)
End Function

Function IsMinimized(H As Long) As Boolean
IsMinimized = IsIconic(H)
End Function

Public Function GetCapture() As Long
'End Function
GetCapture = M_GetCapture()
End Function

Function Hollow_window(FN As String, H As Long) 'Need SkinForm.dll ********************************
Dim lRegion As Long
'Me.Picture1.Picture = LoadPicture("d:\aa.bmp")
lRegion = TransparentForm(FN)
Call SetWindowRgn(H, lRegion, True)
End Function