?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -