frmdrawprops.frm

下载后

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmDrawProps 
   AutoRedraw      =   -1  'True
   Caption         =   "Drawing Properties"
   ClientHeight    =   6675
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6690
   LinkTopic       =   "Form3"
   ScaleHeight     =   6675
   ScaleWidth      =   6690
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Height          =   375
      Left            =   1560
      TabIndex        =   13
      Top             =   6000
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   3840
      TabIndex        =   12
      Top             =   6000
      Width           =   1215
   End
   Begin VB.Frame TFrame 
      Height          =   4095
      Index           =   0
      Left            =   120
      TabIndex        =   1
      Top             =   1560
      Width           =   6135
      Begin VB.TextBox txtSize 
         Height          =   375
         Left            =   3120
         TabIndex        =   7
         Text            =   "Text1"
         Top             =   1860
         Width           =   735
      End
      Begin VB.ComboBox cboStyle 
         Height          =   315
         Left            =   3120
         TabIndex        =   6
         Text            =   "Combo1"
         Top             =   2640
         Width           =   2055
      End
      Begin VB.PictureBox pctColor 
         Height          =   375
         Left            =   3120
         ScaleHeight     =   315
         ScaleWidth      =   675
         TabIndex        =   5
         Top             =   1080
         Width           =   735
      End
      Begin VB.Label Label3 
         Caption         =   "Style"
         Height          =   375
         Left            =   1440
         TabIndex        =   4
         Top             =   2640
         Width           =   735
      End
      Begin VB.Label Label2 
         Caption         =   "Size"
         Height          =   375
         Left            =   1440
         TabIndex        =   3
         Top             =   1860
         Width           =   735
      End
      Begin VB.Label Label1 
         Caption         =   "Color"
         Height          =   375
         Left            =   1440
         TabIndex        =   2
         Top             =   1080
         Width           =   735
      End
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   480
      Top             =   5880
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame TFrame 
      Height          =   4095
      Index           =   1
      Left            =   120
      TabIndex        =   8
      Top             =   1560
      Width           =   6135
      Begin MSFlexGridLib.MSFlexGrid grdValues 
         Height          =   2415
         Left            =   2040
         TabIndex        =   11
         Top             =   1080
         Width           =   3735
         _ExtentX        =   6588
         _ExtentY        =   4260
         _Version        =   393216
         BackColorFixed  =   -2147483637
         BackColorSel    =   -2147483643
         BackColorBkg    =   -2147483643
         AllowBigSelection=   0   'False
         HighLight       =   0
         GridLines       =   2
         GridLinesFixed  =   1
         AllowUserResizing=   1
      End
      Begin VB.ComboBox cboUnique 
         Height          =   315
         Left            =   2880
         Style           =   2  'Dropdown List
         TabIndex        =   9
         Top             =   360
         Width           =   2895
      End
      Begin VB.Label Label4 
         Caption         =   "Field"
         Height          =   315
         Left            =   1680
         TabIndex        =   10
         Top             =   360
         Width           =   855
      End
   End
   Begin ComctlLib.TabStrip TabStrip1 
      Height          =   5175
      Left            =   120
      TabIndex        =   0
      Top             =   720
      Width           =   6375
      _ExtentX        =   11245
      _ExtentY        =   9128
      _Version        =   327682
      BeginProperty Tabs {0713E432-850A-101B-AFC0-4210102A8DA7} 
         NumTabs         =   2
         BeginProperty Tab1 {0713F341-850A-101B-AFC0-4210102A8DA7} 
            Caption         =   "Single Symbol"
            Key             =   "SingleSymbol"
            Object.Tag             =   ""
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {0713F341-850A-101B-AFC0-4210102A8DA7} 
            Caption         =   "Unique Value"
            Key             =   "Unique"
            Object.Tag             =   ""
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin VB.Label lblLayerName 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Left            =   3240
      TabIndex        =   14
      Top             =   120
      Width           =   2895
   End
End
Attribute VB_Name = "frmDrawProps"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public vmr As New MapObjects2.ValueMapRenderer
Dim report As Boolean
Public tempSymbol As New MapObjects2.symbol
Public curDrawSymbol As New clsDrawSymbol
Public curFeatureType As Integer
Public curFeatureName As String
Dim tabUp As Boolean
Private Sub RestoreSingleValueMap()
        With drawLayer

            pctColor.BackColor = .symbol.Color
            txtSize = .symbol.Size
            cboStyle.Clear
            Select Case .shapeType
            Case moPoint
                cboStyle.AddItem "Circle"
                cboStyle.AddItem "Square"
                cboStyle.AddItem "Triangle"
                cboStyle.AddItem "Cross"
            Case moLine
                cboStyle.AddItem "Solid Line"
                cboStyle.AddItem "Dash Line"
                cboStyle.AddItem "Dot Line"
                cboStyle.AddItem "Dash Dot"
                cboStyle.AddItem "Dash Dot Dot"
            Case moPolygon
                Label2.Visible = False
                txtSize.Visible = False
                cboStyle.AddItem "Solid Fill"
                cboStyle.AddItem "Transparent"
                cboStyle.AddItem "Horizontal"
                cboStyle.AddItem "Vertical"
                cboStyle.AddItem "Upward Diagonal"
                cboStyle.AddItem "Downward Diagonal"
                cboStyle.AddItem "Cross"
                cboStyle.AddItem "Diagonal Cross"
            End Select
            cboStyle.ListIndex = .symbol.Style
        End With
End Sub
Private Sub RestoreUniqueValueMap()
    Dim recs As New MapObjects2.Recordset
    Set recs = drawLayer.Records
    Dim fld As MapObjects2.Field
    Dim i As Integer
    Const tpi = 1440 'Twips per inch

    cboUnique.Clear
    cboUnique.AddItem "None"
    For Each fld In recs.Fields
        If fld.Name <> "Shape" Then
            If fld.Name <> "FeatureId" Then
                cboUnique.AddItem fld.Name
            End If
        End If
    Next
    
    If drawLayer.Tag <> "UniqueValue" Then
        cboUnique.ListIndex = 0
    Else 'the layer is currently displayed with a vmr
        cboUnique.ListIndex = 0
        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
        
        For i = 0 To cboUnique.listCount - 1
            'Set the cboUnique value
            If cboUnique.List(i) = rv.Field Then
                cboUnique.ListIndex = i
            End If