I'm interested in wrapping long legend text (in ArcGIS 9.3.1) so that the text does not exceed the layout extent. I would like to call the "GetFormattedString" Function within the "UIButtonControl1_Click" procedure. Any pointers on how to get the legend text to wrap at 25 characters would be great.
Thank you!
Here is the code:
Public Sub UIButtonControl1_Click()
'Refresh legend
Dim pMxDoc2 As IMxDocument
Dim pPageLayout2 As IPageLayout
Dim pGC2 As IGraphicsContainer
Dim pElem2 As IElement
Dim pMSF2 As IMapSurroundFrame
Dim pMS2 As IMapSurround
Set pMxDoc2 = ThisDocument
Set pPageLayout2 = pMxDoc2.PageLayout
Set pGC2 = pPageLayout2
pGC2.Reset
Set pElem2 = pGC2.Next
Do Until pElem2 Is Nothing
If TypeOf pElem2 Is IMapSurroundFrame Then
Set pMSF2 = pElem2
Set pMS2 = pMSF2.MapSurround
Dim strFormattedString As String
strFormattedString = GetFormattedString("TextContentblahblah", "Arial", 5, 12)
pMS2.Refresh
pMxDoc2.ActiveView.Refresh
End If
Set pElem2 = pGC2.Next
Loop
End Sub
Private Function GetFormattedString(strTextContent As String, strFontName As _
String, sngFontSizeInPoints As Single, sngMaxWidthInPoints) As String
Dim varWordArray As Variant
Dim pMxApp As IMxApplication
Dim pAppDisplay As IAppDisplay
Dim pTransformation As ITransformation
Dim pTextFont As IFontDisp
Dim pTextSymbol As ITextSymbol
Dim dblXSize As Double
Dim dblYSize As Double
Dim strGoodWidth As String
Dim strFinalString As String
Dim strTestString As String
Dim i As Integer
'------ Split the string into an array of words
varWordArray = Split(strTextContent, " ", , vbTextCompare)
Set pMxApp = Application 'QI
'------ Get a pointer to the application display
Set pAppDisplay = pMxApp.Display 'QI
'------ Set up the Transformation
Set pTransformation = pAppDisplay.DisplayTransformation
'------ Set up the Font
Set pTextFont = New StdFont
pTextFont.Name = strFontName
pTextFont.size = sngFontSizeInPoints
'------ Set up the TextSymbol
Set pTextSymbol = New TextSymbol
pTextSymbol.font = pTextFont
'------ Add each word into the test string and test for width
pAppDisplay.StartDrawing pAppDisplay.hdc, 0
For i = LBound(varWordArray) To UBound(varWordArray)
If strTestString = "" Then
strTestString = varWordArray(i)
Else
strTestString = strTestString & " " & varWordArray(i)
End If
'------ Get the TextSize
pTextSymbol.GetTextSize pAppDisplay.hdc, pTransformation, strTestString, dblXSize, dblYSize
'------ If the word added is < max width keep adding to the line, else make new line by inserting vbcrlf
If dblXSize < sngMaxWidthInPoints Then
strGoodWidth = strTestString
Else
strTestString = varWordArray(i)
strFinalString = strFinalString & vbCrLf & strGoodWidth
End If
Next i
strFinalString = strFinalString & vbCrLf & strGoodWidth
pAppDisplay.FinishDrawing
'remove first vbcrlf and pass back
GetFormattedString = Right$(strFinalString, Len(strFinalString) - 2)
End Function
