I would like to get the scaling factor of a secondary screen.
With this piece of code I get the right information for the primary monitor:
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As IntPtr, ByVal nIndex As Integer) As Integer
Private Declare Function GetDCEx Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal hrgnClip As IntPtr, ByVal DeviceContextValues As DeviceContextValues) As IntPtr
Dim desktop As IntPtr = GetDCEx(0, 0, DeviceContextValues.Window)
Dim scalling As Double = GetDeviceCaps(desktop, 118) / GetDeviceCaps(desktop, 8)
But how can I get the same information for the 2nd monitor?
Which parameters in the GetDCEx function?
thanks it's help me this is the solution :
<DllImport("gdi32.dll")>
Public Shared Function GetDeviceCaps(ByVal hDC As IntPtr, ByVal nIndex As Integer) As Integer
End Function
<DllImport("gdi32.dll", SetLastError:=True, CharSet:=CharSet.Ansi)>
Public Shared Function CreateDC(<MarshalAs(UnmanagedType.LPStr)> lpszDriver As String,
<MarshalAs(UnmanagedType.LPStr)> lpszDevice As String,
<MarshalAs(UnmanagedType.LPStr)> lpszOutput As String,
lpInitData As IntPtr) As IntPtr
End Function
Public Shared Function GetScalleFactor(index As Integer) As Double
Dim desktop As IntPtr = CreateDC(Screen.AllScreens(index).DeviceName, Nothing, Nothing, IntPtr.Zero)
Return GetDeviceCaps(desktop, 118) / GetDeviceCaps(desktop, 8)
End Function
Related
The Goal:
I am trying to create a Visual Basic program that will execute some code whenever any new program window is displayed on screen. Just for an easy to understand example: When I launch a program like File Explorer, I want a message box to be displayed when the window for File Explorer is displayed on screen.
The Problem:
Using the code I provided below, my desired outcome works correctly. However, it will also display a message box whenever something like a context menu is displayed as well. I do not want this. I only want a message box to be displayed whenever an actual program window is displayed. I've tried adding checks for checking if the window has 'minimize', 'maximize', and 'close' buttons. But after adding those checks, a message box no longer gets displayed at all, even with a window that has caption buttons, like File Explorer.
This is my code:
Private Declare Function GetForegroundWindow Lib "user32.dll" () As IntPtr
Declare Auto Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Integer, ByVal eventMax As Integer, ByVal hmodWinEventProc As IntPtr, ByVal lpfnWinEventProc As WinEventDelegate, ByVal idProcess As Integer, ByVal idThread As Integer, ByVal dwflags As Integer) As IntPtr
Declare Auto Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As IntPtr) As Boolean
Delegate Sub WinEventDelegate(ByVal hWinEventHook As IntPtr, ByVal eventType As Integer, ByVal hwnd As IntPtr, ByVal idObject As Integer, ByVal idChild As Integer, ByVal dwEventThread As Integer, ByVal dwmsEventTime As Integer)
Const WINEVENT_OUTOFCONTEXT As Integer = 0
Const EVENT_OBJECT_CREATE As Integer = &H8000
Private hook As IntPtr = IntPtr.Zero
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
hook = SetWinEventHook(EVENT_OBJECT_CREATE, EVENT_OBJECT_CREATE, IntPtr.Zero, AddressOf WinEventProc, 0, 0, WINEVENT_OUTOFCONTEXT)
End Sub
Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed
UnhookWinEvent(hook)
End Sub
Private Sub WinEventProc(ByVal hWinEventHook As IntPtr, ByVal eventType As Integer, ByVal hwnd As IntPtr, ByVal idObject As Integer, ByVal idChild As Integer, ByVal dwEventThread As Integer, ByVal dwmsEventTime As Integer)
Dim windowTitle As String = GetWindowText(hwnd)
If windowTitle <> "" AndAlso IsPopupWindow(hwnd) Then
msgbox("New Window Detected")
End If
End Sub
Private Function IsPopupWindow(ByVal hwnd As IntPtr) As Boolean
Dim style As Long = GetWindowLong(hwnd, GWL_STYLE)
Return (style And WS_POPUP) = WS_POPUP
End Function
Declare Auto Function GetWindowLong Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal nIndex As Integer) As Integer
Private Const GWL_STYLE As Integer = -16
Private Const WS_POPUP As Long = &H80000000
Private Function GetWindowText(ByVal hwnd As IntPtr) As String
Dim textLength As Integer = GetWindowTextLength(hwnd) + 1
Dim text As String = New String(" "c, textLength)
GetWindowText(hwnd, text, textLength)
Return text.Trim()
End Function
Declare Auto Function GetWindowText Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal lpString As String, ByVal nMaxCount As Integer) As Integer
Declare Auto Function GetWindowTextLength Lib "user32.dll" (ByVal hWnd As IntPtr) As Integer
What approach could I use to better listen for the creation of new program windows? Or, how could I fix my code?
EVENT_OBJECT_CREATE gets triggered for all kinds of objects, not just windows. You will have to retrieve the created object's window class name via GetClassName() and ignore whichever classes you don't want to process. Menus have a standard class name of #32768.
I found a code which would help one of my projects. However I can't use it in my 64bit MS Access.
This was the original post How to get Application name from process name?
Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As Int32, ByRef lpdwProcessId
As Int32) As Int32
Private Declare Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow" () As IntPtr
'Private Declare Auto Function GetWindowText Lib "user32" (ByVal hWnd As System.IntPtr, ByVal
lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer
Private makel As String
Private Function GetActiveAppProcess() As Process
Dim activeProcessID As IntPtr
GetWindowThreadProcessId(GetForegroundWindow(), activeProcessID)
Return Process.GetProcessById(activeProcessID)
End Function
Sub GetProcInfo()
Dim activeProcess As Process = GetActiveAppProcess()
With activeProcess
ApplicationName = .MainModule.FileVersionInfo.FileDescription
ProcessName = .ProcessName
WindowTitle = .MainWindowTitle
End With
End Sub
I know how to click a button of another application using the codes below. But now I need to know how to change the selected value of a combo box.
'Declaration
Private Declare Auto Function FindWindow Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Private Declare Auto Function FindWindowEx Lib "user32.dll" (ByVal hWndParent As IntPtr, ByVal hWndChildAfter As IntPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As IntPtr
Declare Auto Function PostMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As IntPtr, ByRef lParam As IntPtr) As IntPtr
Private Const BM_CLICK = &HF5
'Usage
Dim ButtonHandle As IntPtr
Dim MainWindowHandle As IntPtr
MainWindowHandle = FindWindow(FormClass, FormCaption)
ButtonHandle = FindWindowEx(MainWindowHandle, IntPtr.Zero, TargetClass, TargetCaption)
If ButtonHandle <> 0 Then
PostMessage(ButtonHandle, BM_CLICK, 0, 0)
End If
All I need to do is to change the combobox selected value of a different application from its default value of Off to a value of On. Any help is very much appreciated. Thank You.
Finally I now know how to do this. The code that I used is shown below.
'Declaration
Private Declare Auto Function FindWindow Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Private Declare Auto Function FindWindowEx Lib "user32.dll" (ByVal hWndParent As IntPtr, ByVal hWndChildAfter As IntPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As IntPtr
Declare Auto Function PostMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As IntPtr, ByRef lParam As IntPtr) As IntPtr
Private Const BM_CLICK = &HF5
Private Const CB_SETCURSEL = &H14E
'Usage
Dim MainWindowHandle As IntPtr
Dim ChildAfter As IntPtr
Dim ComboBoxHandle As IntPtr
'Get the Handle
MainWindowHandle = FindWindow(FormClass, FormCaption)
'Get the ChildAfter of the Combo Box
ChildAfter = FindWindowEx(MainWindowHandle, IntPtr.Zero, ChildClass, ChildCaption)
'Get the handle of the combobox dropdown
ComboBoxHandle = FindWindowEx(MainWindowHandle, ChildAfter, "ComboBox", vbNullString)
'Select combo box index(1)
PostMessage(ComboBoxHandle, CB_SETCURSEL, 1, 0)
From the MSDN documentation of FindWindowEx:
hwndChildAfter [in, optional]
Type: HWND
A handle to a child window. The search begins with the next child window in the Z order. The child window must be a direct child window of hwndParent, not just a descendant window.
If hwndChildAfter is NULL, the search begins with the first child window of hwndParent.
#RemyLebeau Thank you so much for helping me do this.
I can't figure out how to make my ComboBox (which lists all open windows(I can see these already)) to make my form type on that selected window. I just can't make it so when screen1 is selected, it clicks on that screen.
Example:
I have 2 different forms open.
Form (1) clicks on a specified screen. (screen1)
Form (2) clicks on a different specified screen. (screen2)
The forms are the same program just opened twice.
I want my form to be able to click on a certain screen even if it's not open.
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Public Class W1
Public Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As EnumWindowsProc, ByVal lParam As Int32) As Int32
Public Declare Function IsWindowVisible Lib "user32.dll" (ByVal hwnd As IntPtr) As Boolean
Public Delegate Function EnumWindowsProc(ByVal hwnd As IntPtr, ByVal lParam As Int32) As Boolean
Public Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As IntPtr, ByVal lpString As String, ByVal cch As Int32) As Int32
Public Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hwnd As IntPtr) As Int32
Public Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As IntPtr, ByVal nIndex As Int32) As Int32
Public Declare Function GetParent Lib "user32.dll" (ByVal intptr As IntPtr) As IntPtr
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Boolean
Public Property SelectedItem As Object
Public Const GWL_HWNDPARENT As Int32 = -8
Private newwindowlist As List(Of String)
Private newhandlelist As List(Of IntPtr)
Private Structure RECT
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
Public Sub New(ByVal _left As Integer, ByVal _top As Integer, ByVal _right As Integer, ByVal _bottom As Integer)
left = _left
top = _top
right = _right
bottom = _bottom
End Sub
End Structure
Private Function EnumWinProc(ByVal hwnd As IntPtr, ByVal lParam As Int32) As Boolean
If IsWindowVisible(hwnd) Then
If GetParent(hwnd) = IntPtr.Zero Then
If GetWindowLong(hwnd, GWL_HWNDPARENT) = 0 Then
Dim str As String = String.Empty.PadLeft(GetWindowTextLength(hwnd) + 1)
GetWindowText(hwnd, str, str.Length)
If Not String.IsNullOrEmpty(str.Substring(0, str.Length - 1)) Then
newwindowlist.Add(str.Substring(0, str.Length - 1))
End If
End If
End If
End If
EnumWinProc = True
End Function
Private Sub RefreshWindowList()
newwindowlist = New List(Of String)
EnumWindows(AddressOf EnumWinProc, CInt(True))
End Sub
And
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
RefreshWindowList()
For Each item As String In newwindowlist
ComboBox1.Items.Add(item)
ComboBox1.SelectedItem = Convert.ToInt64(GWL_HWNDPARENT)
Next
End Sub
I'm attempting to intercept and interrupt mouse events. Lets say I wanted to disable the right mouse button down event, or even the mouse move event. I haven't been able to figure out the interrupting part.
I am using the (I assume pretty widely used) following code for Global Hooking of the mouse.
Private Structure MSLLHOOKSTRUCT
Public pt As Point
Public mouseData As Int32
Public flags As Int32
Public time As Int32
Public extra As IntPtr
End Structure
Private _mouseHook As IntPtr
Private Const WH_MOUSE_LL As Int32 = 14
Private Delegate Function MouseHookDelegate(ByVal nCode As Int32, ByVal wParam As IntPtr, ByRef lParam As MSLLHOOKSTRUCT) As Int32
<MarshalAs(UnmanagedType.FunctionPtr)> Private _mouseProc As MouseHookDelegate
Private Declare Function SetWindowsHookExW Lib "user32.dll" (ByVal idHook As Int32, ByVal HookProc As MouseHookDelegate, ByVal hInstance As IntPtr, ByVal wParam As Int32) As IntPtr
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hook As IntPtr) As Boolean
Private Declare Function CallNextHookEx Lib "user32.dll" (ByVal idHook As Int32, ByVal nCode As Int32, ByVal wParam As IntPtr, ByRef lParam As MSLLHOOKSTRUCT) As Int32
Private Declare Function GetCurrentThreadId Lib "kernel32.dll" () As Integer
Private Declare Function GetModuleHandleW Lib "kernel32.dll" (ByVal fakezero As IntPtr) As IntPtr
Public Function HookMouse() As Boolean
Debug.Print("Mouse Hooked")
If _mouseHook = IntPtr.Zero Then
_mouseProc = New MouseHookDelegate(AddressOf MouseHookProc)
_mouseHook = SetWindowsHookExW(WH_MOUSE_LL, _mouseProc, GetModuleHandleW(IntPtr.Zero), 0)
End If
Return _mouseHook <> IntPtr.Zero
End Function
Public Sub UnHookMouse()
Debug.Print("Mouse UnHooked")
If _mouseHook = IntPtr.Zero Then Return
UnhookWindowsHookEx(_mouseHook)
_mouseHook = IntPtr.Zero
End Sub
Private Function MouseHookProc(ByVal nCode As Int32, ByVal wParam As IntPtr, ByRef lParam As MSLLHOOKSTRUCT) As Int32
'Debug.Print("Message = {0}, x={1}, y={2}", wParam.ToInt32, lParam.pt.X, lParam.pt.Y)
If wParam.ToInt32 = 513 Then
'''interrupt the left mouse button event here, but don't know what to return to do so.
End If
Return CallNextHookEx(WH_MOUSE_LL, nCode, wParam, lParam)
End Function
Return 1 - sorry for posting this.