I have a really huge project with hundreds of thousands lines of code.
My application has a complex graphical interface.
For some reason, sometimes my main form is resized, and I just don't see why / how this happens.
To track down the reason for the resizing, I installed a window subclass.
Private Sub iSubclass_WndProc(ByVal bBefore As Boolean, bHandled As Boolean, lReturn As Long, ByVal lng_hWnd As Long, ByVal uMsg As eMsg, ByVal wParam As Long, ByVal lParam As Long, lParamUser As Long)
These are the parameters of the window message for WM_SIZING when this undesired resize occurs:
wParam = 9
lParam = 1697980
lParamUser = 0
The resizing only occurs only like once each 2 hours, so debugging is really difficult already.
How could I track any further who / which function is responsible for the resizing?
Related
I'm trying to fasten up the loading of one form, which populates several combobox with a big amount of data. I did my best stopping the UI while loading ecc shredding the loading time from 20s to 13s, but still the only bottleneck remaining is loading data into ComboBox which takes about 3-4s each. I did research on the internet and found that using Windows API you can fasten it up a lot more. So I did the code:
Private Const CB_ERR As Integer = -1
Private Const CB_ADDSTRING As Integer = &H143
Private Const CB_SETITEMDATA As Integer = &H151
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Function SendMessage(ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As String) As Integer
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Function SendMessage(ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Object) As Integer
End Function
Public Sub AddItem(cmb As ComboBox, Item As Object)
Dim l As Integer
l = SendMessage(cmb.Handle, CB_ADDSTRING, 0&, Item.ToString())
SendMessage(cmb.Handle, CB_SETITEMDATA, l, Item)
End Sub
But on CB_ADDSTRING the program crashes with this error (that can be catched):
InvalidArgument=Value of '0' not valid for 'index'. Parameter Name: index
Since I'm using Krypton Controls, I had to shuffle trough Parents until I found KryptonComboBox, and then pass it's Handle value.
WinRestore,% hwnd([1])
i have found in many programming language the use of hwnd. after searching on google it comes out to be handle. I didnt got more information on this. how programmer knows the value to put in, eg.
Const LB_GETTEXTLEN = &H18A
Const LB_GETTEXT = &H189
Const LB_GETCOUNT = &H18B
&h18a how he known, how will he use this?
this is the example program
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
Const LB_GETTEXTLEN = &H18A
Const LB_GETTEXT = &H189
Const LB_GETCOUNT = &H18B
Private Function GetListItems(ByVal hList As Long) As Variant
Dim i As Long, nCount As Long, lItemLength As Long
Dim sItem() As String
nCount = SendMessage(hList, LB_GETCOUNT, 0, ByVal 0&)
For i = 0 To nCount - 1
lItemLength = SendMessage(hList, LB_GETTEXTLEN, i, ByVal 0&)
ReDim Preserve sItem(i)
sItem(i) = String(lItemLength, 0)
Call SendMessage(hList, LB_GETTEXT, i, ByVal sItem(i))
Next i
GetListItems = sItem
End Function
there are many such examples in all different languages but concept will be the same. so i want to learn it. what does it mean and how to use it.
another example from ahk
Gui,2:+hwndhwnd
hwnd(2,hwnd)
Those are all window messages that you can find information about on the MSDN Documentation by googling them. See below links:
LB_GETTEXTLEN
LB_GETTEXT
LB_GETCOUNT
You can find them and other related messages by checking the documentation for the native List Box control.
As for the numbers they're hexadecimal numbers which are (usually) mentioned in the documentation. But since these aren't you'll have to google them and check other websites/forums, or find their values on your own by experimenting with them in C or C++ .
In VB hexadecimal numbers are represented by prepending the number with &H, whereas in C, C++, C# or alike they're prepended with 0x.
In a forms editor each window/control has a hwnd property. For windows not created by your forms package you use the API calls FindWindow (easiest but not reliable) or EnumWindows. Also GetForegroundWindow and GetDesktopWindow.
To find out the value of constants you download the C header files as part of the Windows SDK https://developer.microsoft.com/en-us/windows/downloads/windows-10-sdk. It also has the documentation for all these API calls. This is online documentation listing all the windows' functions https://msdn.microsoft.com/en-us/library/windows/desktop/ms633505(v=vs.85).aspx.
All.
I'm attempting to develop a 'sidebar' application with vb6, which I want to behave like windows Vista's gadget sidebar or Google Desktop sidebar, in the respect that other windows could not maximize over it.
I'm aware that chances of this happening are probably very little, but I'm asking just in case.
Currently, I've got a form that has multiple controls, and runs a function on load which makes itself the exact height of the screen, minus the taskbar, and it's 'left' location is set by a timer to be 'screen.width - me.width', so it will start at full height on the far right of the screen, and cannot be moved. Code for the height is as follows, if it is necessary.
Declare Function GetUserNameA Lib "advapi32.dll" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32" ( _
ByVal hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
Private Const ABM_GETTASKBARPOS = &H5
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type APPBARDATA
cbSize As Long
hwnd As Long
uCallbackMessage As Long
uEdge As Long
rc As RECT
lParam As Long
End Type
Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long
Function Fixheight()
Dim ABD As APPBARDATA
SHAppBarMessage ABM_GETTASKBARPOS, ABD
Form1.Height = Screen.Height - ((ABD.rc.Bottom - ABD.rc.Top) * 12)
If Form1.Height <= 600 Then
Form1.Height = Screen.Height
End If
End Function
To be clear, I do not want an 'always on top' function. I already have that, and it's driving me insane, as the form has to me closed or minimized in order to maximize, minimize of close another program (i.e. chrome, word, etc) behind it. This form must instead not allow other programs to maximize over it, so that if for example, the user maximized Chrome, chrome would maximize minus form1.width.
I doubt that this is possible because as far as I'm concerned, that would mean taking control of chrome, and essentially making it's maximize function as
me.height = screen.height - ((ABD.rc.Bottom - ABD.rc.Top) * 12)
me.width = screen.width - form1.width
which isn't possible.
Anyway, hopefully someone out there can help. As I said, I seriously doubt the possibility of having this work, but if so, all the better.
Thanks in advance!
Thanks to Ken White, I googled SHAppBarMessage and found the following website, offering a downloadable source with the very feature I needed. I just have to implement it now!!
Very glad I asked! Thank you!
Edit: Found this spanish website, which while needed some help from Google Translate, is more suited to my needs. Just need to figure out how to make it work on the Right Hand Side! Thanks again!
So I want to use
pid = Shell(MyApp, 1)
with VBA to automate the use of a crappy external program. This program unfortunately has all sorts of annoying dialog boxes and popups that must be clicked. Is there any way to directly control each dialog box to ensure that the "OK" button is pressed rather than "Cancel"?
Currently I am using
AppActivate pid
Application.SendKeys ("%R")
But this command can only guarantee the "OK" of the initial pop-up dialog. Subsequent pop-ups may not be clicked, especially because I'm not sure how to guarantee focus on the new popup. Is there a way to find the child process ID's of any new popups? Is there any way to directly "click" a particularly labeled control button?
How to Interact with a Button on a Dialog
Well, there is a way of sending a WM_COMMAND message to common buttons on a dialog box effectively closing it:
Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal Msg As Integer, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const WM_COMMAND As Integer = 273
Const WM_CLOSE As Integer = 16
Const IDOK As Integer = 1
Const IDCANCEL As Integer = 2
Sub ShowDialogs()
If Shell("C:\Users\myself\dialogs.exe") <> 0 Then
Dim hWnd As Long
hWnd = FindWindowA("#32770", "Info")
Debug.Print hWnd
SendMessageA hWnd, WM_COMMAND, IDOK, 0
End If
End Sub
Important Notes:
I had to use Spy++ to find out what class name Windows gives to message box dialogs.
The Windows SDK headers contained useful constants, especially the value for WM_COMMAND which was obtained from WinUser.h.
Each time a dialog is a created, you will need to obtain the handle for the window again using FindWindowA, as shown in the preceding code.
hello friends，i want to monitor an IP address control's（created by CreateWindowEx） input events which is on a form.i have used the API SetWindowsHookEx to hook WH_GETMESSAGE message ,but now i cannt eat the input message as (MSG)lParam->message = WM_NULL like in C,So i need your help,friends. can you give me the solution?
here is the code:
Private Function GetMsgProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
CopyMemory p, ByVal lParam, LenB(p)
If p.message = WM_RBUTTONDOWN And GetParent(p.hWnd) = lngHWNDCtl Then
GetMsgProc = 0
Else
GetMsgProc = CallNextHookEx(hHook, nCode, wParam, ByVal lParam)
End If
End Function
Public Sub SetHook(ByVal lngThread As Long, lngHWND As Long, bFlag As Boolean)
If bFlag Then
lngHWNDCtl = lngHWND
hHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMsgProc, 0, lngThread)
Else
If hHook Then UnhookWindowsHookEx hHook
End If
End Sub
Skipping the call to CallNextHookEx in GetMsgProc filter function is generally a bad idea. If you do this then other filter functions in the chain will not be called. Maybe, there are none on a dev machine, but 'in the wild' there will be other applications that installed hooks. Those applications will misbehave if you prevent their filter functions from being called.
You probably wouldn't want to analyze messages that have been merely peeked from the queue, but not removed from it. GetMsgProc is called with wParam = PM_REMOVE for messages that have been removed from queue.
VB6 or C++ or whatever, it is a deadly practice to ignore MSDN specification for API. This is how GetMsgProc filter function should make a decision based on a value of its first argument:
code [in]
Specifies whether the hook procedure must process the
message. If code is HC_ACTION, the hook procedure must process the
message. If code is less than zero, the hook procedure must pass the
message to the CallNextHookEx function without further processing and
should return the value returned by CallNextHookEx.
http://msdn.microsoft.com/en-us/library/windows/desktop/ms644981%28v=vs.85%29.aspx
Although CopyMemory should work (assuming you declare it correctly), I wouldn't bother with it here. It's perfectly OK to declare 3rd parameter of filter function as ByRef lParam As MSG.
Here is the code that should be placed in a standard module (as any other code that installs hooks). It works for me if I use it to sniff WM_RBUTTONDOWN messages to, say, TextBox control placed on a main form.
Option Explicit
'http://msdn.microsoft.com/en-us/library/windows/desktop/dd162805%28v=vs.85%29.aspx
Private Type tagPOINT
x As Long
y As Long
End Type
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms644958%28v=vs.85%29.aspx
Private Type MSG
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As tagPOINT
End Type
Private bHooked As Boolean
Private hHook As Long
Private hHwndToSniff As Long
Private Const HC_Action As Long = &H0
Private Const PM_NOREMOVE As Long = &H0
Private Const PM_REMOVE As Long = &H1
Private Const WH_GETMESSAGE As Long = &H3
Private Const WM_RBUTTONDOWN As Long = &H204
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms644974%28v=vs.85%29.aspx
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms644990%28v=vs.85%29.aspx
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms644993%28v=vs.85%29.aspx
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Public Sub RemoveHook()
If bHooked Then
UnhookWindowsHookEx hHook
bHooked = False
End If
End Sub
Public Sub SetHook(ByVal hThreadToHook As Long, hHwndFilter As Long)
If Not bHooked Then
hHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMsgProc, 0, hThreadToHook)
If hHook > 0 Then
bHooked = True
hHwndToSniff = hHwndFilter
Else
Debug.Assert False
End If
End If
End Sub
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms644981%28v=vs.85%29.aspx
Private Function GetMsgProc(ByVal uCode As Long _
, ByVal wParam As Long _
, ByRef lParam As MSG) As Long
If uCode = 0 Then
If wParam = PM_REMOVE Then
If lParam.message = WM_RBUTTONDOWN Then
If lParam.hWnd = hHwndToSniff Then
MsgBox "You right-clicked a text box!"
End If
End If
End If
End If
GetMsgProc = CallNextHookEx(hHook, uCode, wParam, lParam)
End Function
The hook is installed in a form module in the following fashion:
SetHook App.ThreadID, Me.Text1.hWnd