This is a piece of code I wrote a while back to solve the annoyance of VB6 not always correctly repainting its various windows when another program's window moves off of them.
For years, I've just kept a shortcut to this program on my taskbar, and I click it anytime VB6 windows need a repaint.
To use it, just create a project with one module and no forms. This program just executes its Sub Main and then it's done.
I use it all the time, so I thought I'd share.
For years, I've just kept a shortcut to this program on my taskbar, and I click it anytime VB6 windows need a repaint.
To use it, just create a project with one module and no forms. This program just executes its Sub Main and then it's done.
I use it all the time, so I thought I'd share.
Code:
Option Explicit
'
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi" (ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleFileNameEx Lib "psapi" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetModuleBaseName Lib "psapi" Alias "GetModuleBaseNameA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
'
Private Const RDW_INVALIDATE = &H1
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const GWL_STYLE As Long = (-16)
Private Const WS_VISIBLE = &H10000000
'
Dim lTheProcessIdMatch As Long
Dim hWndCount As Long
Dim hWnds() As Long
'
Private Sub Main()
Dim hWindows() As Long
Dim i As Long
'
hWindows = hWndOfAllTopLevelWindows
For i = 1 To UBound(hWindows)
If WindowIsVisible(hWindows(i)) Then
If LCase$(ExeFileName(hWindows(i))) = "vb6.exe" Then
RedrawWindow hWindows(i), ByVal 0&, ByVal 0&, RDW_INVALIDATE
End If
End If
Next i
End Sub
Private Function EnumWindowsCallBack(ByVal hwnd As Long, ByVal lpData As Long) As Long
' Only the API calls this. It should not be called by user.
'
' This callback function is called by Windows (from the EnumWindows
' API call) for EVERY window that exists. It populates the aWindowList
' array with a list of windows that we are interested in.
'
EnumWindowsCallBack = 1
'
If lTheProcessIdMatch = 0 Or ProcessId(hwnd) = lTheProcessIdMatch Then
hWndCount = hWndCount + 1
If UBound(hWnds) < hWndCount Then ReDim Preserve hWnds(1 To UBound(hWnds) + 100)
hWnds(hWndCount) = hwnd
End If
End Function
Private Function hWndOfAllTopLevelWindows(Optional lProcessIdMatch As Long = 0) As Long()
'
' The EnumWindows function enumerates all top-level windows
' on the screen by passing the handle of each window, in turn,
' to an application-defined callback function. EnumWindows
' continues until the last top-level window is enumerated or
' the callback function returns FALSE.
'
' This can also be done with GetWindows, but this is more reliable and with less risk of crashing because of windows destroyed while looping.
lTheProcessIdMatch = lProcessIdMatch
hWndCount = 0
ReDim hWnds(1 To 100)
EnumWindows AddressOf EnumWindowsCallBack, &H0 ' Doesn't return until done.
If hWndCount > 0 Then
ReDim Preserve hWnds(1 To hWndCount)
Else
Erase hWnds
End If
'
hWndOfAllTopLevelWindows = hWnds
End Function
Private Function ExeFileName(hWndOfInterest As Long, Optional FullSpec As Boolean = False) As String
Dim rtn As Long
Dim lProcMods() As Long
Dim sFileName As String * 260
Dim lSize As Long
Dim lRequired As Long
Dim hProcess As Long
Dim hWndOfFormWithFocus As Long
Dim l As Long
'
lSize = 4
ReDim lProcMods(0)
'
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessId(hWndOfInterest))
' Enumerate modules.
rtn = EnumProcessModules(hProcess, lProcMods(0), lSize, lRequired)
' If array is not large enough to hold all results, number of bytes required is in lRequired.
If lRequired > lSize Then
lSize = lRequired
ReDim lProcMods(0 To (lSize / 4) - 1)
rtn = EnumProcessModules(hProcess, lProcMods(0), lSize, lRequired)
End If
' lProcMods() now holds the list of module handles associated with the process.
' The zeroth element is the main program.
If FullSpec Then
rtn = GetModuleFileNameEx(hProcess, lProcMods(0), sFileName, Len(sFileName))
Else
rtn = GetModuleBaseName(hProcess, lProcMods(0), sFileName, Len(sFileName))
End If
ExeFileName = Left$(sFileName, rtn)
rtn = CloseHandle(hProcess)
End Function
Private Function WindowIsVisible(hWndOfInterest As Long) As Boolean
WindowIsVisible = ((GetWindowLong(hWndOfInterest, GWL_STYLE) And WS_VISIBLE) = WS_VISIBLE)
End Function
Private Function ProcessId(hWndOfInterest As Long) As Long
' This process ID is unique to the entire application to which the window belongs.
' A process ID will always be unique for each running copy of an application, even if more than one copy is running.
Dim lProcId As Long
Call GetWindowThreadProcessId(hWndOfInterest, lProcId)
ProcessId = lProcId
End Function