dddtext.cls

gis地图 --- --- --文字1

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "DDDText"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

' Copyright 1995-2004 ESRI

' All rights reserved under the copyright laws of the United States.

' You may freely redistribute and use this sample code, with or without modification.

' Disclaimer: THE SAMPLE CODE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED 
' WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 
' FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ESRI OR 
' CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, 
' OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
' SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
' INTERRUPTION) SUSTAINED BY YOU OR A THIRD PARTY, HOWEVER CAUSED AND ON ANY 
' THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ARISING IN ANY 
' WAY OUT OF THE USE OF THIS SAMPLE CODE, EVEN IF ADVISED OF THE POSSIBILITY OF 
' SUCH DAMAGE.

' For additional information contact: Environmental Systems Research Institute, Inc.

' Attn: Contracts Dept.

' 380 New York Street

' Redlands, California, U.S.A. 92373 

' Email: [e-mail]

Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Member0" ,"DDDTextCollection"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Implements IDDDText

Private lDisplayList As Long        '   opengl display list
Private sType As String             '   string 'tag' of type
Private bEnabled As Boolean         '   draw this label
Private bAutoAdjust As Boolean      '   billboarding
Private dAziAngle As Double         '   local azimuth angle
Private dIncAngle As Double         '   lobal inclination angle
Private sMessage As String          '   actual string message
Private pOrigin As IPoint           '   current location origin
Private dFontSize As Double         '   font size
Private dXScale As Double           '   x scale
Private dYScale As Double           '   y scale
Private dZScale As Double           '   z scale
Private bUseDefaultColor As Boolean '   reset color to default
Private pDefaultColor As IRgbColor  '   the default color
Private pColor As IRgbColor         '   the current color
Private dXRot As Double             '   rotation on the x axis
Private dYRot As Double             '   rotation on the y axis
Private dZRot As Double             '   rotation on the z axis
Private sFontName As String         '   font name
Private bNeedsGeomUpdate As Boolean '   flag for position update
Private bNeedsFontUpdate As Boolean '   flag for font update
Private dMinDisplayDist As Double   '   minimum display distance
Private pDDDFont As IDDDFont        '   current font
Private bAziBillboard As Boolean
Private bIncBillboard As Boolean

Public Enum enumDDDTextAlignment    '   alignment enum
  alignLeft = 0
  alignCenter = 1
  alignRight = 2
End Enum
Private pAlign As enumDDDTextAlignment





