'#Language "WWB-COM"

' Create an integer custom property on the selected topic
' If it already exists, increment it

Option Explicit

Const T_URI = "http://mindmanager.com/macros/properties/integer" ' just a unique string, not a real URL
Const T_Name = "Points"

Sub Main
	Dim m_Topic As Topic

	Set m_Topic = ActiveDocument.Selection.PrimaryTopic
	If Not (m_Topic Is Nothing) Then
		Dim i_Value As Integer
		If Not TopicGetIntegerProperty(m_Topic, T_URI, T_Name, i_Value) Then ' does not exist, assert
			TopicAssertIntegerProperty(m_Topic, T_URI, T_Name, 0)
		Else ' increment
			TopicSetIntegerProperty(m_Topic, T_URI, T_Name, i_Value + 1)
		End If
	End If

End Sub

Function TopicAssertIntegerProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByVal i_Value As Integer) As CustomProperty
	' Assert an integer property on a topic and return the  custom property
	' If the topic already has a different data contain type, return nothing

	Set TopicAssertIntegerProperty = Nothing
	If Not TopicFindProperty(m_Topic, s_URI, s_Name, TopicAssertIntegerProperty) Then ' not found, create
		If  m_Topic.DataContainer.DataContainerType = mmDataContainerTypeNone Then
			m_Topic.DataContainer.InsertCustomProperties
		End If
		If m_Topic.DataContainer.DataContainerType = mmDataContainerTypeCustomProperties Then
			Set TopicAssertIntegerProperty = m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.AddCustomProperty(s_URI, s_Name, mmCustomPropertyFormatTypeInteger)
		End If
	End If
	If Not (TopicAssertIntegerProperty Is Nothing) Then ' we have a property
		TopicAssertIntegerProperty.Value = i_Value ' assert value
	End If

End Function

Function TopicGetIntegerProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByRef i_Value As Integer) As Boolean
	' Read the value of an integer property
	Dim m_Property As CustomProperty

	TopicGetIntegerProperty = False
	If TopicFindProperty(m_Topic, s_URI, s_Name, m_Property) Then
		If m_Property.CustomPropertyFormat.FormatType =  mmCustomPropertyFormatTypeInteger Then
			If m_Property.HasValue Then
				i_Value = m_Property.Value
				TopicGetIntegerProperty = True
			End If
		End If
	End If

End Function

Sub TopicSetIntegerProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByVal i_Value As Integer)
	' Write a value to an integer property
	Dim m_Property As CustomProperty

	If TopicFindProperty(m_Topic, s_URI, s_Name, m_Property) Then
		If m_Property.CustomPropertyFormat.FormatType = mmCustomPropertyFormatTypeInteger Then
			m_Property.Value = i_Value
		End If
	End If

End Sub

Function TopicFindProperty(ByVal m_Topic As Topic, ByVal s_URI As String, ByVal s_Name As String, ByRef m_Property As CustomProperty) As Boolean
	' Find a property by either matching URI or name if given
	' Match by name is used if the match by URI fails. The name is not case-sensitive and ignores spaces.
	Dim i_1 As Integer

	Set m_Property = Nothing
	TopicFindProperty = False
	If m_Topic.DataContainer.DataContainerType = mmDataContainerTypeCustomProperties Then
		If Len(s_URI) > 0 Then
			For i_1 = 1 To m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Count
				If m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Item(i_1).Uri = s_URI Then
					Set m_Property = m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Item(i_1)
					TopicFindProperty = True
					Exit For
				End If
			Next
		End If
		If (m_Property Is Nothing) And (Len(s_Name) > 0) Then
			s_Name = UCase(Trim(s_Name))
			For i_1 = 1 To m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Count
				If UCase(Trim(m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Item(i_1).CustomPropertyName)) = s_Name Then
					Set m_Property = m_Topic.DataContainer.CustomProperties.CustomPropertyCollection.Item(i_1)
					TopicFindProperty = True
					Exit For
				End If
			Next
		End If
	End If

End Function