Global WarningFlag As Boolean
Global MissingClassErrorFlag As Boolean
Global MissingAssocErrorFlag As Boolean

' SubRoutine getDiagramClasses: 
' 	Retrives from the scenario diagram the classes participating
Sub getDiagramClasses (ByVal theDgm As ScenarioDiagram, ByRef theClasses As ClassCollection)
  Dim DgmObjects As ObjectInstanceCollection
  Dim anObj As ObjectInstance
  Dim bAdded As Boolean
  Dim Cls As Class

  Set DgmObjects = theDgm.getObjects ' Returns the objects in the diagram.

  For objCnt% = 1 To DgmObjects.Count
  	Set anObj = DgmObjects.getAt(objCnt%)
	If anObj.IsClass Then
		Set Cls = anObj.getClass
		theClasses.Add Cls
	Else
		RoseApp.WriteErrorLog "ERROR VOPC Script: Object " & anObj.Name & " in diagram " & theDgm.Name & " is not from a class."
		MissingClassErrorFlag = true
	End If
  Next objCnt%
End Sub 'Of getDiagramClasses

' SubRoutine Create_VOPC_Classes
'	Created the Classes in the newly created VOPC class diagram or updates the old one.
Sub Create_VOPC_Classes( ByRef theUC As UseCase,  ByVal theClasses As ClassCollection, ByRef theVOPC As ClassDiagram)
	
	Dim newClsDgm As ClassDiagram
	Dim bAdded As Boolean
	Dim clsDgmIdx As Integer
	
	' Search if the VOPC exists
	clsDgmIdx = theUC.ClassDiagrams.FindFirst(theUC.Name &"_VOPC")
	If clsDgmIdx = 0 Then
		Set newClsDgm = theUC.AddClassDiagram(theUC.Name &"_VOPC")
	Else
		Set newClsDgm = theUC.ClassDiagrams.getAt(clsDgmIdx)
	End If

	For clsCnt% = 1 To theClasses.Count 
	  If Not newClsDgm.getClasses.Exists(theClasses.getAt(clsCnt)) Then
	  	bAdded = newClsDgm.AddClass(theClasses.getAt(clsCnt))
	  End If
	Next clsCnt%
	Set theVOPC = newClsDgm
End Sub ' Of Create_VOPC_Classes

' Function CheckAssoc:
' 	Check if there is an association between two classes: return true if yes
Function CheckAssoc(ByVal Cls1 As Class, ByVal Cls2 As Class) As Boolean
	Dim clsAssoc As AssociationCollection
	Dim anAssoc As Association
	Dim aRole As Role
	
	CheckAssoc = False
	Set clsAssoc = Cls1.getAssociations
	For AssocCnt% = 1 To clsAssoc.Count
		Set anAssoc = clsAssoc.getAt(AssocCnt%)
		Set aRole = anAssoc.getOtherRole(Cls1)
		If aRole.Class.Name = Cls2.Name Then
		 CheckAssoc = true
		 Exit Function
		End If
	Next AssocCnt%

End Function 'Of CheckAssoc

' SubRoutine CollectMessagesWithMissingAssoc
'	Constructs a Collection of the messages with no link btw classes.
Sub CollectMessagesWithMissingAssoc(ByVal theDgm As ScenarioDiagram, ByRef msgCol As MessageCollection)
	Dim dgmMsgs As MessageCollection
	Dim aMsg As Message
	Dim msgSender As ObjectInstance
	Dim msgReceiver As ObjectInstance
	Dim NotMissing As Boolean

	Set dgmMsgs = theDgm.getMessages
	For MsgCnt% = 1 To dgmMsgs.Count
		Set aMsg = dgmMsgs.getAt(MsgCnt%)
		If Not aMsg.IsMessageToSelf Then
			Set msgSender = aMsg.getSenderObject
			Set msgReceiver = aMsg.getReceiverObject
			If msgSender.IsClass And msgReceiver.IsClass Then
				NotMissing = CheckAssoc(msgSender.getClass,msgReceiver.getClass)
				If Not NotMissing Then
					 MissingAssocErrorFlag = true
				 	RoseApp.WriteErrorLog "ERROR VOPC Script: No association between classes for Message " & aMsg.Name & " in diagram " & theDgm.Name & "."
				 	msgCol.Add aMsg
				End If 
			End If ' Of class validity check.
		End If 'Of Reflexive message.
	Next MsgCnt%
End Sub 'Of

' Subroutine AddAssociationToVOPC:
'	Adds associations to VOPC for message that haven't
Sub AddAssociationToVOPC(ByVal theMsgs As MessageCollection, ByRef theDgm As ClassDiagram)
	Dim aMsg As Message
	Dim msgSender As ObjectInstance
	Dim msgReceiver As ObjectInstance
	Dim theAddedAssoc As Association
	Dim SenderClass As Class
	Dim bAdded As Boolean

	For MsgCnt% = 1 To theMsgs.Count
		Set aMsg = theMsgs.getAt(MsgCnt%)
		Set msgSender = aMsg.getSenderObject
		Set msgReceiver = aMsg.getReceiverObject
		Set SenderClass = msgSender.getClass
		Set theAddedAssoc = SenderClass.AddAssociation("",msgReceiver.getClass.Name)
		bAdded = theDgm.AddAssociation(theAddedAssoc)
	Next MsgCnt%  
End Sub 'Of AddAssociationToVOPC

' Subroutine Check_Warnings_Errors
'	If there is just warning displays a msgbox about it.
'	If there is message errors adds the relationships for them. Can not fix missing classes. 
Sub Check_Warnings_Errors (ByVal scen As ScenarioDiagram,ByVal msgCol As MessageCollection, ByRef clsdgm As ClassDiagram)
  	  Dim answr As Integer
	  If MissingClassErrorFlag Then
	  	msgbox "There are Class errors, See log window!"	  
	  End If
	  If MissingAssocErrorFlag Then
	  	answr = msgbox("There messages without association between their classes in diagram " & scen.Name & Chr(10) & Chr(13) & "Do you want To update the model ?",_
						ebYesNo,"Errors")
		If answr = ebYes Then
			Call AddAssociationToVOPC(msgCol,clsDgm)
		End If
	  End If
End Sub ' Of Check_Warnings_Errors 


Sub Main
	   Dim selUseCases As UseCaseCollection
	   Dim aUseCase As UseCase
	   Dim theVOPC As ClassDiagram
	   Dim theMsgs As New MessageCollection
	   MissingClassErrorFlag = false
	   WarningFlag = false

	   Set selUseCases = RoseApp.CurrentModel.getSelectedUseCases
	   For UseCasesCnt% = 1 To selUseCases.Count
	   			Set aUseCase = selUseCases.getAt(UseCasesCnt%)
				Dim clss As New ClassCollection
	   			For ScenariiCnt% = 1 To aUseCase.ScenarioDiagrams.Count
					Call getDiagramClasses ( aUseCase.ScenarioDiagrams.getAt(ScenariiCnt%), clss)
					Call Create_VOPC_Classes(aUseCase,clss, TheVOPC)					
					Call CollectMessagesWithMissingAssoc(aUseCase.ScenarioDiagrams.getAt(ScenariiCnt%), theMsgs)
					Call Check_Warnings_Errors (aUseCase.ScenarioDiagrams.getAt(ScenariiCnt%),theMsgs, theVOPC)
				Next ScenariiCnt%
	   Next UseCasesCnt%
	   Set theMsgs = Nothing
End Sub