vb 在打开多个窗口时,如果窗口已经打开过需显示到最上层(急求解,请帮忙!)

tsm163 2011-11-11 01:12:07
 点击左侧菜窗口单中的某个功能按钮时,对应右边则显示打开的窗口,如果窗口已经打开过需显示到最上层,(比如:现在打开A窗口,再打开B窗口,也就是说有多个窗口打开时,我再次打开A窗口就不会自动切换显示到最上层),请问要怎样才能显示让A窗口切换显示到最顶端,请各位大侠帮帮忙!
如图就是不能将底部切换到顶端:
...全文
335 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
现在还是人类 2011-11-13
  • 打赏
  • 举报
回复
[Quote=引用 4 楼 tsm163 的回复:]
哈哈,现在实现了,不用SetWindowPos 那么麻烦,就是在树节点按钮打开前,加一个me.hide属性就可以了
[/Quote]
你激活或是设置焦点给窗口不就可以了,隐藏不是什么好办法的。
yangao 2011-11-11
  • 打赏
  • 举报
回复

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 Declare Sub 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)

Private Sub Form_Activate()

'Set the window position to topmost
SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub
tsm163 2011-11-11
  • 打赏
  • 举报
回复
哈哈,现在实现了,不用SetWindowPos 那么麻烦,就是在树节点按钮打开前,加一个me.hide属性就可以了
tsm163 2011-11-11
  • 打赏
  • 举报
回复
这是右边打开窗体的代码如下:

Option Explicit
Private m_oColSortColumn As cColFlexGridSortColumn
Private Declare Sub 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)
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 CmdClose_Click()
Unload Me
Set m_oColSortColumn = Nothing
End Sub

Private Sub FGrid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
m_oColSortColumn.MouseDown X, Y
End Sub

Private Sub Form_Activate()
On Error Resume Next
Frmmain.TreeView.Nodes(Int(Me.Tag)).Selected = True
End Sub


Private Sub Form_Load()


On Error Resume Next
Me.WPowerControl1.DrawMe
g_comboOption.Stocks ComboItem, 0
g_comboOption.ItemType ComboType, 0

DTPBegin.Value = Now - 31
DTPEnd.Value = Now

FillGrid True
Set m_oColSortColumn = New cColFlexGridSortColumn
With m_oColSortColumn
Set .grid = Me.FGrid
.Add 1, True, flexSortStringAscending, flexSortStringDescending
.Add 2, True, flexSortStringAscending, flexSortStringDescending
.Add 3, True, flexSortStringAscending, flexSortStringDescending
.Add 4, True, flexSortNumericAscending, flexSortNumericDescending
.Add 5, True, flexSortNumericAscending, flexSortNumericDescending
.Add 6, True, flexSortNumericAscending, flexSortNumericDescending
.Add 7, True, flexSortNumericAscending, flexSortNumericDescending

End With
ComboItem.SetFocus
ComboType.SetFocus
'' end sort setup
End Sub


Private Sub Form_DblClick()
If Me.WindowState = 0 Then
Me.WindowState = 2
ElseIf Me.WindowState = 2 Then
Me.WindowState = 0
End If
End Sub
Private Sub FGrid_DblClick()
m_oColSortColumn.Sort
NumericGrid FGrid
End Sub


Private Sub FillGrid(Optional ByVal First As Boolean = False)
On Error Resume Next
Dim SqlStr As String, SRy As New Recordset, SRx As New Recordset, IsOne As Boolean
Dim l As Long

SqlStr = "SELECT b.IM_TypeName AS 类型名,SK_Name AS 物品名称,c.IM_UnitName AS 单位,c.IM_Unit AS 单位数量 FROM stock,Itemmaster b, ItemMaster c WHERE b.IM_OID=Left(SK_IM_OID,3) And c.IM_ID=SK_IM_ID AND c.im_etime>=#" & Format$(DTPBegin.Value, "YYYY-MM-DD") & " 0:0:0# AND c.im_btime<=#" & Format$(DTPEnd.Value, "YYYY-MM-DD") & " 23:59:59#"