Private Function PI() As Double
  'PI = 3.1415926
  PI = 4 * Atn(1#)
End Function

Private Property Let IDDDText_AutoAdjust(RHS As Boolean)
  bAutoAdjust = RHS
  bAziBillboard = RHS
  bIncBillboard = RHS
  bNeedsGeomUpdate = True
End Property
Private Property Get IDDDText_AutoAdjust() As Boolean
  IDDDText_AutoAdjust = bAutoAdjust
End Property





Private Function IDDDText_BoundingBox() As IGeometry

    On Error GoTo BoundingBox_ERR
    

'origin coordinates
Dim pWhere As IPoint, pOriginMod As IPoint
Dim pClone As IClone
Dim pSym As IFillSymbol
Dim pColor As IColor

Set pClone = pOrigin
Set pOriginMod = pClone.Clone


Dim iCount As Integer
Dim nXScale As Double
Dim nZScale As Double
Dim nYScale As Double


' CREATE NEW ENVELOPE

  Dim pBB As IEnvelope2

  Set pBB = New Envelope

  ' CALCULATE CENTER OFFSET

  Dim dCenterOffset As Double
  dCenterOffset = pDDDFont.CenterOffset(sMessage) * (dFontSize * (dXScale / 100))

  ' ASSIGN VALUES TO ENVELOPE

  pBB.xmin = pOrigin.x - (dCenterOffset * pAlign)

  pBB.ymin = pOrigin.y

  pBB.zmin = pOrigin.z

  pBB.xmax = pBB.xmin + (dCenterOffset * 2)

  pBB.ymax = pBB.ymin + (dFontSize * (dYScale / 100))

  pBB.zmax = pBB.zmin + (dFontSize * (dZScale / 100))


Set IDDDText_BoundingBox = pBB
Exit Function


    nXScale = dXScale / 1000 * dFontSize * Len(sMessage)
    nXScale = nXScale / 2
    nZScale = dZScale / 100 * dFontSize * 2

Dim pRect As IPolygon
Dim pPolyPoints As IPointCollection
    Set pRect = New Polygon
    Set pPolyPoints = pRect
'1
'LL
    Set pClone = pOriginMod
    Set pWhere = pClone.Clone
    pPolyPoints.AddPoint pWhere
    

'3
'UL
    Set pWhere = pClone.Clone
    pWhere.x = pOriginMod.x
    pWhere.y = pOriginMod.y
    pWhere.z = pOriginMod.z + nZScale
    pPolyPoints.AddPoint pWhere
    

'4
'UR
    Set pWhere = pClone.Clone
    pWhere.x = pOriginMod.x + nXScale
    pWhere.y = pOriginMod.y
    pWhere.z = pOriginMod.z + nZScale
    
    pPolyPoints.AddPoint pWhere


'2
'LR
    Set pWhere = pClone.Clone
    pWhere.x = pOriginMod.x + nXScale
    pWhere.y = pOriginMod.y
    pWhere.z = pOriginMod.z
    
    pPolyPoints.AddPoint pWhere

    pRect.Close
    
    Dim pZAware As IZAware
    Set pZAware = pRect
    pZAware.ZAware = True


    Set IDDDText_BoundingBox = pRect


        
    Exit Function
    
BoundingBox_ERR:
'MsgBox "BoundingBox_ERR: " & Err.Description
Resume Next


End Function

Private Property Get IDDDText_TextType() As String
  IDDDText_TextType = sType
End Property
Private Property Let IDDDText_TextType(sInType As String)
  sType = sInType
End Property

Private Property Get IDDDText_Enabled() As Boolean
  IDDDText_Enabled = bEnabled
End Property
Private Property Let IDDDText_Enabled(bInEnable As Boolean)
  bEnabled = bInEnable
  bNeedsGeomUpdate = True
End Property

Private Property Get IDDDText_Message() As String
  IDDDText_Message = sMessage
End Property
Private Property Let IDDDText_Message(sInMsg As String)
  sMessage = sInMsg
  bNeedsGeomUpdate = True
End Property

Private Property Get IDDDText_Alignment() As enumDDDTextAlignment
  IDDDText_Alignment = pAlign
End Property
Private Property Let IDDDText_Alignment(pInAlignment As enumDDDTextAlignment)
  pAlign = pInAlignment
  bNeedsGeomUpdate = True
End Property

Private Property Get IDDDText_Origin() As IPoint
  Set IDDDText_Origin = pOrigin
End Property
Private Property Set IDDDText_Origin(pInOrg As IPoint)
  Set pOrigin = pInOrg
  bNeedsGeomUpdate = True
End Property

Private Property Let IDDDText_UseDefaultColor(RHS As Boolean)
  bUseDefaultColor = RHS
End Property
Private Property Get IDDDText_UseDefaultColor() As Boolean
  IDDDText_UseDefaultColor = bUseDefaultColor
End Property

Private Property Get IDDDText_Color() As IRgbColor
  Set IDDDText_Color = pColor
End Property
Private Property Set IDDDText_Color(pInColor As IRgbColor)
  Set pColor = pInColor
End Property

Private Property Get IDDDText_FontName() As String
  IDDDText_FontName = sFontName
End Property
Private Property Let IDDDText_FontName(sInFontName As String)
  sFontName = sInFontName
  bNeedsFontUpdate = True
  bNeedsGeomUpdate = True
End Property

Private Property Get IDDDText_FontSize() As Double
  IDDDText_FontSize = dFontSize
End Property
Private Property Let IDDDText_FontSize(dInFontSize As Double)
  dFontSize = dInFontSize
  bNeedsGeomUpdate = True
End Property

Private Property Get IDDDText_MinDisplayDist() As Double
  IDDDText_MinDisplayDist = dMinDisplayDist