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

最新推荐文章于 2021-01-29 14:13:22 发布
最新推荐文章于 2021-01-29 14:13:22 发布
阅读量119 收藏
点赞数
文章标签： 操作系统

                            

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

 

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

 

 先看一下效果图:

 

 

 

 

 

 

 

 

 

以下是整个SymbolSelectForm 源码:

 

 

ContractedBlock.gif ExpandedBlockStart.gif Code
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

 

 

weixin_34163553
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
VB.net程序源码120实例(VS2013)
10-12
VB.NET是一种基于.NET Framework的编程语言，用于构建各种应用程序，包括桌面、Web和移动应用。这个压缩包包含120个VB.NET编程实例，适用于在Visual Studio 2013环境中学习和实践。通过这些实例，你可以深入理解VB...
VB.NET源码帝国初学者chm教程
02-11
《VB.NET源码帝国初学者chm教程》是为那些想要深入学习VB.NET编程的初学者准备的一份宝贵资源。这份教程由WorkHelper作者精心编撰，旨在帮助读者快速掌握VB.NET的基础知识，并通过源码实例提升编程技能。 VB.NET是...
VB图片动态按钮控件
键盘上的舞指
01-29 559
'新建一个ActiveX控件工程，粘贴以下代码： Option Explicit Private Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long Private Declare Function GetWindowRect Lib “user32” (ByVal hwnd As Long, lpRect As RECT) As Long Private Type RECT Left As Long Top A.
.NET中操作IPicture、IPictureDisp的小随笔
weixin_30666401的博客
10-04 391
【题外话】 最近在做一个调用某实验仪器的程序，这个仪器提供了Windows上COM的接口。调用仪器的时候需要传输图片，提供的接口里使用了IPicture这个接口，由于以前没接触过，所以查找了一些资料，整理了一下与.NET中System.Drawing.Image的互转的方式。 【文章索引】 IPicture和IPictureDisp是什么 使用AxHost实现与System.Dr...
vb.net.rar_vb.net源码
09-19
这个“vb.net.rar_vb.net源码”压缩包包含了一个简单的VB.NET留言板程序的源代码，它允许用户进行在线管理，如添加管理员、删除留言以及查看IP地址等功能。下面我们将深入探讨VB.NET编程基础、.NET Framework、留言...
VB.Net.rar_VB.NET 源码
09-19
标签 "vb.net_源码" 明确指出这是关于VB.NET的源代码，我们可以期待看到如何在VB.NET环境中组织代码，使用类、对象、函数和方法，以及如何与.NET Framework的其他组件进行交互。 从压缩包的文件名列表中，我们可以...
VB.NET网页源码爬取.zip
04-10
在"VB.NET网页源码爬取.zip"这个压缩包中，包含的是一套使用VB.NET实现的网页源码爬取示例。这套示例旨在帮助开发者解决在爬取网页源码时可能遇到的问题，并提供了四级爬取的结构，每级都会展示提取结果，以直观地...
ATL中的IPictureDisp和IPicture的互相转换以及IPicture的绘图
qq_39457138的博客
08-22 986
在ATL的项目中的控件类中的OnDraw函数中进行绘图操作，以下代码在OnDraw函数中实现： RECT&amp; rc = *(RECT*)di.prcBounds; CComPtr&lt;IPictureDisp&gt; m_picdisp = NULL;//IPictureDisp对象指针 _bstr_t m_bstrImgUrl = "C:\\桌面\\1.bmp";//bmp图片格式的...
将stdole.IPictureDisp类型的图片转换为image
ly1074106000的博客
11-26 2562
using System; using System.Collections.Generic; using System.Linq; using System.Text; using System.Drawing; using Microsoft.VisualBasic.Compatibility.VB6; namespace ReadMxdInfo {     //将st
(转载)基于ArcGIS Engine编写的ColorRamp对栅格渲染代码
weixin_30607029的博客
09-19 244
转载于：http://www.gisall.com/html/59/26859-2432.html 需要实现类似ArcMap中的单击TOC控件来对图层进行渲染，示例代码中主要针对的是矢量图层FeatureLayerClass, 没有针对RasterLayerClass, 不过原理是很类似的，我们都知道对栅格渲染主要有三种方式： 1.Raster Unique value Render...
vb.net 串口 源码
最新发布
06-06
VB.NET串口源码是用Visual Basic .NET编写的，可用于串行通信。串口通信是一种通过串口接口连接两个设备进行数据传输的通信方式。VB.NET的串口源码具有发送和接收数据的功能，其主要实现方式是使用串行通信协议传输...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值