One To Many Labels
OneToManyProps.cls

' Copyright 2008 ESRI
' 
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See use restrictions at <your ArcGIS install location>/developerkit/userestrictions.txt.
' 




Option Explicit

Implements IComPropertyPage

Private m_frmOneToManyProps As frmOneToManyProps
Private m_sTitle As String
Private m_lWidth As Long ' pixels
Private m_lHeight As Long ' pixels
Private m_pLabelEngine As ILabelEngineLayerProperties
Private m_pFeatLayer As IFeatureLayer

Private Sub Class_Initialize()
  Set m_frmOneToManyProps = New frmOneToManyProps
  m_sTitle = m_frmOneToManyProps.Caption
  m_frmOneToManyProps.ScaleMode = vbPixels
  m_lWidth = m_frmOneToManyProps.ScaleWidth
  m_lHeight = m_frmOneToManyProps.ScaleHeight
End Sub

Private Sub Class_Terminate()
  Unload m_frmOneToManyProps
  Set m_frmOneToManyProps = Nothing
  Set m_pLabelEngine = Nothing
  Set m_pFeatLayer = Nothing
End Sub

Private Function IComPropertyPage_Activate() As esriSystem.OLE_HANDLE
  IComPropertyPage_Activate = m_frmOneToManyProps.Picture1.hWnd
End Function

Private Function IComPropertyPage_Applies(ByVal Objects As esriSystem.ISet) As Boolean
  On Error GoTo Eh
  IComPropertyPage_Applies = True
  Exit Function
Eh:
  MsgBox "IComPropertyPage_Applies - " & Erl & " - " & Err.Description
End Function

Private Sub IComPropertyPage_Apply()
  On Error GoTo ErrorHandler:
  Dim sExp As String
  sExp = "REL:" & _
   m_frmOneToManyProps.cmbRelClass.Text & ":REL FIELD:" & m_frmOneToManyProps.cmbField.Text & _
   ":FIELD RINDEX:" & CStr(m_frmOneToManyProps.cmbRelClass.ListIndex) & ":RINDEX F2:" & _
   m_frmOneToManyProps.cmbField2.Text & ":F2"
  
  m_pLabelEngine.Expression = sExp

  Dim pAnnoExp As IAnnotationExpressionEngine, pLabels As OneToManyLabels
  Dim pAnnoProps As IAnnotateLayerProperties
  Set pAnnoProps = m_pLabelEngine
  Set pAnnoExp = New OneToManyLabels
  Set pLabels = pAnnoExp
  pLabels.SetFeatureLayer m_pFeatLayer
  pAnnoExp.SetExpression "", sExp
  Set m_pLabelEngine.ExpressionParser = pAnnoExp

  Exit Sub
ErrorHandler:
  MsgBox "IComPropertyPage - " & Erl & " - " & Err.Description
End Sub

Private Sub IComPropertyPage_Cancel()

End Sub

Private Sub IComPropertyPage_Deactivate()
  m_frmOneToManyProps.Enabled = False
  m_frmOneToManyProps.SetPageSite Nothing
End Sub

Private Property Get IComPropertyPage_Height() As Long
  IComPropertyPage_Height = m_lHeight
End Property

Private Property Get IComPropertyPage_HelpContextID(ByVal controlID As Long) As Long

End Property

Private Property Get IComPropertyPage_HelpFile() As String

End Property

Private Sub IComPropertyPage_Hide()
  m_frmOneToManyProps.Picture1.Visible = False
End Sub

Private Property Get IComPropertyPage_IsPageDirty() As Boolean
  IComPropertyPage_IsPageDirty = True
End Property

Private Property Set IComPropertyPage_PageSite(ByVal RHS As IComPropertyPageSite)
  m_frmOneToManyProps.SetPageSite RHS
End Property

Private Property Let IComPropertyPage_Priority(ByVal RHS As Long)

End Property

Private Property Get IComPropertyPage_Priority() As Long
  IComPropertyPage_Priority = -1
End Property

Private Sub IComPropertyPage_SetObjects(ByVal Objects As esriSystem.ISet)
  On Error GoTo Eh
  
  If Objects Is Nothing Then Exit Sub
  
  Dim obj As Variant, pFeatLayer As IFeatureLayer
  Dim i As Long
  Objects.Reset
  
  For i = 0 To Objects.Count - 1
    obj = Objects.Next
    If TypeOf obj Is ILabelEngineLayerProperties Then
      Set m_pLabelEngine = obj
    ElseIf TypeOf obj Is IFeatureLayer Then
      Set m_pFeatLayer = obj
    End If
  Next i
  
  If m_pLabelEngine Is Nothing Then
    MsgBox "Did not get the LabelEngine!!!"
  End If
   
  Exit Sub
Eh:
  MsgBox "IComPropertyPage_SetUpObjects - " & Erl & " - " & Err.Description
End Sub

Private Sub IComPropertyPage_Show()
On Error GoTo ErrHand:
  Dim sExp As String, lPos1 As Long, lPos2 As Long
  Dim sRel As String, sF As String, sF2 As String
  Dim pAnnoProps As IAnnotateLayerProperties
  
  m_frmOneToManyProps.Picture1.Visible = True
  sExp = m_pLabelEngine.Expression
  
  Set pAnnoProps = m_pLabelEngine
  Set m_frmOneToManyProps.m_pFeatLayer = m_pFeatLayer
  m_frmOneToManyProps.UpdateSettings
  
  'Check Expression to see if it is a one to many expression
  If InStr(1, sExp, "FIELD:") > 0 And InStr(1, sExp, "REL:") > 0 Then
    lPos1 = InStr(1, sExp, "REL:") + 4
    lPos2 = InStr(1, sExp, ":REL") - lPos1
    sRel = Mid(sExp, lPos1, lPos2)
    lPos1 = InStr(1, sExp, "FIELD:") + 6
    lPos2 = InStr(1, sExp, ":FIELD") - lPos1
    sF = Mid(sExp, lPos1, lPos2)
    lPos1 = InStr(1, sExp, "F2:") + 3
    lPos2 = InStr(1, sExp, ":F2") - lPos1
    sF2 = Mid(sExp, lPos1, lPos2)
  
    With m_frmOneToManyProps
    ' Tell the form a progrommatic update is happening so it doesn't set PageChanged
      .IsProgrammaticPageUpdate = True
      .cmbRelClass.Text = sRel
      If .cmbRelClass.ListIndex < 0 Then
        MsgBox "Can not find the Relationship name, please reset OneToMany labeling parameters!!"
        Exit Sub
      End If
      .cmbField.Text = sF
      If .cmbField.ListIndex < 0 Then
        MsgBox "Can not find the first field name, please reset OneToMany labeling parameters!!"
        Exit Sub
      End If
      .cmbField2.Text = sF2
      If .cmbField2.ListIndex < 0 Then
        MsgBox "Can not find the second field name, please reset OneToMany labeling parameters!!"
        Exit Sub
      End If
      .IsProgrammaticPageUpdate = False
    End With
  End If

  Exit Sub
  
ErrHand:
  MsgBox "IComPropertyPage_Show - " & Erl & " - " & Err.Description
End Sub

Private Property Get IComPropertyPage_Title() As String
  IComPropertyPage_Title = m_sTitle
End Property

Private Property Let IComPropertyPage_Title(ByVal RHS As String)
  m_sTitle = RHS
End Property

Private Property Get IComPropertyPage_Width() As Long
  IComPropertyPage_Width = m_lWidth
End Property