dynamicmdi.frm

VB圣经

VERSION 5.00
Begin VB.MDIForm MDIFormMain 
   AutoShowChildren=   0   'False
   BackColor       =   &H8000000C&
   Caption         =   "MDIForm1"
   ClientHeight    =   3705
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   7485
   LinkTopic       =   "MDIForm1"
   StartUpPosition =   3  'Windows Default
   Begin VB.Menu mnuNewForms 
      Caption         =   "&New Form"
      NegotiatePosition=   1  'Left
      Begin VB.Menu mnuNewForm 
         Caption         =   ""
         Index           =   0
      End
   End
End
Attribute VB_Name = "MDIFormMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'***************************************************************
Option Explicit
Private m_dwContextCookie  As DWORD

Private Sub MDIForm_Load()
Dim Context As New AppContext
Dim fNum As Integer
Dim strLine As String
Dim i As Integer
    'The GUID is arbitrary as long as it is agreed upon by both the app
    'and the dynamically-loaded OCXs.
    m_dwContextCookie = CoRegisterClassObject(IIDFromString(strCLSID_APPCONTEXT), Context, CLSCTX_INPROC_SERVER Or CLSCTX_LOCAL_SERVER, REGCLS_MULTIPLEUSE)
    
    'Open our data file and load data for all the controls
    On Error GoTo Done
    fNum = FreeFile
    Open App.Path & "\Forms.Dat" For Input As fNum
    Do Until EOF(fNum)
        Line Input #fNum, strLine
        strLine = Trim$(strLine)
        If Len(strLine) Then
            If i Then Load mnuNewForm(i)
            With mnuNewForm(i)
                .Tag = strLine
                .Caption = Trim$(Right$(strLine, Len(strLine) - InStrRev(strLine, ",")))
                .Visible = True
            End With
            i = i + 1
        End If
    Loop
Done:
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    If m_dwContextCookie Then
        CoRevokeClassObject m_dwContextCookie
        m_dwContextCookie = 0
    End If
End Sub

Private Sub mnuNewForm_Click(Index As Integer)
Dim strData() As String
    'Use the first two fields to show the control
    On Error GoTo Error
    strData = Split(mnuNewForm(Index).Tag, ",", 3, vbBinaryCompare)
    ShowNewForm App.Path & "\" & Trim$(strData(0)), Trim$(strData(1))
    Exit Sub
Error:
    MsgBox Err.Description
End Sub