DRAW TEXT 实例

<P> Option Explicit</P>
<P>Dim g_line As MapObjects2.Line<BR>Dim pts As MapObjects2.Points<BR>Dim tHeight As Double</P>
<P>'"重置"按钮单击响应事件<BR>Private Sub Command1_Click()<BR>  '清空之前生成的几何图形<BR>  Set g_line = Nothing<BR>  Set pts = Nothing<BR>  Map1.TrackingLayer.Refresh True<BR>End Sub</P>
<P>'"全图显示"按钮单击响应事件<BR>Private Sub Command2_Click()<BR>  Map1.Extent = Map1.FullExtent<BR>End Sub</P>
<P>Private Sub Form_Load()<BR>  '连接地理数据库<BR>  '这里是MapObjects自带的World数据<BR>  '默认路径在C:\Program Files\ESRI\MapObjects2\Samples\Data\World<BR>  Dim dc As New DataConnection<BR>  dc.Database = "C:\Program Files\ESRI\MapObjects2\Samples\Data\World"<BR>  If Not dc.Connect Then End<BR>  <BR>  '读入country图层<BR>  Dim layer As New MapLayer<BR>  Set layer.GeoDataset = dc.FindGeoDataset("country")<BR>  layer.Symbol.Color = moPaleYellow<BR>  Map1.Layers.Add layer<BR>  tHeight = Map1.Extent.Height / 8<BR>End Sub</P>
<P>Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As StdOle.OLE_HANDLE)<BR>  '确定g_line是不是空<BR>  If Not g_line Is Nothing Then<BR>    '确认g_line有至少两个顶点<BR>    If pts.Count > 1 Then<BR>      Dim tSym As New TextSymbol<BR>      '使用TextBox的字体<BR>      Set tSym.Font = Text1.Font<BR>      Dim sym As New Symbol<BR>      sym.Color = moRed<BR>      '使用DrawShape方法在Map Control中使用sym符号显示g_line图形<BR>      Map1.DrawShape g_line, sym<BR>      tSym.Height = tHeight<BR>      '使用DrawText方法在Map Control中使用tSym符号显示Text1中的文字<BR>      Map1.DrawText Text1.Text, g_line, tSym<BR>    End If<BR>  End If<BR>End Sub</P>
<P>Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, _<BR>                            x As Single, y As Single)<BR>  If Button = 1 Then<BR>    '鼠标左键被单击<BR>    <BR>    '当线段对象不存在时建立Line对象<BR>    If g_line Is Nothing Then<BR>      Set g_line = New MapObjects2.Line<BR>    End If<BR>    <BR>    '建立Points对象<BR>    If pts Is Nothing Then<BR>      Set pts = New MapObjects2.Points<BR>    End If<BR>    <BR>    '建立Point对象，并将其添加到Line对象<BR>    Dim p As Point<BR>    Set p = Map1.ToMapPoint(x, y)<BR>    pts.Add p<BR>    If pts.Count = 1 Then<BR>        g_line.Parts.Add pts<BR>        Set pts = g_line.Parts(0)<BR>    End If<BR>    <BR>    '刷新TrackingLayer层<BR>    Map1.TrackingLayer.Refresh True<BR>  Else<BR>    '鼠标右键被单击<BR>    '放大地图<BR>    Dim r As MapObjects2.Rectangle<BR>    Set r = Map1.TrackRectangle<BR>    If Not r Is Nothing Then Map1.Extent = r<BR>  End If<BR>End Sub</P>
<P><BR> </P>