A window in this VB6 legacy system that I'm supporting hosts a Word 2007 instance as a child window. On Windows 7, the parent window can be resized without any issues: the window doesn't update until the mouse is released after resizing. On Windows 10, however, the window updates dynamically while being resized.
The issue I'm encountering in Windows 10 is that the child Word window is getting activated/focused upon the first update: you can only drag to resize the parent window by a couple pixels at a time, before the child window gets focused and the resize event on the parent window is canceled (the cursor is still on the resize icon, but continued dragging has no effect). Maximizing, minimizing, and restoring the parent window all work normally. Once the child Word window is closed (through the file menu in Word), the parent window can be resized normally, because there's no child window to activate/focus. The same automatic-child-window-activation-after-parent-window-resizing occurs in Windows 7, but because the resize event doesn't fire until after the parent window has actually updated, it's not an issue there.
My conundrum is that I don't see anything in the code that suggests why the child window is getting automatically activated/focused, unless that's just default Windows behavior. In either case, I'm pretty sure I need a way to make that not happen.
All that this code is explicitly doing (primarily the ResizeControls() sub; the rest is here mostly for context) is resizing/positioning the Word window to correspond to the new size of the container in the parent window, which is consistent with the behavior in Windows 7.
From what I can tell, I don't believe that GetWindow() actually activates the window it gets a handle to, but if it does, then that's likely the cause of the issue, in which case I need to be able to get a handle to the window without activating it.
PDFView.frm:
Begin VB.Form frmPDFView
Caption = "Untitled"
ClientHeight = 8655
ClientLeft = 1320
ClientTop = 1665
ClientWidth = 9270
' ...
Begin VB.PictureBox picContainer
BackColor = &H00FFFFFF&
Height = 4215
Left = 1080
ScaleHeight = 4155
ScaleWidth = 4995
TabIndex = 0
Top = 120
Width = 5055
End
End
Private Sub ResizeControls()
On Error Resume Next
Dim pWndChild As Long
Dim r As RECT
Dim rtn As Long
picContainer.Left = 100
picContainer.Height = Me.Height - 1300
picContainer.Width = Me.Width - 350
picContainer.Top = 300
pWndChild = GetWindow(picContainer.hWnd, GW_CHILD)
rtn = GetLastError
If (pWndChild) Then
rtn = GetClientRect(picContainer.hWnd, r)
rtn = SetWindowPos(pWndChild, 0, 0, 0, r.Right - r.Left, r.Bottom - r.Top, SWP_NOZORDER Or SWP_NOMOVE)
Else
rtn = GetLastError
End If
End Sub
Private Sub Form_Resize()
On Error GoTo ERROR_HANDLER
Call ResizeControls
Exit Sub
ERROR_HANDLER:
Err.Clear
Resume Next
End Sub
Turns out I'm blind and/or didn't read the documentation thoroughly enough for all the Windows functions used in the code. Found the solution the next day and forgot to come back and answer this, but as confirmed by #wqw's comment, the issue was with SetWindowPos(). The SWP_NOACTIVATE flag needed to be passed in to SetWindowPos() to prevent activation of the target window (in my case, the child Word window).
Related
I'm iterating through all windows on the Windows desktop in order to allow disable patients select them easily in order to type into them.
I get all windows using
hw = GetDesktopWindow()
' It's first child is the 1st top level window
hw = GetWindow(hw, GW_CHILD)
'Now loop through all windows
etc.
There are many windows which are invisible or disabled, and I simply skip them because the user should not be able to select them. He wouldn't be able to type into them anyway.
Now I am confronted with a strange window.
Its title is "Groove Music".
It's a window from the Window Groove music app, and I can see it in the taskmanager.
I use the following API calls to check if this is a valid window that the user should be able to select:
IsWindow
IsWindowEnabled
IsWindowVisible
The declarations of these API calls are 100% perfect, I use them since years already.
And last, I even check its GetWindowRect values to see if it's in the screen at all.
And then I even check if it's a layered window (like an overlay that some apps use for non-clickable messages):
Public Function IsWindowLayered(ByVal uHwnd As Long) As Boolean
Dim lret&
lret = GetWindowLong(uHwnd, GWL_EXSTYLE)
If (lret And WS_EX_LAYERED) = WS_EX_LAYERED Then
IsWindowLayered = True
End If
End Function
It returns false.
The funny thing how is that the window is actually invisible.
So the user should not be able to select it.
Which function may I have missed to check if the window is actually visible?
Thank you!
Edit: It's also the calculator window (calc.exe) after I had opened it and closed it again.
Edit 2:
I also check for WS_VISIBLE like that, but even that return true for that window:
Public Function IsWindowVisibleEx(ByVal uHwnd As Long) As Boolean
Dim lret&
lret = GetWindowLong(uHwnd, GWL_STYLE)
If (lret And WS_VISIBLE) = WS_VISIBLE Then
IsWindowVisibleEx = True
End If
End Function
Edit 3: The taskmanager says that Calculator.exe and Groove have the status "Suspended".
From Windows Vista, although some windows are not resizable, but the borders are bold. Is there a way to make bold window borders(unresizable) in VB6?
Your Form's BorderStyle property dictates if the window will be resizable or not. You can chose between the following:
0 - None (no border)
1 - Fixed Single
2 - Sizable
3 - Fixed Dialog
4 - Fixed ToolWindow
5 - Sizable ToolWindow
As far as the visual appearance of the window in Vista, the resizing behavior shouldn't be affected.
Edit
If you want to prevent the form from resizing while keeping the resizable border style, you can override the Height and Width in the Form_Resize event:
Private Sub Form_Resize()
Me.Width = m_lngOriginalWidth
Me.Height = m_lngOriginalHeight
End Sub
You will need to store the original Height and Width at some point. You can do this in Form_Load or declare constants to store the original values:
Dim m_lngOriginalWidth As Long
Dim m_lngOriginalHeight As Long
Private Sub Form_Load()
m_lngOriginalWidth = Me.Width
m_lngOriginalHeight = Me.Height
End Sub
I've created a program that is fully functional and I have sent it to some clients. Some of them have really old computers with really low resolution and they can't access it easily since the form and the controls are oversized for them. Is there an easy way for me to make it to automatically resize both form and controls according to the resolution?
As I've said in the title, this is for Visual Basic 6.0. Thanks to all of you in advance.
You can store size and location of each control on the form, and move or resize controls according to your needs.
In the code below, I use "TabIndex" property as unique id for each control (I can't remember in my old VB6 memory if that's the right thing to do...).
I store the size of the form, and the size and location of each control in the Form_Load event.
Private lWidth As Long
Private lHeight As Long
Private Enum ePROPERTY
ep_Top = 0
ep_Left = 1
ep_Width = 2
ep_Height = 3
End Enum
Private aControlSize() As Long
Private Sub Form_Load()
Dim ctlTmp As Control
lWidth = Me.Width
lHeight = Me.Height
ReDim aControlSize(3, Form1.Controls.Count)
For Each ctlTmp In Form1.Controls
aControlSize(ctlTmp.TabIndex, ep_Top) = ctlTmp.Top
aControlSize(ctlTmp.TabIndex, ep_Left) = ctlTmp.Left
aControlSize(ctlTmp.TabIndex, ep_Width) = ctlTmp.Width
aControlSize(ctlTmp.TabIndex, ep_Height) = ctlTmp.Height
Next
End Sub
Then each time the form is resized (Form_resize event), you'll have to move or resize each control.
Some of them need to be anchored to the right or to the bottom (or both). Some need to be resized and moved. Others don't need nothing.
Private Sub Form_Resize()
Dim ctlTmp As Control
For Each ctlTmp In Form1.Controls
Select Case LCase$(ctlTmp.Name)
Case "text1"
' Text1 is anchored to the left and right borders of the form :
ctlTmp.Width = Me.Width - (lWidth - aControlSize(ctlTmp.TabIndex, ep_Width))
Case "command1"
' Command1 is anchored to the right border of the form :
ctlTmp.Left = aControlSize(ctlTmp.TabIndex, ep_Left) - (lWidth - Me.Width)
Case "check1"
' check1 is anchored to the bottom border of the form :
ctlTmp.Top = aControlSize(ctlTmp.TabIndex, ep_Top) - (lHeight - Me.Height)
End Select
Next
End Sub
Form loaded :
Form Resized :
Please be advised that my code is largely perfectible...
There's probably a more elegant solution that goes through overload each Control and to add properties/methods like the existing ones in dotnet.
I have my "about" form looking like this on my computer (Win7 32 bits) and in the IDE
And on at least one PC (under Win7 64 bits), it looks like that :
2 questions about this :
Why is my OK button not appearing when there is nothing to hide it in my code? How can I solve that? The OK button appears when I click the other button or when I click on its location.
Why are my buttons and my labels shifted to the right, going out of the form I designed in VB6? There is nothin in my code to change their position.
A bit of information :
My buttons are inside a "Frame" control. This frame control is supposed to be 840 twips (VB6 unit...Why couldn't they use pixel?!) from the left and 525 from top. My labels are not inside anything.
Thank you.
Edit : the only code managing the windows is in the form_load. FraAbout is containing the buttons you see above, FraSplash contains a progressbar. The ZOrder make buttons always appear on top.
Private Sub Form_Load()
On Error Resume Next
Timer1.Enabled = False
LblRevision = App.FileDescription
SendMessage pb1.Hwnd, PBM_SETBARCOLOR, 0, ByVal RGB(114, 191, 68)
FraAbout.Visible = False: FraSplash.Visible = False
Me.ForeColor = 0: Me.DrawStyle = 0: Me.BorderStyle = vbFixedSingle: Me.Refresh
If AppLoaded Then
FraAbout.Visible = True
Else
t = 0: pb1.value = pb1.min: FraSplash.Visible = True: Timer1.Enabled = True
End If
End Sub
This all came from... my configuration panel. Here is how to fix the problem if you have it. I was at 125, just put it back to 100 :
I've got a timer set up to detect if the mouse is over a certain area on my form, which you can imagine to be a rectangle starting at 50,50 (pixels) and ending at 1000,500. If the mouse is inside that rectangle, a second window pops up that acts somewhat like a tooltip, following the mouse around. The problem is that the menus at the top drape over this rectangle, and if you try to use a menu, the second window pops up (the timer sets its visible property to true) as soon as you move down the menu, which ends up closing the menu (I guess due to a loss of focus or something.)
If I can detect when one of the menus is open, I can disable the showing of the tooltip window with an if statement, but I don't know how to do that.
I think I've figured out how to do this by searching WIN32API.txt for "menu" and a little bit of googling, but I'm not really sure. Perhaps this solution only works on my machine.
Putting this code...
Dim hMenu As Long
hMenu = GetMenu(Form1.hwnd)
MsgBox GetMenuState(hMenu, 0, MF_BYPOSITION)
on a timer with an interval of 5000 allows you to the view the menu's state. In a closed state, the number appears to be random (1552, 1296, etc.,) but when the menu is opened, it is offset by 128 from this base value. A menu whose state is 1552 when closed is 1680 when open.
I'm not sure why it's offset by 128 or if this works on all machines (just to be safe, I will program it to check for inequality, not offset by 128), but it appears to be working for me.
If there is a problem with this solution or if there is a better way, please respond with another answer, and I'll be glad to give you credit for the answer instead.
Written by SBEIH Iyad - Syria - Damascus. 4/1/2021.
Using VB6.0, we can.
We check all menus windows if one is opened, it means: menu is opened.
we use API "GetMenu" for hWnd of main-menu,
then with the API "GetMenuState" we check if one of menus is opened.
Vb6.0 CODE:
Private Function GetBit_I(ByVal X As Long, ByVal i As Integer) As Integer
' Get the bit number i of X.
GetBit_I = (X And (2 ^ i)) / (2 ^ i)
End Function
Private Function MainMenuIsOpened(FRM As Form) As Boolean
Const MF_BYPOSITION = 1024
Dim H As Long, i As Integer, L As Long, MCount As Long
MainMenuIsOpened = False
On Error GoTo MainMenuIsOpenedError
H = GetMenu(FRM.HWnd)
MCount = GetMenuItemCount(H)
' MCount is the number of main-menus.
Do While (i < MCount)
L = GetMenuState(H, i, MF_BYPOSITION)
If ((L > -1) And (GetBit_I(L, 7) = 1)) Then
MainMenuIsOpened = True
Exit Do
End If
i = i + 1
Loop
Exit Function
MainMenuIsOpenedError:
MainMenuIsOpened = False
End Function
Good luck.