VB Forum / Win API / December 2006

I have a form1 through which a form2 is opened which has a picture box
in which a user control is loaded but the problem is

if I opens the form1, calls form2 and then close form2 and do this for
25 times the following error occurs:

Class           : iPMFunc.CreateUserControl
Message         : CreateUserControl Failed
Err.No          : 743
Err.Description : Unable to create or activate a new instance of
'PartyPCControl.uctPartyPCControl'.

I tried the possibility of removing the picture box and using the user
control on the form. Even this time the process failed

but the error this time was

"Invalid version. use the version of the control provided with the
application".

I am totally lost, and need help on this.

Below is the the code snippet:-

This is the procedure through which the form containing the user
control is opened and the procedure being called are given

below

Private Sub cmdEdit_Click()

   m_lReturn = OpenFile(vPartyCnt:=m_lPartyCnt, _
                        vPartyShortName:=m_sShortName, _
                        vPartyType:=m_sPartyType, _
                        vPartyResolvedName:=m_sResolved, _

bIsIncludeClosedBranchchecked:=m_bIsIncludeClosedBranchChecked)

   If (m_lReturn = PMTrue) Then
       Unload Me
   End If

End Sub

Function OpenFile(vPartyCnt As Variant, _
                 vPartyShortName As Variant, _
                 vPartyType As Variant, _
                 vPartyResolvedName As Variant, _
                 Optional bIsIncludeClosedBranchchecked) As Long

Dim fIndex As Integer
Dim vFileName As Variant

   On Error GoTo Err_OpenFile

   OpenFile = PMTrue

   vFileName = vPartyShortName & "|" & vPartyResolvedName & "|" &
vPartyCnt & vPartyType

   fIndex = FindFreeIndex()

   Set Document(fIndex) = New frmPartyPC
   ' Save the old party count
   Document(fIndex).PartyCnt = vPartyCnt
   Document(fIndex).Caption = "Personal Client : [" &
Trim$(vPartyResolvedName) & "]"

   'Note that it's the setting of the tag that loads the control on
the form
   Document(fIndex).Tag = fIndex
   Document(fIndex).Footer = "Client:" & fIndex
   Document(fIndex).ShortName = vPartyShortName
   Document(fIndex).ResolvedName = vPartyResolvedName
   Document(fIndex).PartyType = vPartyType     'FSA Phase III
   Document(fIndex).Index = fIndex

   frmMDI.Caption = "Sirius Client Manager : [" &
Trim$(vPartyResolvedName) & "]"

   Document(fIndex).LoadInterface
   Document(fIndex).Show

   Exit Function

Err_OpenFile:

   OpenFile = PMError

End Function

Function FindFreeIndex() As Integer

Dim i As Integer
Dim ArrayCount As Integer

   ArrayCount = UBound(Document)

   ' Cycle through the document array. If one of the documents has
been deleted, then return that index.
   For i = 1 To ArrayCount
       If FState(i).Deleted Then
           FindFreeIndex = i
           FState(i).Deleted = False
           Exit Function
       End If
   Next

   ' If none of the elements in the document array have been deleted,
then increment the document and the
   ' state arrays by one and return the index to the new element.
   ReDim Preserve Document(ArrayCount + 1)
   ReDim Preserve FState(ArrayCount + 1)
   FindFreeIndex = UBound(Document)

End Function

Private Sub Form_Load()

   m_lReturn& = CreateUserControl( _
                   v_sProgID:="PartyPCControl.uctPartyPCControl", _
                   v_sObjectName:="uctPartyPCControl1", _
                   v_oForm:=Me, _
                   r_oContainer:=picHolder, _
                   r_oControl:=uctControl)

End Sub

Public Function CreateUserControl( _
           ByVal v_sProgID As String, _
           ByVal v_sObjectName As String, _
           ByVal v_oForm As Object, _
           ByRef r_oContainer As Object, _
           ByRef r_oControl As Object, _
           Optional ByVal v_vLicenseKey As Variant, _
           Optional ByVal v_bNoResizeControl As Boolean) As Long

Dim sLicense As String
Dim bExists As Boolean
Dim bNoResizeControl As Boolean
Dim oLicInfo As LicenseInfo

   On Error GoTo Err_CreateUserControl

   CreateUserControl = PMTrue

   ' Check the license isn't added already
   bExists = False

   If (IsMissing(v_vLicenseKey) = False) Then
       For Each oLicInfo In Licenses
           ' If the progid and licencekey matches then we have a
winner
           If (oLicInfo.ProgId = v_sProgID) And _
                   (oLicInfo.LicenseKey = v_vLicenseKey) Then
               bExists = True
               Exit For
           End If
       Next
   Else
       For Each oLicInfo In Licenses
           ' If the progid's match then we have a winner
           If (oLicInfo.ProgId = v_sProgID) Then
               bExists = True
               Exit For
           End If
       Next
   End If

   ' If its not in the license collection then add it
   If (bExists = False) Then

       ' Add the license
       If (IsMissing(v_vLicenseKey) = False) Then
           sLicense = Licenses.Add(ProgId:=v_sProgID, _
                   LicenseKey:=v_vLicenseKey)
       Else
           sLicense = Licenses.Add(ProgId:=v_sProgID)
       End If

   End If

   ' Add the control
   Set r_oControl = v_oForm.Controls.Add(v_sProgID, v_sObjectName)

   ' Set the dimensions and location of the control to match those of
the placemarker
   r_oControl.Left = r_oContainer.Left
   r_oControl.Top = r_oContainer.Top

   ' Hide the placemarker
   r_oContainer.Visible = False
   ' Show the new user control
   r_oControl.Visible = True

   Exit Function

Err_CreateUserControl:

   CreateUserControl = PMError
   
      Exit Function
   
   Resume
   
End Function