vb 在打开多个窗口时，如果窗口已经打开过需显示到最上层（急求解，请帮忙！）
本帖最后由 tsm163 于 2011-11-11 01:15:00 编辑 点击左侧菜窗口单中的某个功能按钮时，对应右边则显示打开的窗口，如果窗口已经打开过需显示到最上层，(比如：现在打开Ａ窗口，再打开Ｂ窗口，也就是说有多个窗口打开时，我再次打开Ａ窗口就不会自动切换显示到最上层)，请问要怎样才能显示让Ａ窗口切换显示到最顶端，请各位大侠帮帮忙！
如图就是不能将底部切换到顶端：
[img=http://b95.photo.store.qq.com/psb?/V12SnZQv2zmkvp/arq23*uroVS36nJG5zUD*TVltxf4Q4NQaNB6yplHdjo!/b/YTm8szjlAQAAYrCyszjnAQAA][/img]
[解决办法]
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
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
[解决办法]
这是右边打开窗体的代码如下:
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
[解决办法]
哈哈，现在实现了，不用SetWindowPos 那么麻烦，就是在树节点按钮打开前，加一个me.hide属性就可以了
[解决办法]
该回复于2011-11-14 10:13:32被版主删除
[解决办法]
