Lundi 13 novembre 2006
Voici comment affecter une couleur à un polygone dans Mappoint:
Dim adoCn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim dbPath As String
Dim strQry As String
Dim i As Long
Dim lngPop As Long
Dim oShape As MapPoint.Shape
'Recupération de la valeur de palette qui est dans le fichier Kanalyse.conf , lu au démarrage
Select Case strPalette
Case "vert"
color1 = mpLightGreen
color2 = mpBrightGreen
color3 = mpSeaGreen
color4 = mpGreen
color5 = mpDarkGreen
Case "bleu"
color1 = mpPaleBlue
color2 = mpSkyBlue
color3 = mpAqua
color4 = mpBlue
color5 = mpDarkBlue
End Select
dbPath = "chemin de mabase"
'j'utilise une base access qui stocke la données attributaire
adoCn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & dbPath & ";Persist Security Info=False")
'selection de la table qui contient des données à l'iris
strQry = "SELECT " & strTable & ".IRIS, " & strTable & ".val " _
& "From " & strTable & " ORDER BY " & strTable & ".val ;"
rs.Open strQry, adoCn, adOpenStatic, adLockOptimistic
rs.MoveLast
rs.MoveFirst
For i = 0 To rs.RecordCount - 1
lngPop = rs.Fields(1).Value
'ici le polygon mappoint , pour etre reconnu doit avoir un code iris valide
Set oShape = frmCartoDso.MappointControl0.ActiveMap.Shapes(rs.Fields(0).Value)
'oShape.Fill.ForeColor = vbBlack
'oShape.Fill.Visible = True
If lngPop >= dblRangMin(0) And lngPop < dblRangMax(0) Then
oShape.Fill.ForeColor = color1
oShape.Fill.Visible = True
oShape.ZOrder geoSendBehindRoads
End If
If lngPop >= dblRangMax(0) And lngPop < dblRangMax(1) Then
oShape.Fill.ForeColor = color2
oShape.Fill.Visible = True
oShape.ZOrder geoSendBehindRoads
End If
If lngPop >= dblRangMax(1) And lngPop < dblRangMax(2) Then
oShape.Fill.ForeColor = color3
oShape.Fill.Visible = True
oShape.ZOrder geoSendBehindRoads
End If
If lngPop >= dblRangMax(2) And lngPop < dblRangMax(3) Then
oShape.Fill.ForeColor = color4
oShape.Fill.Visible = True
oShape.ZOrder geoSendBehindRoads
End If
If lngPop >= dblRangMax(3) Then
oShape.Fill.ForeColor = color5
oShape.Fill.Visible = True
oShape.ZOrder geoSendBehindRoads
End If
rs.MoveNext
Next i
'End If
End Function
Dim adoCn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim dbPath As String
Dim strQry As String
Dim i As Long
Dim lngPop As Long
Dim oShape As MapPoint.Shape
'Recupération de la valeur de palette qui est dans le fichier Kanalyse.conf , lu au démarrage
Select Case strPalette
Case "vert"
color1 = mpLightGreen
color2 = mpBrightGreen
color3 = mpSeaGreen
color4 = mpGreen
color5 = mpDarkGreen
Case "bleu"
color1 = mpPaleBlue
color2 = mpSkyBlue
color3 = mpAqua
color4 = mpBlue
color5 = mpDarkBlue
End Select
dbPath = "chemin de mabase"
'j'utilise une base access qui stocke la données attributaire
adoCn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & dbPath & ";Persist Security Info=False")
'selection de la table qui contient des données à l'iris
strQry = "SELECT " & strTable & ".IRIS, " & strTable & ".val " _
& "From " & strTable & " ORDER BY " & strTable & ".val ;"
rs.Open strQry, adoCn, adOpenStatic, adLockOptimistic
rs.MoveLast
rs.MoveFirst
For i = 0 To rs.RecordCount - 1
lngPop = rs.Fields(1).Value
'ici le polygon mappoint , pour etre reconnu doit avoir un code iris valide
Set oShape = frmCartoDso.MappointControl0.ActiveMap.Shapes(rs.Fields(0).Value)
'oShape.Fill.ForeColor = vbBlack
'oShape.Fill.Visible = True
If lngPop >= dblRangMin(0) And lngPop < dblRangMax(0) Then
oShape.Fill.ForeColor = color1
oShape.Fill.Visible = True
oShape.ZOrder geoSendBehindRoads
End If
If lngPop >= dblRangMax(0) And lngPop < dblRangMax(1) Then
oShape.Fill.ForeColor = color2
oShape.Fill.Visible = True
oShape.ZOrder geoSendBehindRoads
End If
If lngPop >= dblRangMax(1) And lngPop < dblRangMax(2) Then
oShape.Fill.ForeColor = color3
oShape.Fill.Visible = True
oShape.ZOrder geoSendBehindRoads
End If
If lngPop >= dblRangMax(2) And lngPop < dblRangMax(3) Then
oShape.Fill.ForeColor = color4
oShape.Fill.Visible = True
oShape.ZOrder geoSendBehindRoads
End If
If lngPop >= dblRangMax(3) Then
oShape.Fill.ForeColor = color5
oShape.Fill.Visible = True
oShape.ZOrder geoSendBehindRoads
End If
rs.MoveNext
Next i
'End If
End Function