frmdrawprops.frm

下载后

        Next
        cboUnique_Click
        Exit Sub
        
    End If
    
End Sub


Private Sub cboUnique_Click()
    Dim recs As New MapObjects2.Recordset
    Dim uniquevals As New MapObjects2.Strings
    Dim retval As Integer
    Dim goOn As Boolean
    Dim i As Integer
    
    Const tpi = 1440 'Twips per inch
  'Size the grid initially to 2 by 2 and grow as needed.
        grdValues.Clear
        grdValues.Cols = 2: grdValues.Rows = 2
        'Position on first row and set first column settings
        grdValues.Row = 0: grdValues.Col = 0
        grdValues.ColWidth(0) = tpi * 1.3
        grdValues.ColAlignment(0) = 1 'right align
        grdValues.Text = "Value"
        'Second column settings
        grdValues.Col = 1
        grdValues.ColWidth(1) = tpi * 0.6
        grdValues.Text = "Symbol"
        grdValues.FixedRows = 1: grdValues.FixedCols = 0
        
    If cboUnique.List(cboUnique.ListIndex) <> "None" Then
        'Load up the grid
        
        Set recs = drawLayer.Records
        recs.MoveFirst
        goOn = False
        Do While Not recs.EOF
            uniquevals.Add recs(cboUnique.Text).Value
            If tabUp = True Then
                goOn = True
            Else
                If uniquevals.Count > 25 And goOn = False Then
                    retval = MsgBox("There are more than 25 unique values. Continue?", vbYesNo)
                    If retval = vbNo Then
                        Exit Do
                    Else
                        goOn = True
                    End If
                End If
            End If
            recs.MoveNext
        Loop
   
        'have the list, build the grid
        'Set drawLayer.Renderer = vmr
        
        curFeatureType = drawLayer.shapeType
        Select Case drawLayer.shapeType
        
        Case moPoint
            vmr.SymbolType = moPointSymbol
        Case moLine
            vmr.SymbolType = moLineSymbol
        Case moPolygon
            vmr.SymbolType = moFillSymbol
        End Select
        
        vmr.ValueCount = uniquevals.Count
        vmr.Field = cboUnique.Text
    
        'Add the values and pictures to the flex grid grdValues
        For i = 0 To vmr.ValueCount - 1
            grdValues.Row = i + 1
            grdValues.Col = 0
            grdValues.Text = uniquevals(i)
            'go to second column
            grdValues.Col = 1
            vmr.Value(i) = uniquevals(i)
            Set tempSymbol = Nothing
            With vmr.symbol(i)
                tempSymbol.SymbolType = vmr.SymbolType
                tempSymbol.Color = .Color
                tempSymbol.Size = .Size
                tempSymbol.Style = .Style
            End With
            
            Form2.MapDrawSymbol.TrackingLayer.Refresh True
            Form2.MapDrawSymbol.CopyMap 1
            Set grdValues.CellPicture = Clipboard.GetData
            grdValues.CellPictureAlignment = flexAlignLeftCenter
            grdValues.Rows = grdValues.Rows + 1
        Next
        'Remove blank line at end
        grdValues.Rows = grdValues.Rows - 1
        grdValues.RowHeight(-1) = tpi * 0.25
        
    End If
End Sub