If ComboType.Text <> "" Then
SqlStr = SqlStr & " AND LEFT(c.IM_OID,3) = (select Im_oid from ItemMaster where IM_TypeName='" & ComboType.Text & "') "
End If

SqlStr = SqlStr & " ORDER BY b.IM_OID,b.IM_TypeName"

Set SRx = g_Con.OpenSQL(SqlStr)
If SRx.EOF Then
IsOne = True
End If
Set SRx = Nothing
Set SRy = g_Con.OpenSQL(SqlStr)

With FGrid
Set .Recordset = Nothing
If Not IsOne Then
FGrid.Rows = 5
FGrid.FixedRows = 1
Set .Recordset = SRy
Else
FGrid.Rows = 1

End If
CmdPrint.Enabled = Not IsOne
If First Then
.ColWidth(0) = 100
.ColWidth(1) = 1650
.ColAlignment(1) = 0
.ColWidth(2) = 1650
.ColWidth(3) = 550
.ColAlignment(3) = 3
.ColWidth(4) = 800
.ColWidth(5) = 800
.ColWidth(6) = 800
.ColWidth(7) = 800
End If
NumericGrid FGrid
End With
Set SRy = Nothing

End Sub

Private Sub Form_Resize()
On Error Resume Next
If Me.Width < 8610 Then Me.Width = 8610
If Me.Height < 8085 Then Me.Height = 8085
FGrid.Width = Me.Width - 25 * Screen.TwipsPerPixelX
FGrid.Height = Me.Height - 170 * Screen.TwipsPerPixelX
End Sub

Private Sub CmdSeek_Click()
FillGrid
End Sub


tsm163 2011-11-11
  • 打赏
  • 举报
回复
谢谢,楼上这位大哥,我试了下不行,窗口还是不能切换显示到最顶端(我仔细看了下代码,发现在左边树节点窗体中代码有上面所说代码,我现在再加到要切的窗体中,是不是用冲突呢)我把代码分两次贴出来了,麻烦你帮我看一下

这是左边树节点代码如下:

Option Explicit
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwnewlong As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32.dll" (ByVal hBitmap As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As Long, ByVal bErase As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Private Declare Function Shell_NotifyIconA Lib "SHELL32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Private Const trayLBUTTONDOWN = 7695
Private Const trayLBUTTONUP = 7710
Private Const trayLBUTTONDBLCLK = 7725

Private Const trayRBUTTONDOWN = 7740
Private Const trayRBUTTONUP = 7755
Private Const trayRBUTTONDBLCLK = 7770

Private Const trayMOUSEMOVE = 7680

Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_LBUTTONDBLCLK = &H203
Private Const NIM_MODIFY = &H1
Private Ni As NOTIFYICONDATA

Dim OffX As Long
Dim FrmShow As Boolean
Dim RealQuit As Boolean
Dim TimC As Integer

Private Sub MDIForm_Load()

Me.WPowerControl1.DrawMe
SetToolbarBG Toolbar.hWnd, ImgBG.Picture
Dim Tstr As String
Select Case UserRight
Case 1
Tstr = "Admin"
Case 2
Tstr = "实物管理员"
End Select
With Me.StatusBar1
.Panels(1).Text = "用户姓名:" & UserName
.Panels(2).Text = "用户权限:" & Tstr
.Panels(3).Text = "账套:" & ACName
End With
Dim TNode As Node
'1 ADMIN 2 实物管理员 3 录入员 4 普通用户 5 部门经理
With TreeView
.Visible = False
.Nodes.Clear
Set TNode = .Nodes.Add(, , "K000", "系统功能列表", 1)
TNode.Expanded = True
Set TNode = .Nodes.Add("K000", 4, "K001", "基础数据维护", 1)
TNode.Expanded = True
Set TNode = .Nodes.Add("K000", 4, "K002", "业务流程操作", 1)
TNode.Expanded = True
Set TNode = .Nodes.Add("K000", 4, "K003", "业务报表", 1)
TNode.Expanded = True

