' 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