自己定制的SymbolSelectForm效果及VB.NET源码

                            

           自己定制的SymbolSelectForm效果及VB.NET源码

 

声明:本帖请勿随意转载,如有需要请联系gispeng@vip.qq.com!谢谢!

 

 先看一下效果图:

 

 

 

 

 

 

 

 

 

以下是整个SymbolSelectForm 源码:

 

 

Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms.Form
Imports System.Windows.Forms
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.SystemUI
Imports ESRI.ArcGIS.Controls

Public Class SymbolSelectorFrm
    Private pStyleGalleryItem As IStyleGalleryItem = Nothing
    Private pLegendClass As ILegendClass = Nothing
    Private pLayer As ILayer = Nothing
    Public pSymbol As ISymbol = Nothing
    Public pSymbolImage As Image = Nothing
    Private contextMenuMoreSymbolInitiated As Boolean = False

    Public Sub New(ByVal tempLegendClass As ILegendClass, ByVal tempLayer As ILayer)

        ' 此调用是 Windows 窗体设计器所必需的。
        InitializeComponent()
        ' 在 InitializeComponent() 调用之后添加任何初始化。
        pLegendClass = tempLegendClass
        pLayer = tempLayer
    End Sub


    Private Sub SymbolSelectorFrm_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        ''Get the ArcGIS install location 
        'Dim sInstall As String = ReadRegistry("SOFTWARE\ESRI\CoreRuntime")

        ''Load the ESRI.ServerStyle file into the SymbologyControl 
        'Me.axSymbologyControl.LoadStyleFile(sInstall + "\Styles\ESRI.ServerStyle")
        'Get the ArcGIS install location
        Dim sInstall As String = ReadRegistry("SOFTWARE\\ESRI\\CoreRuntime")

        'Load the ESRI.ServerStyle file into the SymbologyControl
        axSymbologyControl1.LoadStyleFile(sInstall + "\\Styles\\ESRI.ServerStyle")

        '确定图层的类型(点线面),设置好SymbologyControl的StyleClass,设置好各控件的可见性(visible) 
        Dim pGeoFeatureLayer As IGeoFeatureLayer = DirectCast(pLayer, IGeoFeatureLayer)
        Select Case DirectCast(pLayer, IFeatureLayer).FeatureClass.ShapeType
            Case ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPoint
                Me.SetFeatureClassStyle(esriSymbologyStyleClass.esriStyleClassMarkerSymbols)
                Me.lblAngle.Visible = True
                Me.nudAngle.Visible = True
                Me.lblSize.Visible = True
                Me.nudSize.Visible = True
                Me.lblWidth.Visible = False
                Me.nudWidth.Visible = False
                Me.lblOutlineColor.Visible = False
                Me.btnOutlineColor.Visible = False
                Exit Select
            Case ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPolyline
                Me.SetFeatureClassStyle(esriSymbologyStyleClass.esriStyleClassLineSymbols)
                Me.lblAngle.Visible = False
                Me.nudAngle.Visible = False
                Me.lblSize.Visible = False
                Me.nudSize.Visible = False
                Me.lblWidth.Visible = True
                Me.nudWidth.Visible = True
                Me.lblOutlineColor.Visible = False
                Me.btnOutlineColor.Visible = False
                Exit Select
            Case ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryPolygon
                Me.SetFeatureClassStyle(esriSymbologyStyleClass.esriStyleClassFillSymbols)
                Me.lblAngle.Visible = False
                Me.nudAngle.Visible = False
                Me.lblSize.Visible = False
                Me.nudSize.Visible = False
                Me.lblWidth.Visible = True
                Me.nudWidth.Visible = True
                Me.lblOutlineColor.Visible = True
                Me.btnOutlineColor.Visible = True
                Exit Select
            Case ESRI.ArcGIS.Geometry.esriGeometryType.esriGeometryMultiPatch
                Me.SetFeatureClassStyle(esriSymbologyStyleClass.esriStyleClassFillSymbols)
                Me.lblAngle.Visible = False
                Me.nudAngle.Visible = False
                Me.lblSize.Visible = False
                Me.nudSize.Visible = False
                Me.lblWidth.Visible = True
                Me.nudWidth.Visible = True
                Me.lblOutlineColor.Visible = True
                Me.btnOutlineColor.Visible = True
                Exit Select
            Case Else
                Me.Close()
                Me.Dispose()
                Exit Select
        End Select
    End Sub

    ''' <summary> 
    ''' 设置好SymbologyControl的StyleClass,如果有图例,把当前的TOC图例的符号添加到当前SymbologyStyleClass中去,并让之处于选中状态 
    ''' </summary> 
    ''' <param name="symbologyStyleClass"></param> 
    Private Sub SetFeatureClassStyle(ByVal symbologyStyleClass As esriSymbologyStyleClass)
        Me.axSymbologyControl1.StyleClass = symbologyStyleClass
        Dim pSymbologyStyleClass As ISymbologyStyleClass = Me.axSymbologyControl1.GetStyleClass(symbologyStyleClass)
        If Me.pLegendClass IsNot Nothing Then
            Dim currentStyleGalleryItem As IStyleGalleryItem = New ServerStyleGalleryItem()
            currentStyleGalleryItem.Name = "当前符号"
            currentStyleGalleryItem.Item = pLegendClass.Symbol
            pSymbologyStyleClass.AddItem(currentStyleGalleryItem, 0)
            Me.pStyleGalleryItem = currentStyleGalleryItem
        End If
        pSymbologyStyleClass.SelectItem(0)
    End Sub
    ''' <summary> 
    ''' 读取注册表中的制定软件的路径 
    ''' </summary> 
    ''' <param name="sKey"></param> 
    ''' <returns></returns> 
    Private Function ReadRegistry(ByVal sKey As String) As String
        'Open the subkey for reading 
        Dim rk As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey(sKey, True)
        If rk Is Nothing Then
            Return ""
        End If
        ' Get the data from a specified item in the key. 
        Return DirectCast(rk.GetValue("InstallDir"), String)
    End Function


    Private Sub btnCancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCancel.Click
        Me.Close()
    End Sub

    Private Sub axSymbologyControl1_OnDoubleClick(ByVal sender As Object, ByVal e As ESRI.ArcGIS.Controls.ISymbologyControlEvents_OnDoubleClickEvent) Handles axSymbologyControl1.OnDoubleClick
        Me.btnOK.PerformClick()
    End Sub

    Private Sub axSymbologyControl1_OnItemSelected(ByVal sender As Object, ByVal e As ESRI.ArcGIS.Controls.ISymbologyControlEvents_OnItemSelectedEvent) Handles axSymbologyControl1.OnItemSelected
        pStyleGalleryItem = DirectCast(e.styleGalleryItem, IStyleGalleryItem)
        Dim color As Color
        Select Case Me.axSymbologyControl1.StyleClass
            Case esriSymbologyStyleClass.esriStyleClassMarkerSymbols
                color = Me.ConvertIRgbColorToColor(TryCast(DirectCast(pStyleGalleryItem.Item, IMarkerSymbol).Color, IRgbColor))
                Exit Select
            Case esriSymbologyStyleClass.esriStyleClassLineSymbols
                color = Me.ConvertIRgbColorToColor(TryCast(DirectCast(pStyleGalleryItem.Item, ILineSymbol).Color, IRgbColor))
                Exit Select
            Case esriSymbologyStyleClass.esriStyleClassFillSymbols
                color = Me.ConvertIRgbColorToColor(TryCast(DirectCast(pStyleGalleryItem.Item, IFillSymbol).Color, IRgbColor))
                Me.btnOutlineColor.BackColor = Me.ConvertIRgbColorToColor(TryCast(DirectCast(pStyleGalleryItem.Item, IFillSymbol).Outline.Color, IRgbColor))
                Exit Select
            Case Else
                color = color.Black
                Exit Select
        End Select
        Me.btnColor.BackColor = color
        Me.PreviewImage()
    End Sub

    ''' <summary> 
    ''' 将ArcGIS Engine中的IRgbColor接口转换至.NET中的Color结构 
    ''' </summary> 
    ''' <param name="pRgbColor">IRgbColor</param> 
    ''' <returns>.NET中的System.Drawing.Color结构表示ARGB颜色</returns> 
    Public Function ConvertIRgbColorToColor(ByVal pRgbColor As IRgbColor) As Color
        Return ColorTranslator.FromOle(pRgbColor.RGB)
    End Function
    ''' <summary> 
    ''' 将.NET中的Color结构转换至于ArcGIS Engine中的IColor接口 
    ''' </summary> 
    ''' <param name="color">.NET中的System.Drawing.Color结构表示ARGB颜色</param> 
    ''' <returns>IColor</returns> 
    Public Function ConvertColorToIColor(ByVal color As Color) As IColor
        Dim pColor As IColor = New RgbColorClass()
        pColor.RGB = color.B * 65536 + color.G * 256 + color.R
        Return pColor
    End Function
    ''' <summary> 
    ''' 将.NET中的Color结构转换至于ArcGIS Engine中的IRgbColor接口 
    ''' </summary> 
    ''' <param name="color">.NET中的System.Drawing.Color结构表示ARGB颜色</param> 
    ''' <returns>IRgbColor</returns> 
    Public Function ConvertColorToIRgbColor(ByVal color As Color) As IRgbColor
        Dim pRgbColor As IRgbColor = New RgbColorClass()
        pRgbColor.RGB = color.B * 65536 + color.G * 256 + color.R
        Return pRgbColor
    End Function

    ''' <summary> 
    ''' 把选中并设置好的符号在picturebox中预览 
    ''' </summary> 
    Private Sub PreviewImage()
        Dim picture As stdole.IPictureDisp = Me.axSymbologyControl1.GetStyleClass(Me.axSymbologyControl1.StyleClass).PreviewItem(pStyleGalleryItem, Me.ptbPreview.Width, Me.ptbPreview.Height)
        Dim image As System.Drawing.Image = System.Drawing.Image.FromHbitmap(New System.IntPtr(picture.Handle))
        Me.ptbPreview.Image = image
    End Sub

    Private Sub btnOK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOK.Click
        'pLegendClass.Symbol = (ISymbol)pStyleGalleryItem.Item; 
        Me.pSymbol = DirectCast(pStyleGalleryItem.Item, ISymbol)
        Me.pSymbolImage = Me.ptbPreview.Image
        Me.Close()
    End Sub

    Private Sub btnColor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnColor.Click
        If Me.colorDialog.ShowDialog() = DialogResult.OK Then
            Me.btnColor.BackColor = Me.colorDialog.Color
            Select Case Me.axSymbologyControl1.StyleClass
                Case esriSymbologyStyleClass.esriStyleClassMarkerSymbols
                    DirectCast(Me.pStyleGalleryItem.Item, IMarkerSymbol).Color = Me.ConvertColorToIColor(Me.colorDialog.Color)
                    Exit Select
                Case esriSymbologyStyleClass.esriStyleClassLineSymbols
                    DirectCast(Me.pStyleGalleryItem.Item, ILineSymbol).Color = Me.ConvertColorToIColor(Me.colorDialog.Color)
                    Exit Select
                Case esriSymbologyStyleClass.esriStyleClassFillSymbols
                    DirectCast(Me.pStyleGalleryItem.Item, IFillSymbol).Color = Me.ConvertColorToIColor(Me.colorDialog.Color)
                    Exit Select
            End Select
            Me.PreviewImage()
        End If
    End Sub

    Private Sub axSymbologyControl1_OnStyleClassChanged(ByVal sender As Object, ByVal e As ESRI.ArcGIS.Controls.ISymbologyControlEvents_OnStyleClassChangedEvent) Handles axSymbologyControl1.OnStyleClassChanged
        Select Case DirectCast((e.symbologyStyleClass), esriSymbologyStyleClass)
            Case esriSymbologyStyleClass.esriStyleClassMarkerSymbols
                Me.lblAngle.Visible = True
                Me.nudAngle.Visible = True
                Me.lblSize.Visible = True
                Me.nudSize.Visible = True
                Me.lblWidth.Visible = False
                Me.nudWidth.Visible = False
                Me.lblOutlineColor.Visible = False
                Me.btnOutlineColor.Visible = False
                Exit Select
            Case esriSymbologyStyleClass.esriStyleClassLineSymbols
                Me.lblAngle.Visible = False
                Me.nudAngle.Visible = False
                Me.lblSize.Visible = False
                Me.nudSize.Visible = False
                Me.lblWidth.Visible = True
                Me.nudWidth.Visible = True
                Me.lblOutlineColor.Visible = False
                Me.btnOutlineColor.Visible = False
                Exit Select
            Case esriSymbologyStyleClass.esriStyleClassFillSymbols
                Me.lblAngle.Visible = False
                Me.nudAngle.Visible = False
                Me.lblSize.Visible = False
                Me.nudSize.Visible = False
                Me.lblWidth.Visible = True
                Me.nudWidth.Visible = True
                Me.lblOutlineColor.Visible = True
                Me.btnOutlineColor.Visible = True
                Exit Select
        End Select
    End Sub

    Private Sub nudSize_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles nudSize.ValueChanged
        If Me.pStyleGalleryItem Is Nothing Then Exit Sub
        DirectCast(Me.pStyleGalleryItem.Item, IMarkerSymbol).Size = CDbl(Me.nudSize.Value)
        Me.PreviewImage()
    End Sub

    Private Sub nudWidth_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles nudWidth.ValueChanged
        Select Case Me.axSymbologyControl1.StyleClass
            Case esriSymbologyStyleClass.esriStyleClassLineSymbols
                DirectCast(Me.pStyleGalleryItem.Item, ILineSymbol).Width = Convert.ToDouble(Me.nudWidth.Value)
                Exit Select
            Case esriSymbologyStyleClass.esriStyleClassFillSymbols
                Dim pLineSymbol As ILineSymbol = DirectCast(Me.pStyleGalleryItem.Item, IFillSymbol).Outline
                pLineSymbol.Width = Convert.ToDouble(Me.nudWidth.Value)
                DirectCast(Me.pStyleGalleryItem.Item, IFillSymbol).Outline = pLineSymbol
                Exit Select
        End Select
        Me.PreviewImage()
    End Sub

    Private Sub nudAngle_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles nudAngle.ValueChanged
        DirectCast(Me.pStyleGalleryItem.Item, IMarkerSymbol).Angle = CDbl(Me.nudAngle.Value)
        Me.PreviewImage()
    End Sub

    Private Sub btnOutlineColor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOutlineColor.Click
        If Me.colorDialog.ShowDialog() = DialogResult.OK Then
            Dim pLineSymbol As ILineSymbol = DirectCast(Me.pStyleGalleryItem.Item, IFillSymbol).Outline
            pLineSymbol.Color = Me.ConvertColorToIColor(Me.colorDialog.Color)
            DirectCast(Me.pStyleGalleryItem.Item, IFillSymbol).Outline = pLineSymbol
            Me.btnOutlineColor.BackColor = Me.colorDialog.Color
            Me.PreviewImage()
        End If
    End Sub

    Private Sub btnMoreSymbols_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnMoreSymbols.Click
        If Me.contextMenuMoreSymbolInitiated = False Then
            Dim sInstall As String = ReadRegistry("SOFTWARE\ESRI\CoreRuntime")
            Dim path As String = System.IO.Path.Combine(sInstall, "Styles")
            Dim styleNames As String() = System.IO.Directory.GetFiles(path, "*.ServerStyle")
            Dim symbolContextMenuItem As ToolStripMenuItem() = New ToolStripMenuItem(styleNames.Length) {}
            For i As Integer = 0 To styleNames.Length - 1
                symbolContextMenuItem(i) = New ToolStripMenuItem()
                symbolContextMenuItem(i).CheckOnClick = True
                symbolContextMenuItem(i).Text = System.IO.Path.GetFileNameWithoutExtension(styleNames(i))
                If symbolContextMenuItem(i).Text = "ESRI" Then
                    symbolContextMenuItem(i).Checked = True
                End If
                symbolContextMenuItem(i).Name = styleNames(i)
                AddHandler symbolContextMenuItem(i).Click, AddressOf symbolContextMenuItem_Click
            Next
            symbolContextMenuItem(styleNames.Length) = New ToolStripMenuItem()
            symbolContextMenuItem(styleNames.Length).Text = "更多符号"
            AddHandler symbolContextMenuItem(styleNames.Length).Click, AddressOf symbolContextMenuItemMoreSymbols_Click
            Me.contextMenuStripMoreSymbol.Items.AddRange(symbolContextMenuItem)
            Me.contextMenuMoreSymbolInitiated = True
        End If
        Me.contextMenuStripMoreSymbol.Show(Me.btnMoreSymbols.Location)
    End Sub

    Private Sub symbolContextMenuItemMoreSymbols_Click(ByVal sender As Object, ByVal e As EventArgs)
        If Me.openFileDialog.ShowDialog() = DialogResult.OK Then
            Me.axSymbologyControl1.LoadStyleFile(Me.openFileDialog.FileName)
            Me.axSymbologyControl1.Refresh()
        End If
    End Sub

    Private Sub symbolContextMenuItem_Click(ByVal sender As Object, ByVal e As EventArgs)
        Dim pToolStripMenuItem As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
        'Load the style file into the SymbologyControl 
        If pToolStripMenuItem.Checked = True Then
            Me.axSymbologyControl1.LoadStyleFile(pToolStripMenuItem.Name)
            Me.axSymbologyControl1.Refresh()
        Else
            Me.axSymbologyControl1.RemoveFile(pToolStripMenuItem.Name)
            Me.axSymbologyControl1.Refresh()
        End If
    End Sub
End Class