If UserRight <= 3 Or UserRight = 5 Then

If UserRight = 3 Or UserRight = 1 Then
Set TNode = .Nodes.Add("K002001", 4, "K002001001", "新建入库单", 2, 3)
TNode.Expanded = True
End If

Set TNode = .Nodes.Add("K002001", 4, "K002001002", "修改/确认入库单", 2, 3)
TNode.Expanded = True

Set TNode = .Nodes.Add("K003", 4, "K003005", "领用情况查询", 2, 3)
TNode.Expanded = True

Set TNode = .Nodes.Add("K003", 4, "K003006", "物品结存统计", 2, 3)
TNode.Expanded = True

End If
.Visible = True
End With
LoadPopUp "欢迎您!" & UserName, "现在是:" & Format$(Now, "YYYY-MM-DD HH:MM")
'TrayAddIcon Frmmain, App.Path & "\xptray.ico", "中国移动通信办公用品管理客户端"
'TrayBalloon Frmmain, "现在是:" & Format$(Now, "YYYY-MM-DD HH:MM") & vbCrLf & "您也可以通过这里操作本系统", "欢迎您!" & UserName, NIIF_INFO
FrmShow = True
Dim i As Integer
With PicBG
.AutoRedraw = True
.Width = Screen.Width
.Height = Screen.Height
PicBGTmp.AutoRedraw = True
For i = 0 To .ScaleHeight \ PicBGTmp.ScaleHeight
StretchBlt .hdc, 0, i * PicBGTmp.ScaleHeight, .ScaleWidth, PicBGTmp.ScaleHeight, PicBGTmp.hdc, 0, 0, PicBGTmp.ScaleWidth, PicBGTmp.ScaleHeight, vbSrcCopy
Next i
PicBGTmp.AutoRedraw = False
Set .Picture = .Image
.AutoRedraw = False
Set Me.Picture = .Picture
Set .Picture = Nothing
Set PicBGTmp.Picture = Nothing
End With
TimC = 59
TimeMsg.Enabled = True
End Sub

Private Sub MDIForm_Resize()
On Error Resume Next
TreeView.Move 5 * Screen.TwipsPerPixelX, 5 * Screen.TwipsPerPixelY, PicMain.Width - 10 * Screen.TwipsPerPixelX, Me.Height - Toolbar.Height - 80 * Screen.TwipsPerPixelY
ImgSlip.Move ImgSlip.Left, 0, ImgSlip.Width, Me.Height

End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
Cancel = Not RealQuit
If RealQuit Then
DeleteIcon TrayIcon
Set Frmmain = Nothing
Else
NoSysIcon False
LoadPopUp "操作提示", "系统缩小到了这里!" & vbCrLf & "您可以通过鼠标右键的选择来继续操作系统或者完全退出系统"
End If
End Sub


Private Sub TimeMsg_Timer()
On Error Resume Next
If TimC = 59 Then
TreeView.Nodes(1).Selected = True
TimC = 0
Dim stockState As Long
Dim SqlStr As String
stockState = g_Con.getalong("SELECT SH_State FROM StockState")
If stockState <> 0 Then
TimeMsg.Enabled = False: Exit Sub
End If
TimeMsg.Enabled = False
Else
TimC = TimC + 1
End If
End Sub

Private Sub Toolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
If Button.Index <= 12 Then
If Button.Style = tbrDefault Then
TreeView.Nodes(1).Selected = True
SelectFunction Button.Tag
End If
Else
Select Case Button.Index
Case 14
FrmAbout.Show , Frmmain
Case 16
RealQuit = True
Unload Me
FrmLogin.TxtInfo(2).Text = ACName
FrmLogin.Show
End Select

End If
End Sub

Private Sub TreeView_NodeClick(ByVal Node As MSComctlLib.Node)
SelectFunction Node.Key
End Sub

