I'm using the InteropFormsToolkit version 2.1. I'm trying to make sure that when a .NET form loads from an event being thrown on the VB6 form, that the .NET form can stay on top. I've tried many things and can't get anything to work. I've tried everything from z-index, to adding a managed call into User32.dll to push it to the forefront, etc.
Any ideas are appreciated.
In vb6 you can use as:
Private Sub Form_Load()
OnTopMe Me, True
End Sub
and following code in module
Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long
Public Sub OnTopMe(FormID As Object, onTop As Boolean)
If onTop = True Then SetWindowPos FormID.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
If onTop = False Then SetWindowPos FormID.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
I don't know about how to do it in .Net
Related
I have created a VB6 program which runs in the background to another program. It means the program window will be in the back only to this other program. I am using this code for it,
Private Declare Function FindWindow1 Lib "User32" Alias "FindWindowA" (ByVal lpclassname As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_HWNDPARENT = -8
Private parenthwnd As Long
Private strTitle As String
Private Sub Form_Load()
strTitle = "My Program" 'Title of the program window
parenthwnd = FindWindow1(vbNullString, strTitle)
Dim R As Long
R = SetWindowLong(parenthwnd, GWL_HWNDPARENT, Me.hWnd)
End Sub
The other program will run this VB6 program which sets it-self to the background to the other program window. It works. But there are two problems.
When the VB6 program executes the code R = SetWindowLong(parenthwnd, GWL_HWNDPARENT, Me.hWnd), the other program along with VB6 program goes to the background. How to make other program active when it is run and the VB6 program is executed?
When the other program is closed, it has the code to terminate the VB6 program. But this does not close the VB6 program. I think this may be due to running the code R = SetWindowLong(parenthwnd, GWL_HWNDPARENT, Me.hWnd). How to fix this?
If I understand you question correctly (and I'm not sure I do) here's the code I use to send a form to the background or send the form to the top. Perhaps it's what you're looking for.
' Declares and constants for BringToFront and SendToBack
Public Declare Function SetWindowPos Lib "user32" (ByVal _
hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As _
Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As _
Long, ByVal wFlags As Long) As Long
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_BOTTOM = 1
Public Const HWND_TOP = 0
Public Sub BringToFront(frm As Form)
Dim flags As Long
flags = SWP_NOSIZE Or SWP_NOMOVE
SetWindowPos frm.hWnd, HWND_TOP, 0, 0, 0, 0, flags
End Sub
Public Sub SendToBack(frm As Form)
Dim flags As Long
flags = SWP_NOSIZE Or SWP_NOMOVE
SetWindowPos frm.hWnd, HWND_BOTTOM, 0, 0, 0, 0, flags
End Sub
I have an excel vba application that runs a separate process. During the external process a progress indicator with abort button is initialized. It is crucial for the end users that the abort button is available. It is also usefull to see the external process running.
I would like to have the progress indicator/abort button placed on top of the external process. but I do NOT wont to force the userform on top of everything.
I have tried to use findwindow / setwindowpos, resulting in the following problems:
If I initialize HWND_TOPMOST before running the process, then the userform is always on top, regardless of what the user wants. I find this very annoying, especially if some sort of errors occur where the debuging window might be blocked by the inactive vba userform. However the workbook remains in the background which is desired.
If I use HWND_TOP (after the external process is up and running) then the entire workbook is activated (not just the userform), which then hides to progress of the external application. Not very benificial compared to activating the workbook.
Are there any suggestions on how to put the userform in front of the external applicaiton, while still allowing the user to deactivate it?
code snippets:
Option Explicit
' Code stolen with pride from various sources.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public id As Integer
Public ProgressForm As fProgress
' Main routine, launch application and progress indicator.
Sub LoadForm()
Set ProgressForm = New fProgress
ProgressForm.Show
' Force userform to front, makes it on top but does not allow reorder of windows.
ForceToFront ProgressForm
' Run external process, notepad used for example.
id = Shell("notepad", vbNormalFocus)
End Sub
' Routine to bring userform to front after the external program is up and running.
Sub TestBringToFront()
BringToFront ProgressForm
End Sub
Sub BringToFront(fm As fProgress)
Dim hwnd As Long, ret As Variant
hwnd = FindWindow("ThunderDFrame", fm.Caption)
ret = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub
Sub ForceToFront(fm As fProgress)
Dim hwnd As Long, ret As Variant
hwnd = FindWindow("ThunderDFrame", fm.Caption)
ret = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub
Unfortunately this is the designated behaviour of windows and applications. However, I can suggest some workarounds:
Use TOPMOST option and make the userform clickable, e.g. capture the ProgressForm_Click and toggle between TOPMOST and NOTOPMOST state. ALternatively use can employ an "Always On Top" checkbox on ProgressForm like it is in the Task Manager.
Use TOP option and resize the workbook window behind to as small as possible, or even move aside (out of the screen), and restore size and position after the external app finished.
It may be worthy making a try with ProgressForm.Show(vbModeless) and TOP
I'm looking for the fastest way to take a print-screen, and i found out that using Bitblt was my better choice, however, it only works for device context handle's, which means for me to retrieve a bitmap from that, i'd have to use multiple API's including CreateCompatibleBitmap, which in the end it probably takes the same time as using a managed way, like graphics.CopyFromScreen (which is a bit slow for me and also consumes alot of CPU, between 7-10% on a 2.3ghz quad-core processor...)
However, i still searched for a cleaner way of retrieving a bitmap from it, so i came up with this code:
<DllImport("user32.dll")> _
Public Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")> _
Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
End Function
<DllImport("gdi32.dll")> _
Public Shared Function BitBlt(ByVal hdcDest As IntPtr, ByVal xDest As Integer, ByVal yDest As Integer, ByVal wDest As Integer, ByVal hDest As Integer, ByVal hdcSource As IntPtr, _
ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal rop As TernaryRasterOperations) As Boolean
End Function
Dim hwNd As IntPtr = Nothing
hwNd = GetDC(GetDesktopWindow)
picHandle = GetDC(Me.PictureBox1.Handle)
BitBlt(picHandle, 0, 0, PictureBox1.Width, PictureBox1.Height, hwNd, 0, 0, TernaryRasterOperations.SRCCOPY)
ReleaseDC(hwNd, picHandle)
I can reach ~30 fps with this... But it has two problems as i said above:
Even if displaying it on a picturebox as i'm doing it above accomplished what i want, it doesn't resize to the picturebox control, even if i change those "0" values to the picturebox x and y coordinates.
I further searched and found there's a StretchBit API for that, and it does stretch, but it also reduces quality, (Even with the necessary call to SetStretchBltMode with parameter "HALFTONE" so it doesn't "corrupt" the pixels), it also reduces performance at least in 10+ fps...
But as i need to get it as bitmap object, with the other necessary API's for that, i ended up with almost half the performance (15~ fps) which is equivalent of graphics.CopyFromScreen.
So, i'm asking, is there another way to get a bitmap from the screen using Bitblt or similar without losing performance?
If there isn't a .Net way, i kindly ask for any language-way of doing that.
If you want raw performance, you will have to get away from managed code. This is easy enough using C++ with Visual Studio. You can make calls directly to the Windows API, bypassing the .NET runtime, managed code for your application, and the overhead of p/invokes in .NET.
If you are familiar with C#, you can take your C# code, convert it to C++ (which should be straightforward, with a lot of work to replace the CLI).
Private Declare Function BitBlt Lib "GDI32" ( _
ByVal hdcDest As Integer, _
ByVal nXDest As Integer, _
ByVal nYDest As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hdcSrc As Integer, _
ByVal nXSrc As Integer, _
ByVal nYSrc As Integer, _
ByVal dwRop As System.Int32) As Boolean
Declare Function QueryPerformanceCounter Lib "Kernel32" (ByRef X As Long) As Short
Declare Function QueryPerformanceFrequency Lib "Kernel32" (ByRef X As Long) As Short
Const SRCCOPY As Integer = &HCC0020
Use a form with only a picturebox and a label in it. Set the anchors of picbox accordingly. In picbox down event:
Private Sub PictureBox1_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
Dim Ctr1, Ctr2, Freq As Long
Dim dbl As Double
QueryPerformanceCounter(Ctr1)
Dim desktopDC As IntPtr = Nothing
Dim picboxDC As IntPtr = Nothing
desktopDC = GetDC(New IntPtr(0))
picboxDC = GetDC(PictureBox1.Handle)
BitBlt(picboxDC, 0, 0, PictureBox1.Width, PictureBox1.Height, desktopDC, 0, 0, SRCCOPY)
QueryPerformanceCounter(Ctr2)
QueryPerformanceFrequency(Freq)
dbl = (Ctr2 - Ctr1) / Freq
dbl *= 1000000
Label1.Text = dbl.ToString 'it is in microseconds
ReleaseDC(New IntPtr(0), desktopDC)
ReleaseDC(PictureBox1.Handle, picboxDC)
End Sub
Maximize your form and click in picturebox.
I want to develop an app which won't allow the user to open or jump to another application while it is open. It should be in Visual Basic. For example, if my application is open (running) and the user tries to open any other windows application like "media player" then it shouldn't open. The app should not even allow "task manager" to run. The application should completely block the windows environment while it is running.
A very good question. :)
Is is possible to achieve it in VB?
The answer is Yes!
Is it Easy?
Definitely not!
However here are few tips on how to approach the problem.
1) Disable the Task Manager
Sub DisableTaskManager()
Shell "REG add HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System /v DisableTaskMgr /t REG_DWORD /d 1 /f", vbNormalFocus
End Sub
Sub EnableTaskManager()
Shell "REG add HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System /v DisableTaskMgr /t REG_DWORD /d 0 /f", vbNormalFocus
End Sub
2) Ensure your program is always on top
a) Hide the task bar
Option Explicit
'~~> http://allapi.mentalis.org/apilist/FindWindow.shtml
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long
'~~> http://allapi.mentalis.org/apilist/SetWindowPos.shtml
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
'~~> Show/Hide Taskbar
Sub Sample()
'~~> To show the taskbar
ShowTskBar True
'~~> To hide the taskbar
ShowTskBar False
End Sub
Sub ShowTskBar(ShouldI As Boolean)
Dim Sid As Long
Sid = FindWindow("Shell_traywnd", "")
If ShouldI = True Then
If Sid > 0 Then _
Sid = SetWindowPos(Sid, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
Else
If Sid > 0 Then _
Sid = SetWindowPos(Sid, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End If
End Sub
b) Show your application Always on top
'~~> http://www.allapi.net/apilist/SetWindowPos.shtml
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Private Sub Form_Activate()
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub
b) Show your application in maximized mode
Maximize your form so that the desktop shows only your form as it shows in a Kiosk application. Depending on the need you can also disable the minimize button or the title bar. In such a case do remember to add a button so that user can click that to exit the form.
3) Disable the Start Menu
This code depends on the Windows version that you are using. Do a search on Google, you will find plenty of examples.
Similarly, you have to take care of few small small things but this post will give you a good start. If you are looking for a complete solution in one place then I doubt you will ever get it ;)
HTH
Take a look at the Desktop APIi to create your own "sandbox" but very careful as it's very easy to lock yourself out of the primary desktop.
Also see this question for a bit more information.
First of all I'm a total newby in visual basic, I needed to hack an application that kept clicking (don't ask).
Everything is nice and dandy on my pc, then I compile, move it to its final destination and I doesn't work! At first I thought it was a OS problem, but both machines has win7, I then thought it was a compilation problem, installed visual studio on the other pc, recompiled still with no luck, then it dawned on me, may it be a problem of 32bit vs 64bit?
Sadly I don't have enough knowledge about it and so I ask you.
The piece of code is this:
Private Sub mainTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mainTimer.Tick
Dim keyStart As Boolean
keyStart = GetAsyncKeyState(Keys.A)
If keyStart = True Then
timeClicker.Enabled = True
timeClicker.Start()
End If
Dim keyStop As Boolean
keyStop = GetAsyncKeyState(Keys.S)
If keyStop = True Then
timeClicker.Stop()
timeClicker.Enabled = False
End If
End Sub
Private Sub timeClicker_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timeClicker.Tick
mouse_event(mouseclickdown, 0, 0, 0, 0)
mouse_event(mouseclickup, 0, 0, 0, 0)
End Sub
MainTimer has an interval of 100 and timeClicker has an interval of 10, both are declared on the form project (not in the code).
The MainTimer works perfectly (I've done tests) it's the timeClicker that doesn't work at all!
Can somebody tell me why and possibly help me understand the issue?
Thank you very much
EDIT: as requested by max
Private Declare Sub mouse_event Lib "user32" (ByVal dwflags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, ByVal dwExtraInfo As Long)
Private Const mouseclickup = 4
Private Const mouseclickdown = 2
By the way is not a problem of mouse_event, is the timer that doesn't work.
Yes, this cannot work on a 32-bit machine, it manages to scrape by on a 64-bit machine but that's sheer luck. Your pinvoke declaration dates from the VB6 era, it is quite wrong for VB.NET. Watch out for this, there are a lot of junk declarations out there. The pinvoke.net site is a good bet to get it right. Fix:
Private Declare Sub mouse_event Lib "user32" (ByVal dwflags As Integer, ByVal dx As Integer, _
ByVal dy As Integer, ByVal cbuttons As Integer, ByVal dwExtraInfo As IntPtr)
Another thing you want to do on your dev machine so you can debug this for a 32-bit machine is Project + Properties, Compile tab, scroll down, Advanced Compile Options, Target CPU = x86. Also enables Edit+Continue, you'll love it.
Note that your GetAsyncKeyState() declaration is almost certainly wrong as well. It returns Short, not Integer.
Try to declare mouse_event this way:
Private Declare Sub mouse_event Lib "user32" (ByVal dwflags As Integer, ByVal dx As Integer, ByVal dy As Integer, ByVal cbuttons As Integer, ByVal dwExtraInfo As IntPtr)
And call it this way:
mouse_event(0, 0, 0, 0, IntPtr.Zero)