Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing clsWindowController.cls (20.93 KB)
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsWindowController"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
' clsWindowController: exposes a window-controller interface
'
' Copyright (c) 2008 JaviteSoft ( http://www.javitesoft.com )
Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable 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 FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function FlashWindow Lib "user32" (ByVal hWnd As Long, ByVal bInvert As Long) 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 GetClientRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) 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 GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function IsWindowApi Lib "user32" Alias "IsWindow" (ByVal hWnd As Long) As Long
Private Declare Function IsWindowEnabled Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function IsZoomed Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) 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 SendMessageByLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) As Long
Private Declare Function SetFocus 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 ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const WM_CHAR = &H102
Private Const WM_CLOSE = &H10
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_SETTEXT = &HC
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const VK_SPACE = &H20
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Public Enum ClickButtonMethods
BTN_DEFAULT = 0
BTN_LBTN_DOWN = 1
BTN_LBTN_UP = 2
BTN_LBTN_DBLCLICK = 3
BTN_RBTN_DOWN = 4
BTN_RBTN_UP = 5
BTN_RBTN_DBLCLICK = 6
End Enum
Private m_hWnd As Long
Private m_topMost As Boolean
Public Function InitByHandle(ByVal hWnd As Long) As clsWindowController
m_hWnd = hWnd
m_topMost = False
Set InitByHandle = Me
End Function
Public Function InitByWindow(Optional ByVal ClassName As String = vbNullString, Optional ByVal WindowText As String = vbNullString) As clsWindowController
Set InitByWindow = InitByHandle(FindWindow(ClassName, WindowText))
End Function
Public Property Get hWnd() As Long
hWnd = m_hWnd
End Property
Public Property Get hWndParent() As Long
hWndParent = GetParent(m_hWnd)
End Property
Public Property Let hWndParent(ByVal newParent As Long)
SetParent m_hWnd, newParent
End Property
Public Property Get Parent() As clsWindowController
Dim thisParent As New clsWindowController
Set Parent = thisParent.InitByHandle((m_hWnd))
End Property
Public Property Set Parent(ByVal newParent As clsWindowController)
SetParent m_hWnd, newParent.hWnd
End Property
Public Property Get ClassName() As String
Dim strClass As String
strClass = Space(255)
GetClassName m_hWnd, strClass, Len(strClass)
If InStr(strClass, vbNullChar) > 0 Then _
strClass = Left(strClass, InStr(strClass, vbNullChar) - 1)
ClassName = Trim(strClass)
End Property
Public Property Get AlwaysOnTop() As Boolean
AlwaysOnTop = m_topMost
End Property
Public Property Let AlwaysOnTop(ByVal value As Boolean)
m_topMost = value
Dim wFlag As Long
If value Then
wFlag = HWND_TOPMOST
Else
wFlag = HWND_NOTOPMOST
End If
SetWindowPos m_hWnd, wFlag, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE
End Property
Public Property Get Enabled() As Boolean
Enabled = CBool(IsWindowEnabled(m_hWnd))
End Property
Public Property Let Enabled(ByVal bEnabled As Boolean)
EnableWindow m_hWnd, Abs(CInt(bEnabled))
End Property
Public Property Get Visible() As Boolean
Visible = CBool(IsWindowVisible(m_hWnd))
End Property
Public Property Let Visible(ByVal bVisible As Boolean)
If bVisible Then
ShowWindow m_hWnd, SW_SHOW
Else
ShowWindow m_hWnd, SW_HIDE
End If
End Property
Public Property Get Text() As String
Dim CaptionLength As Long
Dim Caption As String
CaptionLength = GetWindowTextLength(m_hWnd)
Caption = String(CaptionLength, vbNullChar)
GetWindowText m_hWnd, Caption, CaptionLength + 1
If Caption = "" Then
CaptionLength = SendMessage(m_hWnd, WM_GETTEXTLENGTH, 0&, 0&)
Caption = String(CaptionLength, 0&)
SendMessageByString m_hWnd, WM_GETTEXT, CaptionLength + 1, ByVal Caption
End If
Text = Caption
End Property
Public Property Let Text(ByVal value As String)
SendMessageByString m_hWnd, WM_SETTEXT, 0&, ByVal value
End Property
Public Property Get Left() As Long
Dim wndRect As RECT
GetWindowRect m_hWnd, wndRect
Left = wndRect.Left
End Property
Public Property Let Left(ByVal value As Long)
Dim wndRect As RECT
GetWindowRect m_hWnd, wndRect
SetWindowPos m_hWnd, 0&, value, wndRect.Top, _
wndRect.Right, wndRect.Bottom, _
SWP_NOACTIVATE Or SWP_NOSIZE
End Property
Public Property Get Top() As Long
Dim wndRect As RECT
GetWindowRect m_hWnd, wndRect
Top = wndRect.Top
End Property
Public Property Let Top(ByVal value As Long)
Dim wndRect As RECT
GetWindowRect m_hWnd, wndRect
SetWindowPos m_hWnd, 0&, wndRect.Left, value, _
wndRect.Right, wndRect.Bottom, _
SWP_NOACTIVATE Or SWP_NOSIZE
End Property
Public Property Get Width() As Long
Dim wndRect As RECT
GetWindowRect m_hWnd, wndRect
Width = wndRect.Right - wndRect.Left
End Property
Public Property Let Width(ByVal value As Long)
Dim wndRect As RECT
GetWindowRect m_hWnd, wndRect
SetWindowPos m_hWnd, 0&, wndRect.Left, wndRect.Top, _
value, wndRect.Bottom - wndRect.Top, _
SWP_NOACTIVATE Or SWP_NOMOVE
End Property
Public Property Get Height() As Long
Dim wndRect As RECT
GetWindowRect m_hWnd, wndRect
Height = wndRect.Bottom - wndRect.Top
End Property
Public Property Let Height(ByVal value As Long)
Dim wndRect As RECT
GetWindowRect m_hWnd, wndRect
SetWindowPos m_hWnd, 0&, wndRect.Left, wndRect.Top, _
wndRect.Right - wndRect.Left, value, _
SWP_NOACTIVATE Or SWP_NOMOVE
End Property
Public Property Get WindowState() As Long
If IsIconic(m_hWnd) Then
WindowState = SW_MINIMIZE
ElseIf IsZoomed(m_hWnd) Then
WindowState = SW_MAXIMIZE
Else
WindowState = SW_NORMAL
End If
End Property
Public Property Let WindowState(ByVal WindowState As Long)
ShowWindow m_hWnd, WindowState
End Property
Public Property Get HasChildren() As Boolean
HasChildren = Not (FindWindowEx(m_hWnd, 0, vbNullString, vbNullString) = 0)
End Property
Public Function SendMsg(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Object, Optional ByVal forceByVal As Boolean = False) As Long
If forceByVal Then
SendMsg = SendMessage(m_hWnd, wMsg, wParam, ByVal lParam)
Else
SendMsg = SendMessage(m_hWnd, wMsg, wParam, lParam)
End If
End Function
Public Function SendMsgByRef(ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Object, Optional ByVal forceByVal As Boolean = False) As Long
If forceByVal Then
SendMsgByRef = SendMessage(m_hWnd, wMsg, wParam, ByVal lParam)
Else
SendMsgByRef = SendMessage(m_hWnd, wMsg, wParam, lParam)
End If
End Function
Public Function SendMsgLong(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, Optional ByVal forceByVal As Boolean = False) As Long
If forceByVal Then
SendMsgLong = SendMessageByLong(m_hWnd, wMsg, wParam, ByVal lParam)
Else
SendMsgLong = SendMessageByLong(m_hWnd, wMsg, wParam, lParam)
End If
End Function
Public Function SendMsgLongByRef(ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Long, Optional ByVal forceByVal As Boolean = False) As Long
If forceByVal Then
SendMsgLongByRef = SendMessageByLong(m_hWnd, wMsg, wParam, ByVal lParam)
Else
SendMsgLongByRef = SendMessageByLong(m_hWnd, wMsg, wParam, lParam)
End If
End Function
Public Function SendMsgString(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String, Optional ByVal forceByVal As Boolean = False) As Long
If forceByVal Then
SendMsgString = SendMessageByString(m_hWnd, wMsg, wParam, ByVal lParam)
Else
SendMsgString = SendMessageByString(m_hWnd, wMsg, wParam, lParam)
End If
End Function
Public Function SendMsgStringByRef(ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As String, Optional ByVal forceByVal As Boolean = False) As Long
If forceByVal Then
SendMsgStringByRef = SendMessageByString(m_hWnd, wMsg, wParam, ByVal lParam)
Else
SendMsgStringByRef = SendMessageByString(m_hWnd, wMsg, wParam, lParam)
End If
End Function
Public Sub PostMsg(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
PostMessage m_hWnd, wMsg, wParam, lParam
End Sub
Public Function GetNextSibling() As clsWindowController
' return next sibling
Dim siblingWnd As New clsWindowController
Set GetNextSibling = siblingWnd.InitByHandle(FindWindowEx(Me.hWndParent, m_hWnd, vbNullString, vbNullString))
End Function
Public Function GetPreviousSibling() As clsWindowController
' get first child of the parent
Dim hWndSibling As Long
Dim hWndLastSibling As Long
hWndSibling = FindWindowEx(Me.hWndParent, 0, vbNullString, vbNullString)
Do While hWndSibling
' check sibling
If hWndSibling = m_hWnd Then
hWndSibling = hWndLastSibling
Exit Do
End If
' get next sibling
hWndSibling = FindWindowEx(Me.hWndParent, hWndSibling, vbNullString, vbNullString)
Loop
Dim siblingWnd As New clsWindowController
Set GetPreviousSibling = siblingWnd.InitByHandle(hWndSibling)
End Function
Public Function GetSibling(Optional ByVal ClassName As String = vbNullString, Optional ByVal WindowText As String = vbNullString) As clsWindowController
Dim siblingWnd As New clsWindowController
Set GetSibling = siblingWnd.InitByHandle(FindWindowEx(Me.hWndParent, 0, ClassName, WindowText))
End Function
Public Function GetTopLevelParent() As clsWindowController
Dim parentWnd As Long
Dim parentWnd2 As Long
parentWnd = Me.hWndParent
parentWnd2 = parentWnd
Do While parentWnd
parentWnd2 = parentWnd
parentWnd = GetParent(parentWnd)
Loop
Dim parentWndObj As New clsWindowController
Set GetTopLevelParent = parentWndObj.InitByHandle(parentWnd2)
End Function
Public Function GetFirstChild() As clsWindowController
Dim childWnd As New clsWindowController
Set GetFirstChild = childWnd.InitByHandle(FindWindowEx(m_hWnd, 0, vbNullString, vbNullString))
End Function
Public Function GetLastChild() As clsWindowController
' get first child
Dim hWndChild As Long
Dim hWndLastChild As Long
hWndChild = FindWindowEx(m_hWnd, 0, vbNullString, vbNullString)
hWndLastChild = hWndChild
Do While hWndChild
hWndLastChild = hWndChild
' get next child
hWndChild = FindWindowEx(m_hWnd, hWndChild, vbNullString, vbNullString)
Loop
Dim childWnd As New clsWindowController
Set GetLastChild = childWnd.InitByHandle(hWndLastChild)
End Function
Public Function GetChild(Optional ByVal ClassName As String = vbNullString, Optional ByVal WindowText As String = vbNullString) As clsWindowController
Dim childWnd As New clsWindowController
Set GetChild = childWnd.InitByHandle(FindWindowEx(m_hWnd, 0, ClassName, WindowText))
End Function
Public Function GetMenu() As clsMenuController
Dim menuController As New clsMenuController
Set menuController = menuController.InitByHandle(m_hWnd)
Set GetMenu = menuController
End Function
Public Function GetWindowHandle() As Long
GetWindowHandle = m_hWnd
End Function
Public Property Get IsWindow() As Boolean
IsWindow = CBool(IsWindowApi(m_hWnd))
End Property
Public Sub CloseWindow()
PostMessage m_hWnd, WM_CLOSE, 0, 0
End Sub
Public Sub Flash()
FlashWindow m_hWnd, 1
End Sub
Public Sub Refresh()
Dim wndRect As RECT
GetClientRect m_hWnd, wndRect
InvalidateRect m_hWnd, wndRect, 1
End Sub
Public Sub Focus()
' set focus to this window
SetFocus m_hWnd
End Sub
Public Sub Update()
' tell the window to redraw itself
UpdateWindow m_hWnd
End Sub
Public Sub ClickButton(ByVal ClickMethod As ClickButtonMethods)
Select Case ClickMethod
Case ClickButtonMethods.BTN_DEFAULT
SendMessage m_hWnd, WM_KEYDOWN, VK_SPACE, ByVal vbNullString
SendMessage m_hWnd, WM_KEYUP, VK_SPACE, ByVal vbNullString
Case ClickButtonMethods.BTN_LBTN_UP
SendMessage m_hWnd, WM_LBUTTONDOWN, 0, ByVal 0
Case ClickButtonMethods.BTN_LBTN_DOWN
SendMessage m_hWnd, WM_LBUTTONUP, 0, ByVal 0
Case ClickButtonMethods.BTN_LBTN_DBLCLICK
SendMessage m_hWnd, WM_LBUTTONDBLCLK, 0, ByVal 0
Case ClickButtonMethods.BTN_RBTN_UP
SendMessage m_hWnd, WM_RBUTTONDOWN, 0, ByVal 0
Case ClickButtonMethods.BTN_RBTN_DOWN
SendMessage m_hWnd, WM_RBUTTONUP, 0, ByVal 0
Case ClickButtonMethods.BTN_RBTN_DBLCLICK
SendMessage m_hWnd, WM_RBUTTONDBLCLK, 0, ByVal 0
End Select
End Sub
Public Function SendText(ByVal strText As String, Optional ByVal sendInterval As Long = 10) As Boolean
Dim i As Long
Dim KeyCode As Long
Dim thisChar As String
For i = 1 To Len(strText)
thisChar = Mid(strText, i, 1)
If thisChar = "{" And InStr(i, strText, "}") > i Then
Select Case UCase(Mid(strText, i, InStr(i, strText, "}") - i + 1))
Case "{BACKSPACE}", "{BS}", "{BKSP}": KeyCode = 8
Case "{BREAK}": KeyCode = 19
Case "{DELETE}", "{DEL}": KeyCode = 46
Case "{DOWN}": KeyCode = 40
Case "{END}": KeyCode = 35
Case "{ENTER}": KeyCode = 13
Case "{ESC}": KeyCode = 27
Case "{HOME}": KeyCode = 36
Case "{INSERT}", "{INS}": KeyCode = 45
Case "{LEFT}": KeyCode = 37
Case "{NUMLOCK}": KeyCode = 144
Case "{PGDN}": KeyCode = 34
Case "{PGUP}": KeyCode = 33
Case "{PRTSC}": KeyCode = 44
Case "{RIGHT}": KeyCode = 39
Case "{SCROLLLOCK}": KeyCode = 145
Case "{TAB}": KeyCode = 9
Case "{UP}": KeyCode = 38
Case "{F1}": KeyCode = 112
Case "{F2}": KeyCode = 113
Case "{F3}": KeyCode = 114
Case "{F4}": KeyCode = 115
Case "{F5}": KeyCode = 116
Case "{F6}": KeyCode = 117
Case "{F7}": KeyCode = 118
Case "{F8}": KeyCode = 119
Case "{F9}": KeyCode = 120
Case "{F10}": KeyCode = 121
Case "{F11}": KeyCode = 122
Case "{F12}": KeyCode = 123
Case "{+}": KeyCode = 107
Case "{^}": KeyCode = 94
Case "{%}": KeyCode = 37
End Select
If KeyCode > 0 Then i = InStr(i, strText, "}")
Else
KeyCode = TranslateKey(Asc(thisChar))
End If
SendKeyApi KeyCode, m_hWnd, sendInterval
Next i
SendText = True
End Function
Public Sub VBSendKeys(ByVal strInput As String, Optional ByVal wait As Boolean = False)
SendKeys strInput, wait
End Sub
Private Sub SendKeyApi(ByVal KeyCode As Long, ByVal hWnd As Long, _
Optional ByVal sendInterval As Integer = 0)
Dim ScanCode As String
ScanCode = Hex(MapVirtualKey(KeyCode, 0)) ' Get scancode for key
ScanCode = String(2 - Len(ScanCode), "0") & ScanCode ' Pad with zeros to get 2 digit number...
PostMessage hWnd, WM_KEYDOWN, KeyCode, CLng("&H00" & ScanCode & "0001")
Sleep sendInterval
If Not ((KeyCode >= 42 And KeyCode <= 57) Or _
(KeyCode >= 64 And KeyCode <= 93) Or _
(KeyCode >= 97 And KeyCode <= 122) Or KeyCode = 32) Then _
PostMessage hWnd, WM_CHAR, KeyCode, CLng("&H00" & ScanCode & "0001")
PostMessage hWnd, WM_KEYUP, KeyCode, CLng("&HC0" & ScanCode & "0001")
End Sub
Private Function TranslateKey(ByVal KeyAscii As Integer) As Long
Select Case True
' numbers 0 - 9
Case (KeyAscii >= 48 And KeyAscii <= 57)
TranslateKey = 48 + (KeyAscii - 48)
' letters A-Z, a-z
Case (KeyAscii >= 65 And KeyAscii <= 90) Or _
(KeyAscii >= 97 And KeyAscii <= 122)
TranslateKey = 65 + (Asc(LCase(Chr(KeyAscii))) - 97)
' multiply (*)
Case KeyAscii = 42
TranslateKey = 106
' subtract (-)
Case KeyAscii = 45
TranslateKey = 109
' addition (+)
Case KeyAscii = 43
TranslateKey = 107
' decimal (.)
Case KeyAscii = 46
TranslateKey = 110
' divide (/)
Case KeyAscii = 47
TranslateKey = 111
' separator (_)
Case KeyAscii = 95
TranslateKey = 108
' everything else
Case Else
TranslateKey = KeyAscii
End Select
End Function
Download clsWindowController.cls