So I have a method I am using to which I can integrate powerpoint into a panel. I use the FindWindow and SetParent functions to achieve this:
Dim proc as integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
Private Declare Function SetParent Lib "user32" Alias "SetParent" (ByVal hWndChild As IntPtr, ByVal hWndNewParent As IntPtr) As Integer
Public Sub embed_Window()
Do Until proc <> 0
proc = FindWindow(vbNullString, window_name)
Loop
SetParent(proc, Panel1.Handle)
End Sub
This part works fine for embedding another window into my panel control. My question is, how can I close the window that is now in my panel? I can no longer use the FindWindow method as it is not a window in the task bar anymore.
In order to close an opened window you need to use PostMessage:
Private Declare Auto Function PostMessage Lib "user32" (ByVal hwnd As Integer, ByVal message As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Boolean
Public Const WM_CLOSE = &H10
Public Sub CloseWindow()
PostMessage(proc, WM_CLOSE, 0, 0)
End Sub
Related
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'm working on an Excel Workbook that uses VBA for data input, since I don't want the application itself to be available to the user if the user does not know the password.
I managed to set up the Userform for data input and then a new Userform for the password input.
However, I noticed that the password is easily bypassed if the Password Userform is terminated.
I tried to make the Userform_Terminate() take the user back to the previous Userform, but it just creates an endless loop.
Anyone know a workaround for this?
Private Sub UserForm_Terminate()
Unload Me
UserForm1.Show
End Sub
If what you need is disallowing user closing UserForm, then here is a solution.
Disable leaving form with either close button click or Alt+F4:
Code within UserForm:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub
Make close button on form unclickable and grayed out:
Code within UserForm:
Private Sub UserForm_Initialize()
DisableCloseButton (Me.Caption) 'disable close button (X)
End Sub
Code within a module, works for 32 and 64 bit:
Option Explicit
Private Const MF_BYPOSITION = &H400
Private Const MF_REMOVE = &H1000
#If VBA7 Then '64 bit
Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetMenuItemCount Lib "User32" (ByVal hMenu As LongPtr) As LongPtr
Private Declare PtrSafe Function GetSystemMenu Lib "User32" (ByVal hwnd As LongPtr, ByVal bRevert As LongPtr) As LongPtr
Private Declare PtrSafe Function RemoveMenu Lib "User32" (ByVal hMenu As LongPtr, ByVal nPosition As LongPtr, ByVal wFlags As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private hwnd As LongPtr
#Else '32 bit
Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long
Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private hwnd As Long
#End If
Public Sub DisableCloseButton(ByVal formCaption As String) 'deactivates the upper right "x" in the user form
#If VBA7 Then '64 bit
Dim hMenu As LongPtr, menuItemCount As LongPtr
#Else '32 bit
Dim hMenu As Long, menuItemCount As Long
#End If
hwnd = FindWindow(vbNullString, formCaption) 'Obtain the window handle to the userform
hMenu = GetSystemMenu(hwnd, 0) 'Obtain the handle to the form's system menu
'Clear list box
If hMenu Then
menuItemCount = GetMenuItemCount(hMenu) 'Obtain the number of items in the menu
'Remove the system menu Close menu item. The menu item is 0-based, so the last item on the menu is menuItemCount - 1
Call RemoveMenu(hMenu, menuItemCount - 1, MF_REMOVE Or MF_BYPOSITION)
Call RemoveMenu(hMenu, menuItemCount - 2, MF_REMOVE Or MF_BYPOSITION) 'Remove the system menu separator line
Call DrawMenuBar(hwnd) 'Force a redraw of the menu. This refreshes the titlebar, dimming the X
End If
End Sub
I use this code to create a caret in a textbox (vb.net):
Private Declare Function CreateCaret Lib "user32" (ByVal hwnd As Long, ByVal hBitmap As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DestroyCaret Lib "user32" () As Long
Private Declare Function SetCaretBlinkTime Lib "user32" (ByVal wMSeconds As Long) As Long
Private Declare Function SetCaretPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function ShowCaret Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function HideCaret Lib "user32" (ByVal hwnd As Long) As Long
Private Sub txtOutput_GotFocus(sender As Object, e As EventArgs) Handles txtOutput.GotFocus
CreateCaret(txtOutput.Handle, IntPtr.Zero, 9, 12)
ShowCaret(txtOutput.Handle)
End Sub
Is it possible to change the color of the caret?
The problem you have is your PInvoke functions aren't declared properly. Look them up and match them with http://pinvoke.net/.
The calls to create the caret will take a bitmap handle. So depending on what your caret looks like, you just need to create a bitmap and pass it to the CreateCaret function to change it's color. Here's some (very) rough code I used to change the caret color of a regular textbox. Just note that I only changed CreateCaret and ShowCaret to the proper signatures from http://www.pinvoke.net. You will have to change the rest.
Public Class Form1
Private Declare Function CreateCaret Lib "user32" (ByVal hWnd As IntPtr, ByVal hBitmap As IntPtr, ByVal nWidth As Integer, ByVal nHeight As Integer) As Boolean
Private Declare Function DestroyCaret Lib "user32" () As Long
Private Declare Function SetCaretBlinkTime Lib "user32" (ByVal wMSeconds As Long) As Long
Private Declare Function SetCaretPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function ShowCaret Lib "user32" (ByVal hwnd As IntPtr) As Boolean
Private Declare Function HideCaret Lib "user32" (ByVal hwnd As Long) As Long
Private caretBitmap as Bitmap
Private Sub txtOutput_GotFocus(sender As Object, e As EventArgs) Handles txtOutput.GotFocus
If caretBitmap Is Nothing Then
caretBitmap = CreateCaretBitmap()
End If
CreateCaret(txtOutput.Handle, caretBitmap.GetHbitmap(), 5, 10)
ShowCaret(txtOutput.Handle)
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Function CreateCaretBitmap() As Bitmap
Dim flag As New Bitmap(5, 5)
Dim flagGraphics As Graphics = Graphics.FromImage(flag)
flagGraphics.FillRectangle(Brushes.Chartreuse, 0, 0, 5, 10)
Return flag
End Function
End Class
You can create the bitmap however you want obviously.
Hope that helps.
I want to send "{TAB}" Key to another application window(send the key to the window not to textbox).
I tried:
SendMessage(hWnd, WM_SETHOTKEY, VK_TAB, 0)
Nothing happened.
my goal is:
send tab key to my application Or other application when the application window is not in focus.
(i know that sendkey is not professional in this case there is no choice(This is the first time that I'm using it).)
I made many attempts and I always returned to the same result:
Nothing happened.
Does anyone know the answer?
SendKeys requires the application that you are sending the Keys to, to be active.
From above Link:
Use SendKeys to send keystrokes and keystroke combinations to the active application.
I order to get around this limitation you will have to resort to using the WinApi Functions.
FindWindow pInvoke.net
FindWindowEx pInvoke.net
sendMessage pInvoke.net
See this MSDN Forum Post for an example
Here is a modified example from that Posting:
Public Class Form1
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd As IntPtr, ByVal hWndChildAfterA As IntPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As IntPtr
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, ByVal lParam As String) As IntPtr
Const WM_SETTEXT As Integer = &HC
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim destination As IntPtr = FindWindow(Nothing, "Untitled - Notepad")
Dim destControl As IntPtr = FindWindowEx(destination, IntPtr.Zero, "Edit", Nothing)
SendMessage(destControl, WM_SETTEXT, IntPtr.Zero, "Hello" & vbTab & "GoodBye" & vbCrLf)
End Sub
End Class
Added an Additional Example using WM_KEYDOWN I created another small application with the Window Title set to TestForm and overrode the WndProc Method to determine if the application got the TabKey.
Sending Form
Public Class Form1
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
Const WM_KEYDOWN As Integer = &H100
Const VK_TAB As Integer = &H9
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim destination As IntPtr = FindWindow(Nothing, "TestForm")
SendMessage(destination, WM_KEYDOWN, VK_TAB, 0)
End Sub
End Class
Test Form
Put a breakpoint on MyBase.WndProc(m) and look at m to see what has been sent.
Public Class Form1
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
End Sub
End Class
Having struggled with this type of this a few times before, i would suggest a couple of things to look at.
The 1st is autoit which includes a dll you can reference from vb.net, and is very simple you use, and well documented. I tend to use that whenever i need to control a 3rd party program.
The other is the ui automation classes
See this for an example:
http://blog.functionalfun.net/2009/06/introduction-to-ui-automation-with.html
you need make the other window active first. check Change focus to another window in VB.NET . then use send key.
Heres my code that does not work:
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
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
Dim wHandle As Long = FindWindow(vbNullString, "Ultima Online")
PostMessage(wHandle, MOUSEEVENTF_LEFTDOWN, 0, 0)
PostMessage(wHandle, MOUSEEVENTF_LEFTUP, 0, 0)
I'm not sure why this code should work - it seems you're just clicking on the window, not on a specific button.
To minimize windows you could use another api function: SetWindowPlacement,
see: http://www.codeproject.com/KB/dialog/Minimizewindow.aspx
Another idea: If you want a hacky solution you can send the keys Alt+Space n to minimize a window, but this is very hacky, and works only for English machines:
SendKeys ("% n") ''//in vb6
SendKeys.Send("% n") ''//in vb.net