Public Sub SelectFunction(ByVal KeyName As String)
On Error Resume Next
Dim hWnd As Long
hWnd = 0
Select Case KeyName
Case "K001001" '基础物品维护
FrmIM.Tag = TreeView.SelectedItem.Index
FrmIM.Show
hWnd = FrmIM.hWnd
Case "K003006"
FrmBalance.Show
FrmBalance.Tag = TreeView.SelectedItem.Index
hWnd = FrmBalance.hWnd

End Select

If hWnd > 0 Then
SendPaint hWnd
End If
End Sub

Private Sub ImgSlip_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
OffX = X
End Sub

Private Sub ImgSlip_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Button = 1 And Abs(X - OffX) > 100 Then
With ImgSlip
If .Left + (X - OffX) + ImgSlip.Width < 2000 Then
Exit Sub
Else
.Move .Left + (X - OffX)
PicMain.Width = .Left + ImgSlip.Width
TreeView.Move 5 * Screen.TwipsPerPixelX, 5 * Screen.TwipsPerPixelY, PicMain.Width - 10 * Screen.TwipsPerPixelX, Me.Height - Toolbar.Height - 80 * Screen.TwipsPerPixelY
End If

End With

End If
End Sub

Private Sub mClose_Click()
RealQuit = True
Unload Me
End Sub

Private Sub mnuItem_Click(Index As Integer)
Dim hWnd As Long
hWnd = 0
mShow_Click
Select Case Index
Case 0
FrmIM.Show
hWnd = FrmIM.hWnd
Case 1
FrmDep.Show
hWnd = FrmDep.hWnd
Case 2
FrmOptioner.Show
hWnd = FrmOptioner.hWnd
End Select
If hWnd > 0 Then
SendPaint hWnd
End If
End Sub

Private Sub mShow_Click()
NoSysIcon True
End Sub
Private Sub SetToolbarBG(hWnd As Long, hBmp As Long)
DeleteObject SetClassLong(hWnd, -10, CreatePatternBrush(hBmp))
InvalidateRect 0&, 0&, False
End Sub

Private Sub ShowProgramInTray()
FrmShow = True
Ni.cbSize = Len(Ni)
Ni.hWnd = TrayIcon.hWnd
Ni.uID = 0
Ni.uID = Ni.uID + 1
Ni.uFlags = &H1 Or &H2 Or &H4
Ni.uCallbackMessage = &H200
Ni.hIcon = TrayIcon.Picture
Ni.szTip = Frmmain.Caption + Chr$(0)
Shell_NotifyIconA &H0&, Ni
End Sub

Private Sub DeleteIcon(ByVal Pic As Control)
FrmShow = False
Ni.uID = 0
Ni.uID = Ni.uID + 1
Ni.cbSize = Len(Ni)
Ni.hWnd = Pic.hWnd
Ni.uCallbackMessage = &H200
Shell_NotifyIconA &H2, Ni
End Sub

Private Sub Trayicon_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Msg As Long
Msg = (X And &HFF) * &H100
Select Case Msg
Case &H3C00 'right mouse button down

PopupMenu mSysPopup, 2, , , mShow

Case &H2D00
NoSysIcon True


End Select

End Sub

Public Sub NoSysIcon(ByVal maxIcon As Boolean)
Me.Visible = maxIcon
If Not maxIcon Then
ShowProgramInTray
Else
DeleteIcon TrayIcon
End If
End Sub

Public Sub LoadPopUp(ByVal TitleStr As String, ByVal Msgstr As String, Optional ByVal MsgType As Integer, Optional ByVal SelTag As String = "")
'MSGTYPE 0 普通消息(不可点) 1 引导消息(可以点)
Dim Fnew As New FrmMSGPopUp
With Fnew
.TagType = MsgType
.MsgText = Msgstr
.SetNumber 450 + MsgIndex * 1785
.LblText.Caption = TitleStr
.LblMessage.Tag = SelTag
.Show , Frmmain
End With
MsgIndex = MsgIndex + 1
End Sub






1,451

社区成员

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