Private Sub cmdCancel_Click()
    If drawLayer.Tag = "UniqueValue" Then
        'need to reset vmr
        Dim i As Integer
        Dim rv As New MapObjects2.ValueMapRenderer
        Set rv = drawLayer.Renderer
        vmr.Field = rv.Field
        vmr.SymbolType = rv.SymbolType
        vmr.ValueCount = rv.ValueCount
        For i = 0 To vmr.ValueCount - 1
            vmr.Value(i) = rv.Value(i)
            vmr.symbol(i).Color = rv.symbol(i).Color
            vmr.symbol(i).Style = rv.symbol(i).Style
            vmr.symbol(i).Size = rv.symbol(i).Size
        Next
        
    End If
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Select Case TabStrip1.SelectedItem.index
    Case 1
        Set drawLayer.Renderer = Nothing
        drawLayer.Tag = ""
        With drawLayer.symbol
            .Color = pctColor.BackColor
            .Style = cboStyle.ListIndex
            If drawLayer.shapeType <> moPolygon Then
                .Size = txtSize
            End If
        End With
        
    Case 2
        Dim rv As New MapObjects2.ValueMapRenderer
        Set drawLayer.Renderer = rv
        rv.Field = vmr.Field
        rv.SymbolType = vmr.SymbolType
        rv.ValueCount = vmr.ValueCount
        Dim i As Integer
        For i = 0 To vmr.ValueCount - 1
            rv.Value(i) = vmr.Value(i)
            rv.symbol(i).Color = vmr.symbol(i).Color
            rv.symbol(i).Style = vmr.symbol(i).Style
            rv.symbol(i).Size = vmr.symbol(i).Size
        Next
        drawLayer.Tag = "UniqueValue"
    End Select
        
    Form1.Map1.Refresh
    'AutoRedraw = False
    Unload Me
End Sub

Private Sub Form_Load()
    Dim curTab As Integer
    Dim i As Integer
    lblLayerName = drawLayer.Name
    'when first loaded into the map, all layers have a blank tag
    If drawLayer.Tag = "" Then drawLayer.Tag = "SingleSymbol"
    tabUp = True
    
    Select Case drawLayer.Tag
    Case "SingleSymbol"
        curTab = 1
    Case "UniqueValue"
        curTab = 2
    End Select
    
    Set TabStrip1.SelectedItem = TabStrip1.Tabs.Item(curTab)

    tabUp = False
    
End Sub

Private Sub grdValues_Click()

    If tabUp Then
        Exit Sub
    End If
    If grdValues.Col = 0 Then
        Exit Sub
    End If
    If grdValues.Row = 0 Then
        Exit Sub
    End If
    grdValues.Col = 0  'grdValues.Col - 1
    curFeatureName = grdValues.Text
    grdValues.Col = 1 'grdValues.Col + 1
    
    Set tempSymbol = Nothing
    
    With vmr.symbol(grdValues.Row - 1)
        tempSymbol.SymbolType = .SymbolType
        tempSymbol.Color = .Color
        tempSymbol.Style = .Style
        tempSymbol.Size = .Size
    End With
    
    frmSymbol.Show vbModal
    If bolChanged = True Then
        With vmr.symbol(grdValues.Row - 1)
            .Color = tempSymbol.Color
            .Style = tempSymbol.Style
            .Size = tempSymbol.Size
        End With
        
        Form2.MapDrawSymbol.TrackingLayer.Refresh True
        
        Form2.MapDrawSymbol.CopyMap 1
        Set grdValues.CellPicture = Clipboard.GetData
        grdValues.CellPictureAlignment = flexAlignCenterCenter
    End If

End Sub

Private Sub pctColor_Click()
    Dim curcolor As Long
    CommonDialog1.CancelError = True
    On Error GoTo ErrHandler
    CommonDialog1.ShowColor
    curcolor = CommonDialog1.Color
    pctColor.BackColor = curcolor
    Exit Sub
    
ErrHandler:
    'do nothing, just exit
    Exit Sub
   
      
End Sub

Private Sub TabStrip1_Click()
    Dim i As Integer
    
    For i = 1 To TabStrip1.Tabs.Count
        If TabStrip1.SelectedItem.index = i Then
            TFrame(i - 1).Visible = True
        Else
            TFrame(i - 1).Visible = False
        End If
    Next
    Select Case TabStrip1.SelectedItem.index
    Case 1
        RestoreSingleValueMap
    Case 2
        tabUp = True
        RestoreUniqueValueMap
        tabUp = False
    End Select
End Sub