发信人: lzzzl(lzzzl)
整理人: winsy(2003-07-02 13:57:37), 站内信件
|
对不喜欢模式显示的朋友来说，控制窗口关系是个烦人的事。用接口是个很好的解决方法，可反映出窗口间的调用关系，而不必访问信息比较少的forms集合
另外，如果你喜欢，还可象类一样，为窗口加上属性
以下代码还没有加上注释，有兴趣的朋友可共同探讨
'========================================================================
'日志窗口
'------------------------------------------------------------------------
'版本记录
'
'创建信息 2003.06.24 by zzl
'========================================================================
Option Explicit
Implements IPopupChild
Implements IPopupParent
Private mChanged As Boolean
Private mChilds As New Collection
Private mParent As IPopupParent
Private Sub cmdClose_Click()
Dim ok As Boolean
ok = ConfirmSave()
If ok Then
Unload Me
Else
End If
End Sub
Private Function ConfirmSave() As Boolean
Dim ok As Boolean
If mChanged Then
Dim i As Integer
i = MsgBox("所作的修改未保存，如果退出信息将丢失！真的要退出吗？", vbOKCancel)
If i = VBA.vbOK Then
ok = True
Else
End If
Else
ok = True
End If
ConfirmSave = ok
End Function
Private Sub Form_Unload(Cancel As Integer)
If mParent Is Nothing Then
Else
mParent.RemoveChild Me
Set mParent = Nothing
End If
End Sub
Public Function IPopupChild_GetID() As String
IPopupChild_GetID = "" & Me.hwnd
End Function
Public Sub IPopupChild_SetParent(p As IPopupParent)
If mParent Is Nothing Then
Else
mParent.RemoveChild Me
End If
Set mParent = p
End Sub
Private Sub IPopupChild_Popup()
If Me.WindowState = VBRUN.vbMinimized Then
Me.WindowState = VBRUN.vbNormal
Else
End If
Me.Show
End Sub
Private Sub AddChild(p As IPopupChild)
On Error Resume Next
mChilds.Remove p.GetID()
If Err.Number = 0 Then
ElseIf Err.Number = 5 Then
Else
mdlDeclare.gDebugger.Debugx mdlGeneral.GetErrInfoEx(Err.Number, Err.Description, Err.Source, Err.LastDllError)
End If
mChilds.Add p, p.GetID()
p.SetParent Me
p.Popup
On Error GoTo 0
End Sub
Public Sub IPopupParent_RemoveChild(p As IPopupChild)
On Error Resume Next
mChilds.Remove p.GetID()
If Err.Number = 0 Then
Else
mdlDeclare.gDebugger.Debugx mdlGeneral.GetErrInfoEx(Err.Number, Err.Description, Err.Source, Err.LastDllError)
End If
On Error GoTo 0
End Sub
Private Sub Command1_Click()
Dim frm As IPopupChild
Set frm = frmOption
AddChild frm
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Select Case UnloadMode
Case vbFormControlMenu '0 用户从窗体上的“控件”菜单中选择“关闭”指令。
If mChilds.Count = 0 Then
Else
MsgBox "请先关闭弹出窗口！"
Cancel = -1
Dim frm As IPopupChild
Set frm = mChilds.Item(1)
frm.Popup
End If
Case vbFormCode '1 Unload 语句被代码调用。
Case vbAppWindows '2 当前 Microsoft Windows 操作环境会话结束。
Case vbAppTaskManager '3 Microsoft Windows 任务管理器正在关闭应用程序。
Case vbFormMDIForm '4 MDI 子窗体正在关闭，因为 MDI 窗体正在关闭。
Case Else
End Select
End Sub
----
不想计较得失，却总在计较得失 |
|