So Logitech keyboard s/w engineers in all their wisdom decided to implement a popup ever time you switch an application that you have custom keyboard script mapping for. Meaning that you get this pop all the time when switching for explorer to chrome to desktop to whatever. I wrote to tek support and they said in the next update it'll be addressed though that was 3 months ago and I found ppl moaning to them about this F.ing feature for a over a year and a half.
So I wrote some code to kill it.
Imports System.Runtime.InteropServices
Public Class Form1
gtr; DllImport("user32.dll", EntryPoint:="FindWindowW" lesr;
Public Shared Function FindWindowW(<MarshalAs(UnmanagedType.LPTStr)> ByVal lpClassName As String, <MarshalAs(UnmanagedType.LPTStr)> ByVal lpWindowName As String) As IntPtr
End Function
gtr; DllImport("user32", EntryPoint:="SendMessageA", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True) lesr;
Public Shared Function SendMessageByString(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, <MarshalAs(UnmanagedType.VBByRefStr)> ByRef lParam As String) As Integer
End Function
Public Const WM_SYSCOMMAND As Integer = 274
Public Const SC_CLOSE As Integer = 61536
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim hWnd As IntPtr = FindWindowW("Qt5QWindowToolSaveBits", "Logitech Gaming Software")
If hWnd !== IntPtr.Zero Then
Label1.Text = "Found"
SendMessageByString(hWnd, WM_SYSCOMMAND, SC_CLOSE, 0)
Else
Label1.Text = "Nothing"
End If
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ShowInTaskbar = False
NotifyIcon1.Visible = True
End Sub
Private Sub CloseToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles CloseToolStripMenuItem.Click
Me.Close()
End Sub
End Class
So nub of this is the timer runs every 200 ms and closes the window if it is there. And it works fine but surely, and I will call you Surely, there is a better way? As you can see its coded in VB net but a bit altered to get around the code tag mangaling. I feel that this code is causing some unwanted windows problems I have that I won't go into.
Ideas ppl?
Related
I'm attempting to create a VB6 executable (not sure of the proper syntax) that will toggle the X-Mouse option in Tweak UI under Windows 98SE. Ideally, I would like to have two scripts - one that turns it off (regardless of its state) and one that turns it on (again, regardless of its state).
I have been able to open the TweakUI control panel with the code below.
Private Sub Form_Load()
Call Shell("rundll32.exe shell32.dll,Control_RunDLL tweakui.cpl", vbNormalFocus)
End Sub
If possible, I would like it to do it without opening the TweakUI control panel.
As far as I can tell, changing the registry setting doesn't work as I would have to reboot the computer for that to take effect.
I have Registry Monitor 7.04 running. It captures the following:
Path: C:\WINDOWS\RUNDLL32.EXE
Command Line: "C:\WINDOWS\RUNDLL32.EXE" "C:\WINDOWS\SYSTEM\TWEAKUI.CPL", Tweak UI
Other: hKey: 0xC2A066F0
Honestly, I'm not sure how to move forward.
Not sure the best way to show progress on this, I'll just edit.
This code is very close.
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SETACTIVEWINDOWTRACKING = 4097
'Click on this button to Activate XMouse
Private Sub Command1_Click()
SystemParametersInfo SPI_SETACTIVEWINDOWTRACKING, 0, True, 0
End Sub
'Click on this button to Deactivate XMouse
Private Sub Command2_Click()
SystemParametersInfo SPI_SETACTIVEWINDOWTRACKING, 0, False, 0
End Sub
Button 1 works correctly and Activates XMouse. But button two does not deactivate it.
SPI_SETACTIVEWINDOWTRACKING is the parameter that does this.
systemparametersinfo is the function call that gets or sets settings like this. See https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-systemparametersinfoa
There is sample code using systemparametersinfo that changes the wallpaper. https://winsourcecode.blogspot.com/2019/06/changewallpaper.html
Thank you to all of the input. I was able to solve this problem.
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByVal lpvParam As Boolean, ByVal fuWinIni As Long) As Long
Const SPI_SETACTIVEWINDOWTRACKING = 4097
Private Sub Command1_Click()
retVal = SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING, 0, True, 0)
End Sub
Private Sub Command2_Click()
retVal = SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING, 0, False, 0)
End Sub
In addition to the help here, I stumbled upon a few gems that gave me what I needed.
Control the mouse speed under Windows 98 / 2000
and
Controling Active Window Tracking
A couple things of note. I had to include this or else nothing happened:
Const SPI_SETACTIVEWINDOWTRACKING = 4097
Also, the 3rd parameter was
ByRef lpvParam As Boolean
Instead of
ByVal lpvParam As Boolean
I was passing a pointer to a pointer instead of a pointer to a value
I've searched, and can't seem to find an answer, so any help would be appreciated.
I want to make a hotkey, but when the hotkey is pressed, I don't want the actual "character" to be displayed, just the action to be performed.
So for example, I have this:
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As KeyCodeConstants) As Long
Private Const VK_A = &H41
Private Sub keyboardTimer001_Timer()
If KeyDown(VK_A) Then
' do my stuff, but DONT DISPLAY the letter "A"
End If
end sub
So this basically just has a timer (interval 1) checking the async keyboard. If it detects that the letter "a" was pressed, I perform an action. But I want it to do this WITHOUT printing the letter "a".
How would I remove the key from the keyboard buffer/prevent it from displaying? (Side note - not sure if something like 'PeekMessage' would work - if so - does anyone know where I can find a good vb6 code sample where I can peek for stuff like 'ctrl+a' or 'ctrl+alt+a', etc, etc and then just clear the buffer, and perform my action?)
Thanks!
You can use a combination of RegisterHotKey and PeekMessage. The following code defines Key-A and Ctrl-A to perform actions:
Main Form
Option Explicit
Private Done As Boolean
Private Sub Form_Activate()
Done = False
RegisterHotKey Me.hWnd, &HBBBB&, MOD_NONE, vbKeyA
RegisterHotKey Me.hWnd, &HBBBA&, MOD_CONTROL, vbKeyA
ProcessMessages
End Sub
Private Sub ProcessMessages()
Dim Message As Msg
Do While Not Done
WaitMessage
If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
If Message.wParam = &HBBBB& Then
MsgBox "This is my Key-A action"
ElseIf Message.wParam = &HBBBA& Then
MsgBox "This is my Ctrl-A action"
End If
End If
DoEvents
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
Done = True
Call UnregisterHotKey(Me.hWnd, &HBBBB&)
Call UnregisterHotKey(Me.hWnd, &HBBBA&)
End Sub
The above code works well, but in a production app I might lean towards subclassing the main window. If you prefer subclassing, you will need to use a technique of your choosing and replace the ProcessMessages method with something like this:
Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_HOTKEY
If wParam = &HBBBB& Then
MsgBox "This is my Key-A action"
ElseIf wParam = &HBBBA& Then
MsgBox "This is my Ctrl-A action"
End If
End Select
End Function
As you can see, subclassing is a little cleaner. Of course, you need to define the Win API stuff. So in a module, place the following code:
Module
Option Explicit
Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Public Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Public Declare Function WaitMessage Lib "user32" () As Long
Public Const MOD_NONE = &H0
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const MOD_WIN = &H8
Public Const PM_REMOVE = &H1
Public Const WM_HOTKEY = &H312
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type Msg
hWnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
The Problem
Call a procedure whenever the Main Excel Window is resized.
First attempt:
Sub Workbook_WindowResize(ByVal Wn As Window)
Debug.Print Wn.Width & "x" & Wn.Height
End Sub
Results:
The sub routine is called whenever the 'inner' workbook window is resized but not when the application window is resized. I.E. occcurs on resize of the Multiple Document Interface child containing the application instance.
Second attempt
Dim WithEvents App As Application
Private Sub App_WindowResize(ByVal Wb As Workbook, ByVal Wn As Window)
Debug.Print Wn.Width & "x" & Wn.Height
End Sub
Results:
Oddly, the same thing that happened before occurs, which definitely surprised me. The event only occurs when the workbook window is resized instead of the application window.
For this reason I started looking into using the windows API.
There are many examples of setting SystemWide keyboard and mouse hooks using the windows APIs. This is along the same lines:
Public Enum enHookTypes
WH_CALLWNDPROC = 4
WH_CALLWNDPROCRET = 12
WH_CBT = 5
WH_DEBUG = 9
WH_FOREGROUNDIDLE = 11
WH_GETMESSAGE = 3
WH_HARDWARE = 8
WH_JOURNALPLAYBACK = 1
WH_JOURNALRECORD = 0
WH_MOUSE = 7
WH_MSGFILTER = (-1)
WH_SHELL = 10
WH_SYSMSGFILTER = 6
WH_KEYBOARD_LL = 13
WH_MOUSE_LL = 14
WH_KEYBOARD = 2
End Enum
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As LongPtr
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
'Ensure that your hook procedure does not interfere with the normal operation of other hook procedures
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public hndl As Long
Sub HookWindow()
hndl = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf measureWindow, Application.Hinstance, 0&)
Debug.Print hndl & "~~" & GetLastError()
End Sub
Sub unhookWindow()
ret = UnhookWindowsHookEx(hndl)
Debug.Print ret
End Sub
Public Sub measureWindow(code As Long, wParam As Long, lParam As Long)
If code > 0 Then
Debug.Print ThisWorkbook.Windows(1).Width & "x" & ThisWorkbook.Windows(1).Height
Else
ret = CallNextHookEx(measureWindow, code, wParam, lParam)
End If
End Sub
Results:
If I replace the WH_CALLWNDPROC in:
hndl = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf measureWindow, Application.Hinstance, 0&)
with WH_KEYBOARD_LL the sub-routine is called whenever a key is pressed. Similarly, if I replace it with WH_MOUSE_LL the sub-routine is called whenever the mouse is moved or a mouse button pressed.
The problem is that when I try to hook the sub-routine to WH_CALLWNDPROC nothing happens?
Why?
I'm still not sure, but the same is true for all ENUMS in enHookTypes except WH_MOUSE_LL and WH_KEYBOARD_LL. Looking through the WinAPI documentation I read that you can use GetLastError from Kernel32.dll do get some indication of why the operation failed.
The error numbers I have got so far are (in decimal) error 5 (for JOURNAL hooks) and error 1428 for the rest.
Ultimately this also failed.
Application.Windows is a collection of window objects of Worbooks opened within the Application. The WindowResize event is raised when a non-maximized window changes size. The Workbook_WindowResize(ByVal Wn As Window) is exposed within the workbook object itself. The Application_WindowResize(ByVal Wb as Workbook, ByVal Wn As Window) event has to do with ANY/ALL of the workbooks within the Application when a non-maximized workbook's window changes size. Hence the difference in references passed in by the events. It is just a Window in the first case, of the workbook that raised the event, within the workbook object, and there is no question here which window it is (it's the "Me" workbook's window). It is both the Workbook and that workbook's window when it is raised at the Application level since the workbook the event relates to needs identification :) And no, Excel does not have a "Resize" event for the App window itself and you would need to go to APIs for that.
With the later Excel versions (past the 2010), there is ONE workbook per Excel Application window, the workbook's window is always maximized in the old sense, and both Workbook and Application events refer to the same workbook and would work just as you would want them to.
Solution , create a timer event that checks and compares the width every few seconds...
Sub my_ONTIME()
application.OnTime Now + TimeValue("00:00:2"), "my_TIMEREVENT"
End Sub
Sub my_TIMEREVENT()
If application.Width <> EWIDTHR Then ESCREENRESIZE
my_ONTIME
End Sub
Sub ESCREENRESIZE()
Dim EWIDTH As Single
Dim ESIDE As Single
Dim EMID As Single
EWIDTH = application.Width
EWIDTHR = EWIDTH
If EWIDTH < 500 Then
EWIDTH = 500
application.Width = 500
End If
EMID = 80 * 5.41
ESIDE = ((EWIDTH - EMID) / 2) / 5.41
Sheet1.Columns("A:A").ColumnWidth = ESIDE
Sheet1.Columns("C:C").ColumnWidth = ESIDE
End Sub
I created a form that has 2 buttons. One button pops a msgbox and the other runs form frmAPI (code is listed below) listed below. If I open the msgbox and leave it open and then run the frmAPI it will list the msgbox and its text and then close it. THis is what I expect it to do. If I open another application and generate a msgbox in that app with my frmAPI still running it will in fact list the other apps msgbox and the text but it does not close the msgbox from the other app. If Irun the frmAPI from the other app and do the same test the results are reversed. So in short it will only close the dialog from within the same app.
I would like to be able to close a dialog from any app based on it being a dialog and having text that will match my criteria. Any help on what I am doing wrong?
Thanks
Imports System.Runtime.InteropServices
Imports System.Text
Partial Public Class TestMSgBoxStuff
Inherits Form
Public Sub New()
InitializeComponent()
End Sub
<DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function FindWindow(lpClassName As String, lpWindowName As String) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function FindWindowEx(hwndParent As IntPtr, hwndChildAfter As IntPtr, lpszClass As String, lpszWindow As String) As IntPtr
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Private Shared Function GetWindowText(hWnd As IntPtr, lpString As StringBuilder, nMaxCount As Integer) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function GetWindowTextLength(hWnd As IntPtr) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function SendMessage(hWnd As HandleRef, Msg As UInteger, wParam As IntPtr, lParam As IntPtr) As IntPtr
End Function
<DllImport("user32", CharSet:=Runtime.InteropServices.CharSet.Auto, SetLastError:=True, ExactSpelling:=True)>
Private Shared Function SetForegroundWindow(ByVal hwnd As IntPtr) As IntPtr
End Function
Private Const WM_IME_NOTIFY As Integer = &H282
Private Const WM_DESTROY As Integer = &H2
Private Const WM_NCDESTROY As Integer = &H82
Private Const WM_CLOSE As Integer = &H10
Private Const IMN_CLOSESTATUSWINDOW As Integer = &H1
Private Const WM_KILLFOCUS As Integer = &H8
Private Const WM_COMMAND As Integer = &H11
Private Sub TestMSgBoxStuff_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim timer As New Timer()
Timer1.Interval = 10000
'detect the MessageBox every seconds
'Timer1.Tick += New EventHandler(Timer1_Tick)
Timer1.Start()
End Sub
Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
'Get the MessageBox handle
Dim handle As IntPtr = FindWindow("#32770", Nothing)
Me.RichTextBox1.AppendText("Handle: " + handle.ToString() + vbLf)
'Get the Text window handle
Dim txtHandle As IntPtr = FindWindowEx(handle, IntPtr.Zero, "Static", Nothing)
Me.RichTextBox1.AppendText(vbTab & "text handle: " + txtHandle.ToString() + vbLf)
Dim len As Integer = GetWindowTextLength(txtHandle)
Dim sb As New StringBuilder()
'Get the text
GetWindowText(txtHandle, sb, len + 1)
Me.RichTextBox1.AppendText(vbTab & "text: " + sb.ToString() + vbLf & vbLf)
Me.RichTextBox1.ScrollToCaret()
SetForegroundWindow(handle)
'close the messagebox WM_CLOSE
Dim lResults As Integer = SendMessage(New HandleRef(Nothing, handle), WM_NCDESTROY, IntPtr.Zero, IntPtr.Zero)
End Sub
End Class
You may be running into User Interface Privilege Isolation. That'll block your messages from going to a higher privilege process. See also ChangeWindowsMessageFilter()
I'd suggest trying to send it a WM_COMMAND instead of a WM_CLOSE; WM_COMMAND is generally treated more gently by the system and may get through. Use BN_CLICKED as the high word of WPARAM and IDOK as the low word (assuming it has an OK button), and the handle to the OK button in LPARAM.. Other button messages are here.
Before you make a comment saying its a redundant question, please allow me to put up the details:
Situation:
Though I know VB, I never get a chance to create a DLL with the help of Visual Studio 2010 using VB
Steps tried:
Launch VS 2010 and created a Project by selecting "VB Class library
(.dll)"
Created a Class [say Maths.vb] with following code:
Namespace Maths
Public Class Maths
Public Const DLL_PROCESS_DETACH = 0
Public Const DLL_PROCESS_ATTACH = 1
Public Const DLL_THREAD_ATTACH = 2
Public Const DLL_THREAD_DETACH = 3
Public Function DllMain(ByVal hInst As Long, ByVal fdwReason As Long,
ByVal lpvReserved As Long) As Boolean
MsgBox("A")
Select Case fdwReason
Case DLL_PROCESS_DETACH
' No per-process cleanup needed
Case DLL_PROCESS_ATTACH
MsgBox("A")
DllMain = True
Case DLL_THREAD_ATTACH
' No per-thread initialization needed
Case DLL_THREAD_DETACH
' No per-thread cleanup needed
' Case Else
' DllMain = False
End Select
End Function
Public Function AxIncrement(ByVal var As Integer) As Integer
If Not IsNumeric(var) Then Err.Raise(5)
AxIncrement = var + 1
End Function
Public Function AxDecrement(ByVal var As Integer) As Integer
If Not IsNumeric(var) Then Err.Raise(5)
AxDecrement = var - 1
End Function
Public Function AxSquare(ByVal var As Long) As Long
If Not IsNumeric(var) Then Err.Raise(5)
AxSquare = var ^ 2
End Function
End Class
End Namespace
Do Right Click on Project and Create a Build >> This step will give
you a dll created Maths.dll
Now Close the Project and create a New Project Say StandardEXE
Create a Form [say Form1.vb] with three buttons and put the following
code by clicking View Code:
Pulic Class Form1
Dim incr As Integer
Dim decr As Integer
Dim sqr As Long
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
incr = 1
decr = 100
sqr = 2
End Sub
Private Sub cmdSquare_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdSquare.Click
sqr = AxSquare(sqr)
cmdSquare.Text = "x = " & CStr(sqr)
End Sub
Private Sub cmdIncrement_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdIncrement.Click
incr = Increment(incr)
cmdIncrement.Text = "x = " & CStr(incr)
End Sub
Private Sub cmdDecrement_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdDecrement.Click
decr = Increment(decr)
cmdDecrement.Text = "x = " & CStr(decr)
End Sub
End Class
Right Click on Project and Select Add >> Module1.vb . Paste the below
code:
Module Module1
Public Declare Function Increment Lib "C:\PracProj\Maths\Maths\bin\Release\Maths.dll" (ByVal var As Integer) As Integer
Public Declare Function Decrement Lib "C:\PracProj\Maths\Maths\bin\Release\Maths.dll" (ByVal var As Integer) As Integer
Public Declare Function AxSquare Lib "C:\PracProj\Maths\Maths\bin\Release\Maths.dll" (ByVal var As Long) As Long
Public Declare Function DllMain Lib "C:\PracProj\Maths\Maths\bin\Release\Maths.dll" (ByVal hInst As Long, ByVal fdwReason As Long, ByVal lpvReserved As Long) As Boolean
End Module
Where "C:\PracProj\Maths\Maths\bin\Release\Maths.dll" is the path of previous created DLL
Now Run the Form1.Vb
You will find the form gets visible and once you click on any of the button you will get the Error saying "Unable to find an entry point named 'AxSquare' in DLL 'C:\PracProj\Maths\Maths\bin\Release\Maths.dll'."
And I tried every thing and not able to solve this.
Please guide me with the missing steps.