精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● VB和Basic>>挖掘VB

主题:挖掘VB
发信人: 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




----
不想计较得失,却总在计较得失     

[关闭][返回]