自己定制的SymbolSelectForm效果及VB.NET源码
2008-08-07 09:41
218 查看
自己定制的SymbolSelectForm效果及VB.NET源码
声明:本帖请勿随意转载,如有需要请联系gispeng@vip.qq.com!谢谢!
先看一下效果图:
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
[/b]
声明:本帖请勿随意转载,如有需要请联系gispeng@vip.qq.com!谢谢!
先看一下效果图:
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
[/b]
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- SwipeToLoadLayout--小白也能轻松定制自己的刷新效果
- 定制自己的flex淡入淡出效果组件
- SwipeToLoadLayout--小白也能轻松定制自己的刷新效果
- 使用HTML+css实现京东图片自动轮播效果(自己写的)
- DotNet中定制自己的表格
- Photoshop(PS)把自己的手写签名制成作品水印效果教程
- android#定制自己的日志工具
- 使用DWR实现自己主动补全 相似百度搜索框的自己主动显示效果
- android中通过shape定制图形效果
- 如何自己定制事件的API
- 自己定制打开文件对话框
- Android Volley完全解析(三)，定制自己的Request
- 【SpringBoot系列4】SpringBoot定制自己的bean
- 部分定制自己的linux系统
- 给自己的网站加点情趣，常用的javaScript效果
- 自己动手定制一个高效阅读源代码的vim
- 自己写的触壁反弹效果！！js
- 移植并定制自己的Android
- 定制以及彩色化自己的 Mac OS X 终端（2015.11.2更新）
- 人脸表情识别——定制自己的数据加载方式