[原创]一个VB-MAPGIS小程序的源代码

<P>一个VB小程序的源代码</P>
<P>为想学编程的朋友提供一个小小的帮助。该程序的作用的根据属性付面参数。</P>
<P>'根据属性付面参数</P>
<P>    Dim regObj As RegArea
    Dim i As Long
    Dim dldm As String
    Dim ATT As Record
    Dim flag As Integer, rtl As Integer
    Dim inf1 As Reg_Info
    
    '取区属性  ===(包括取二进制字段值)
    Set regObj = New RegArea
    
    If (regObj.Load()) Then
        For i = 1 To regObj.Count - 1
      
            flag = regObj.RegAtt.Get(i, ATT)  '将第i个图斑的属性放入ATT中
            
                dldm = ATT.Item(8).Value   '将地类代码付入DLDM变量中</P>
<P>                Select Case dldm           '根据地类代码付图斑的颜色
                  Case "11", "12", "13"
                     Set inf1 = New Reg_Info
                       With inf1
                         .clr = 501
                         .patclr = 0
                         .pathei = 0
                         .patno = 1
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)    '修改第i个图斑的颜色
                
                    Case "14"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 972
                         .patclr = 0
                         .pathei = 0
                         .patno = 0
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "15"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 973
                         .patclr = 0
                         .pathei = 0
                         .patno = 0
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "21", "22", "23", "24", "25"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 974
                         .patclr = 0
                         .pathei = 0
                         .patno = 0
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "31", "32", "33", "34", "35", "36"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 979
                         .patclr = 0
                         .pathei = 0
                         .patno = 0
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "41", "42", "43"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 980
                         .patclr = 0
                         .pathei = 0
                         .patno = 0
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "51B"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 981
                         .patclr = 1
                         .pathei = 50
                         .patno = 153
                         .patwid = 50
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "52"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 981
                         .patclr = 1
                         .pathei = 50
                         .patno = 154
                         .patwid = 50
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "53", "55"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 981
                         .patclr = 0
                         .pathei = 0
                         .patno = 0
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "71", "72", "73", "74", "75", "76", "77", "78"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 988
                         .patclr = 0
                         .pathei = 0
                         .patno = 0
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "81"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 983
                         .patclr = 0
                         .pathei = 0
                         .patno = 0
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "82"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 984
                         .patclr = 0
                         .pathei = 0
                         .patno = 0
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "83"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 984
                         .patclr = 1
                         .pathei = 80
                         .patno = 157
                         .patwid = 80
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "84"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 984
                         .patclr = 1
                         .pathei = 20
                         .patno = 151
                         .patwid = 20
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                    Case "85", "86"
                    Set inf1 = New Reg_Info
                       With inf1
                         .clr = 986
                         .patclr = 0
                         .pathei = 0
                         .patno = 0
                         .patwid = 0
                         .res0 = gisON
                         .res1 = gisON
                       End With
                    rtl = regObj.UpdateInfo(i, inf1)
                    
                End Select
                
            
            Set ATT = Nothing
        Next i
        
        
        rtl = regObj.Save()   '保存区文件
    End If
    
    Set regObj = Nothing
End Sub</P>

<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em03.gif" /><img src="images/post/smile/dvbbs/em06.gif" />

很好的资料，谢谢

谢谢了

<img src="images/post/smile/dvbbs/em07.gif" />

<img src="images/post/smile/dvbbs/em01.gif" />

谢谢分享<img src="images/post/smile/dvbbs/em06.gif" />

<img src="images/post/smile/dvbbs/em05.gif" />

用VB开发Mapgis，需要在VB6里加入引用吗？另外VB开发能不能最大限度的利用Mapgis 的功能？(如果可以的话，我就不用去学VC了)请赐教<img src="images/post/smile/dvbbs/em02.gif" />

<img src="images/post/smile/dvbbs/em01.gif" />我还是这样认为！