yeah2000
路人甲
路人甲
  • 注册日期2005-11-23
  • 发帖数7
  • QQ
  • 铜币0枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:2743回复:1

自己写的MO+VB的小程序

楼主#
更多 发布于:2006-07-21 16:04
<P>Private Sub Form_Load()<BR>    DataLoader<BR>    DisPlayWord</P>
<P>    Combo1.AddItem "书店", 0<BR>    lname(0) = "shudian"<BR>  <BR>    Combo1.ListIndex = 0<BR>End Sub</P>
<P>Sub DataLoader()<BR>    Dim dc As New MapObjects2.DataConnection<BR>    Dim gds As MapObjects2.GeoDataset<BR>    Dim mlyr As MapObjects2.MapLayer<BR>    Dim i As Integer<BR>    Dim MyLayer(24) As String<BR>    Dim MyLayerColor(24) As Long</P>
<P>    '定义24个图层及颜色<BR>    MyLayer(0) = "DISE"                         '22号图层<BR>    MyLayerColor(0) = RGB(;HFD, ;HFF, ;HEB)</P>
<P>    MyLayer(1) = "LVDI"<BR>    MyLayerColor(1) = RGB(;HAE, ;HF1, ;HB0)</P>
<P>    MyLayer(2) = "ZHUYAOJIEDAO_MIANHEI"<BR>    MyLayerColor(2) = RGB(;HC1, ;HF7, ;HF5)</P>
<P>    MyLayer(3) = "ZHUYAOJIEDAO_MIAN"<BR>    MyLayerColor(3) = RGB(;HEF, ;HFC, ;HD7)</P>
<P>    MyLayer(4) = "ZHUYAOJIEDAO"<BR>    MyLayerColor(4) = RGB(;HFF, ;H7F, ;H7F)</P>
<P>    MyLayer(5) = "YIBANJIEDAO_MIANHEI"<BR>    MyLayerColor(5) = RGB(;HFF, ;HEA, ;HBE)</P>
<P>    MyLayer(6) = "YIBANJIEDAO_MIAN"<BR>    MyLayerColor(6) = RGB(;HD6, ;HFF, ;HFA)</P>
<P>    MyLayer(7) = "YIBANJIEDAO"<BR>    MyLayerColor(7) = RGB(;H73, ;HDF, ;HFF)</P>
<P>    MyLayer(8) = "CIYAOJIEDAO_MIANHEI"<BR>    MyLayerColor(8) = RGB(;HFF, ;HEA, ;HBE)</P>
<P>    MyLayer(9) = "CIYAOJIEDAOMIAN"<BR>    MyLayerColor(9) = RGB(;HC4, ;HD5, ;HF5)</P>
<P>    MyLayer(10) = "CIYAOJIEDAO"<BR>    MyLayerColor(10) = RGB(;H49, ;H91, ;H0)</P>
<P>    MyLayer(11) = "BINGUAN"<BR>    MyLayerColor(11) = RGB(;HE1, ;HE1, ;HE1)</P>
<P>    MyLayer(12) = "CANGUAN"<BR>    MyLayerColor(12) = RGB(;HBE, ;HFF, ;HE8)</P>
<P>    MyLayer(13) = "DITIE"<BR>    MyLayerColor(13) = RGB(;HDF, ;H73, ;HFF)</P>
<P>    MyLayer(14) = "GONGSI"                      '8号图层<BR>    MyLayerColor(14) = RGB(;H0, ;H0, ;H0)</P>
<P>    MyLayer(15) = "HELIU"<BR>    MyLayerColor(15) = RGB(;H97, ;HDB, ;HF2)</P>
<P>    MyLayer(16) = "SHANGDIAN"<BR>    MyLayerColor(16) = RGB(;HAA, ;HFF, ;H0)</P>
<P>    MyLayer(17) = "SHUDIAN"<BR>    MyLayerColor(17) = RGB(;HCD, ;HCD, ;H66)</P>
<P>    MyLayer(18) = "SUIDAO"<BR>    MyLayerColor(18) = RGB(;H73, ;HB2, ;HFF)</P>
<P>    MyLayer(19) = "TUKUO"<BR>    MyLayerColor(19) = RGB(;HF5, ;HA2, ;H7A)</P>
<P>    MyLayer(20) = "YANJIUSUO"<BR>    MyLayerColor(20) = RGB(;HFF, ;HBE, ;HE8)</P>
<P>    MyLayer(21) = "YIYUAN"                      '1号图层<BR>    MyLayerColor(21) = RGB(;HFF, ;H7F, ;H7F)</P>
<P>    MyLayer(22) = "ZHUYAOJIANZHU"               '0号图层<BR>    MyLayerColor(22) = RGB(;H73, ;HDF, ;HFF)<BR>    <BR>    '加载地图  23个图层<BR>    dc.Database = App.Path<BR>    dc.Connect<BR>    If Not dc.Connect Then<BR>        MsgBox "Could not find data"<BR>        End<BR>    End If</P>
<P>    For i = 0 To 22<BR>        Set mlyr = New MapObjects2.MapLayer<BR>        mlyr.GeoDataset = dc.FindGeoDataset(MyLayer(i))<BR>        mlyr.Symbol.Color = MyLayerColor(i)<BR>        Map1.Layers.Add mlyr<BR>        Set mlyr = Nothing<BR>    Next<BR>    <BR>    Map1.Extent = Map1.FullExtent<BR>End Sub</P>
<P>'识别地图上的建筑物<BR>Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)<BR>    MoveDisplay X, Y<BR>End Sub</P>
<P>'显示标注字符<BR>Sub DisPlayWord()<BR>    Dim lyr As New MapObjects2.MapLayer<BR>    Dim lblRenderer As New MapObjects2.LabelRenderer<BR>    Dim dcon As New MapObjects2.DataConnection<BR>    <BR>    dcon.Database = App.Path<BR>    dcon.Connect</P>
<P>    lyr.GeoDataset = dcon.FindGeoDataset("heliu") '("SLGIS.Features.Annotations")<BR>    'If LCase(Right(lyr.Name, 11)) = "annotations" Then<BR>        Map1.Layers.Add lyr<BR>        lblRenderer.Field = "name"<BR>        'lblRenderer.LevelField = "shap"<BR>        'lblRenderer.XOffsetField = "X_Offset"<BR>        'lblRenderer.YOffsetField = "Y_Offset"<BR>        'lblRenderer.HeightField = "Height"<BR>        lblRenderer.DrawBackground = False<BR>        lblRenderer.SplinedText = True<BR>        Set lyr.Renderer = lblRenderer<BR>    'End If<BR>End Sub</P>
<P>'显示鼠标移动到的位置的建筑物 名称<BR>Sub MoveDisplay(X As Single, Y As Single)<BR>    Dim mlyr As MapObjects2.MapLayer<BR>    Dim p As MapObjects2.Point<BR>    Dim recs As Recordset<BR>    Dim fld As Fields<BR>    <BR>        Set mlyr = Map1.Layers(lname(Combo1.ListIndex))<BR>        Set p = Map1.ToMapPoint(X, Y)<BR>        Set recs = mlyr.SearchShape(p, moPointInPolygon, "")    'moPointInPolygon<BR>        <BR>        Label2.Caption = ""<BR>        If Not recs.EOF Then<BR>            'For Each fld In recs.Fields<BR>            'Label2.Caption = fld.ValueAsString<BR>            Label2.Caption = recs.Fields("name")<BR>        End If<BR>        Set mlyr = Nothing<BR>End Sub</P>
喜欢0 评分0
fengzigis
路人甲
路人甲
  • 注册日期2008-02-20
  • 发帖数66
  • QQ
  • 铜币239枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2009-01-04 19:35
太高深了,看不懂
举报 回复(0) 喜欢(0)     评分
游客

返回顶部