【已测试通过】：：自定义工具按钮进行矩选查询，高亮显示所选择的地图要素
自定义工具按钮进行矩选查询，高亮显示所选择的地图要素（vb.net代码测试通过）
界面控件
SelectFeatures.vb代码：
Default.aspx.vb 代码：
界面控件
SelectFeatures.vb代码：
Imports Microsoft.VisualBasic
Imports System.Drawing
Imports System.Collections
Imports System.Collections.Generic
Imports ESRI.ArcGIS
Imports ESRI.ArcGIS.ADF.Web
Imports ESRI.ArcGIS.ADF.Web.DataSources
Imports ESRI.ArcGIS.ADF.Web.Display.Graphics
Imports ESRI.ArcGIS.ADF.Web.UI.WebControls
Imports ESRI.ArcGIS.ADF.Web.UI.WebControls.Tools
Imports System.Data
Imports System
Imports System.Web.UI.WebControls
Imports System.Web.UI
Imports System.IO.StringWriter
Public Class SelectFeatures
Implements IMapServerToolAction
#Region "IMapServerToolAction Members"
Public Sub ServerAction(ByVal args As ESRI.ArcGIS.ADF.Web.UI.WebControls.ToolEventArgs) Implements ESRI.ArcGIS.ADF.Web.UI.WebControls.Tools.IMapServerToolAction.ServerAction
Dim mapctrl As Map = Nothing
mapctrl = args.Control
'获取下拉框中的数据，在后面实现
Dim targetlayername As String = mapctrl.Page.Session("TargetLayer")
Dim rectargs As RectangleEventArgs = Nothing
rectargs = args
'获取矩形选择框的屏幕坐标
Dim myrect As System.Drawing.Rectangle = rectargs.ScreenExtent
Dim minpnt As ESRI.ArcGIS.ADF.Web.Geometry.Point = ESRI.ArcGIS.ADF.Web.Geometry.Point.ToMapPoint(myrect.Left, myrect.Bottom, mapctrl.Extent, CInt(mapctrl.Width.Value), CInt(mapctrl.Height.Value))
Dim maxpnt As ESRI.ArcGIS.ADF.Web.Geometry.Point = ESRI.ArcGIS.ADF.Web.Geometry.Point.ToMapPoint(myrect.Right, myrect.Top, mapctrl.Extent, CInt(mapctrl.Width.Value), CInt(mapctrl.Height.Value))
Dim mappoly As ESRI.ArcGIS.ADF.Web.Geometry.Envelope = Nothing
mappoly = New ESRI.ArcGIS.ADF.Web.Geometry.Envelope(minpnt, maxpnt)
Dim mapfun As IMapFunctionality = mapctrl.GetFunctionality("MapResourceWorld")
Dim gisresource As IGISResource = mapfun.Resource
Dim qfunc As IQueryFunctionality = Nothing
qfunc = gisresource.CreateFunctionality(GetType(IQueryFunctionality), Nothing)
'获取所有图层的id和name
Dim lids() As String = Nothing
Dim lnames() As String = Nothing
qfunc.GetQueryableLayers(Nothing, lids, lnames)
Dim layerindex As Integer
Dim i As Integer
For i = 0 To (lnames.Length - 1)
'找到符合要求的图层编号
If lnames(i) = targetlayername Then
layerindex = i
Exit For
End If
Next i
'设置查询过滤条件
Dim spatialfilter As New ESRI.ArcGIS.ADF.Web.SpatialFilter
spatialfilter.ReturnADFGeometries = True
spatialfilter.MaxRecords = 1000
spatialfilter.Geometry = mappoly
Dim flds() As String = qfunc.GetFields(Nothing, lids(layerindex))
Dim scoll As New ESRI.ArcGIS.ADF.StringCollection(flds)
spatialfilter.SubFields = scoll
Dim gfc As IEnumerable = mapctrl.GetFunctionalities
Dim datatable As System.Data.DataTable = Nothing
datatable = qfunc.Query(Nothing, lids(layerindex), spatialfilter)
Dim gResource As ESRI.ArcGIS.ADF.Web.DataSources.Graphics.MapResource = Nothing
Dim gfunc As IGISFunctionality
For Each gfunc In gfc
If gfunc.Resource.Name = "MapResourceSelect" Then
gResource = gfunc.Resource
End If
Next
If gResource Is Nothing Then
Return
End If
Dim glayer As ESRI.ArcGIS.ADF.Web.Display.Graphics.ElementGraphicsLayer = Nothing
Dim dtable As System.Data.DataTable
For Each dtable In gResource.Graphics.Tables
If TypeOf dtable Is ESRI.ArcGIS.ADF.Web.Display.Graphics.ElementGraphicsLayer Then
glayer = dtable
End If
Next
If glayer Is Nothing Then
glayer = New ESRI.ArcGIS.ADF.Web.Display.Graphics.ElementGraphicsLayer
gResource.Graphics.Tables.Add(glayer)
End If
glayer.Clear()
Dim drs = datatable.Rows
Dim shpind As Integer = -1
Dim j As Integer = 0
For j = 0 To (datatable.Columns.Count - 1)
If datatable.Columns(j).DataType Is GetType(ESRI.ArcGIS.ADF.Web.Geometry.Geometry) Then
shpind = j
Exit For
End If
Next j
Try
Dim dr As DataRow
For Each dr In drs
Dim geom As ESRI.ArcGIS.ADF.Web.Geometry.Geometry = CType(dr(shpind), ESRI.ArcGIS.ADF.Web.Geometry.Geometry)
Dim ge As New ESRI.ArcGIS.ADF.Web.Display.Graphics.GraphicElement(geom, System.Drawing.Color.Yellow)
ge.Symbol.Transparency = 50.0
glayer.Add(ge)
Next dr
Catch ice As InvalidCastException
End Try
'Notes: This snippet provides code to use the results of a layer query to populate a GridView control using a custom callback.
' 找到mapcontrol控件所在页面的控件"GridView1"
Dim gdview As GridView = CType(mapctrl.Page.FindControl("GridView1"), GridView)
'Is gridview div visible or hidden
Dim oa(0) As Object
Dim showtable As String = "'visible'"
'display table of selected attributes
gdview.DataSource = datatable
gdview.DataBind()
Dim returnstring As String = Nothing
Dim sw As New System.IO.StringWriter
Try
Dim htw As New HtmlTextWriter(sw)
'将服务器控件的内容输出到HtmlTextWriter对象
gdview.RenderControl(htw)
'清空当前HtmlTextWriter对象的所有缓冲区并使所有缓冲区数据写入到输出流
htw.Flush()
returnstring = sw.ToString
Finally
sw.Dispose()
End Try
' CallbackResult构造方法
'第一个参数：将要异步刷新的内容所属的Control类型
' 第二个参数：Control ID
' 第三个参数：发送的参数，包括content, innercontent, image, or javascript
' 第四个参数：发送到浏览器的内容
Dim cr As CallbackResult = New CallbackResult("div", "griddiv", "innercontent", returnstring)
'通过回调将信息从服务器端传输到客户端
mapctrl.CallbackResults.Add(cr)
If datatable.Rows.Count > 1 Then
showtable = "'visible'"
Else
showtable = "'hidden'"
End If
' set visibility of griddiv
Dim sa As String = "var griddiv = document.getElementById('griddiv');"
sa &= "griddiv.style.visibility = " + showtable
oa(0) = sa
' Invoke a custom javascript function
Dim cr1 As CallbackResult = New CallbackResult(Nothing, Nothing, "javascript", oa)
mapctrl.CallbackResults.Add(cr1)
If mapctrl.ImageBlendingMode = ImageBlendingMode.WebTier Then
mapctrl.Refresh()
Else
If mapctrl.ImageBlendingMode = ImageBlendingMode.Browser Then
mapctrl.RefreshResource(gResource.Name)
End If
End If
End Sub
#End Region
End Class
Imports System.Drawing
Imports System.Collections
Imports System.Collections.Generic
Imports ESRI.ArcGIS
Imports ESRI.ArcGIS.ADF.Web
Imports ESRI.ArcGIS.ADF.Web.DataSources
Imports ESRI.ArcGIS.ADF.Web.Display.Graphics
Imports ESRI.ArcGIS.ADF.Web.UI.WebControls
Imports ESRI.ArcGIS.ADF.Web.UI.WebControls.Tools
Imports System.Data
Imports System
Imports System.Web.UI.WebControls
Imports System.Web.UI
Imports System.IO.StringWriter
Public Class SelectFeatures
Implements IMapServerToolAction
#Region "IMapServerToolAction Members"
Public Sub ServerAction(ByVal args As ESRI.ArcGIS.ADF.Web.UI.WebControls.ToolEventArgs) Implements ESRI.ArcGIS.ADF.Web.UI.WebControls.Tools.IMapServerToolAction.ServerAction
Dim mapctrl As Map = Nothing
mapctrl = args.Control
'获取下拉框中的数据，在后面实现
Dim targetlayername As String = mapctrl.Page.Session("TargetLayer")
Dim rectargs As RectangleEventArgs = Nothing
rectargs = args
'获取矩形选择框的屏幕坐标
Dim myrect As System.Drawing.Rectangle = rectargs.ScreenExtent
Dim minpnt As ESRI.ArcGIS.ADF.Web.Geometry.Point = ESRI.ArcGIS.ADF.Web.Geometry.Point.ToMapPoint(myrect.Left, myrect.Bottom, mapctrl.Extent, CInt(mapctrl.Width.Value), CInt(mapctrl.Height.Value))
Dim maxpnt As ESRI.ArcGIS.ADF.Web.Geometry.Point = ESRI.ArcGIS.ADF.Web.Geometry.Point.ToMapPoint(myrect.Right, myrect.Top, mapctrl.Extent, CInt(mapctrl.Width.Value), CInt(mapctrl.Height.Value))
Dim mappoly As ESRI.ArcGIS.ADF.Web.Geometry.Envelope = Nothing
mappoly = New ESRI.ArcGIS.ADF.Web.Geometry.Envelope(minpnt, maxpnt)
Dim mapfun As IMapFunctionality = mapctrl.GetFunctionality("MapResourceWorld")
Dim gisresource As IGISResource = mapfun.Resource
Dim qfunc As IQueryFunctionality = Nothing
qfunc = gisresource.CreateFunctionality(GetType(IQueryFunctionality), Nothing)
'获取所有图层的id和name
Dim lids() As String = Nothing
Dim lnames() As String = Nothing
qfunc.GetQueryableLayers(Nothing, lids, lnames)
Dim layerindex As Integer
Dim i As Integer
For i = 0 To (lnames.Length - 1)
'找到符合要求的图层编号
If lnames(i) = targetlayername Then
layerindex = i
Exit For
End If
Next i
'设置查询过滤条件
Dim spatialfilter As New ESRI.ArcGIS.ADF.Web.SpatialFilter
spatialfilter.ReturnADFGeometries = True
spatialfilter.MaxRecords = 1000
spatialfilter.Geometry = mappoly
Dim flds() As String = qfunc.GetFields(Nothing, lids(layerindex))
Dim scoll As New ESRI.ArcGIS.ADF.StringCollection(flds)
spatialfilter.SubFields = scoll
Dim gfc As IEnumerable = mapctrl.GetFunctionalities
Dim datatable As System.Data.DataTable = Nothing
datatable = qfunc.Query(Nothing, lids(layerindex), spatialfilter)
Dim gResource As ESRI.ArcGIS.ADF.Web.DataSources.Graphics.MapResource = Nothing
Dim gfunc As IGISFunctionality
For Each gfunc In gfc
If gfunc.Resource.Name = "MapResourceSelect" Then
gResource = gfunc.Resource
End If
Next
If gResource Is Nothing Then
Return
End If
Dim glayer As ESRI.ArcGIS.ADF.Web.Display.Graphics.ElementGraphicsLayer = Nothing
Dim dtable As System.Data.DataTable
For Each dtable In gResource.Graphics.Tables
If TypeOf dtable Is ESRI.ArcGIS.ADF.Web.Display.Graphics.ElementGraphicsLayer Then
glayer = dtable
End If
Next
If glayer Is Nothing Then
glayer = New ESRI.ArcGIS.ADF.Web.Display.Graphics.ElementGraphicsLayer
gResource.Graphics.Tables.Add(glayer)
End If
glayer.Clear()
Dim drs = datatable.Rows
Dim shpind As Integer = -1
Dim j As Integer = 0
For j = 0 To (datatable.Columns.Count - 1)
If datatable.Columns(j).DataType Is GetType(ESRI.ArcGIS.ADF.Web.Geometry.Geometry) Then
shpind = j
Exit For
End If
Next j
Try
Dim dr As DataRow
For Each dr In drs
Dim geom As ESRI.ArcGIS.ADF.Web.Geometry.Geometry = CType(dr(shpind), ESRI.ArcGIS.ADF.Web.Geometry.Geometry)
Dim ge As New ESRI.ArcGIS.ADF.Web.Display.Graphics.GraphicElement(geom, System.Drawing.Color.Yellow)
ge.Symbol.Transparency = 50.0
glayer.Add(ge)
Next dr
Catch ice As InvalidCastException
End Try
'Notes: This snippet provides code to use the results of a layer query to populate a GridView control using a custom callback.
' 找到mapcontrol控件所在页面的控件"GridView1"
Dim gdview As GridView = CType(mapctrl.Page.FindControl("GridView1"), GridView)
'Is gridview div visible or hidden
Dim oa(0) As Object
Dim showtable As String = "'visible'"
'display table of selected attributes
gdview.DataSource = datatable
gdview.DataBind()
Dim returnstring As String = Nothing
Dim sw As New System.IO.StringWriter
Try
Dim htw As New HtmlTextWriter(sw)
'将服务器控件的内容输出到HtmlTextWriter对象
gdview.RenderControl(htw)
'清空当前HtmlTextWriter对象的所有缓冲区并使所有缓冲区数据写入到输出流
htw.Flush()
returnstring = sw.ToString
Finally
sw.Dispose()
End Try
' CallbackResult构造方法
'第一个参数：将要异步刷新的内容所属的Control类型
' 第二个参数：Control ID
' 第三个参数：发送的参数，包括content, innercontent, image, or javascript
' 第四个参数：发送到浏览器的内容
Dim cr As CallbackResult = New CallbackResult("div", "griddiv", "innercontent", returnstring)
'通过回调将信息从服务器端传输到客户端
mapctrl.CallbackResults.Add(cr)
If datatable.Rows.Count > 1 Then
showtable = "'visible'"
Else
showtable = "'hidden'"
End If
' set visibility of griddiv
Dim sa As String = "var griddiv = document.getElementById('griddiv');"
sa &= "griddiv.style.visibility = " + showtable
oa(0) = sa
' Invoke a custom javascript function
Dim cr1 As CallbackResult = New CallbackResult(Nothing, Nothing, "javascript", oa)
mapctrl.CallbackResults.Add(cr1)
If mapctrl.ImageBlendingMode = ImageBlendingMode.WebTier Then
mapctrl.Refresh()
Else
If mapctrl.ImageBlendingMode = ImageBlendingMode.Browser Then
mapctrl.RefreshResource(gResource.Name)
End If
End If
End Sub
#End Region
End Class
Default.aspx.vb 代码：
Imports System
Imports System.Data
Imports System.Collections
Imports System.Collections.Generic
Imports System.Configuration
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports ESRI.ArcGIS.ADF.Web.UI.WebControls
Partial Class _Default
Inherits System.Web.UI.Page
Implements ICallbackEventHandler
Public sADFCallBackFunctionInvocation As String
Private Returnstring As String = ""
Public Function GetCallbackResult() As String Implements System.Web.UI.ICallbackEventHandler.GetCallbackResult
Return Returnstring
End Function
Public Sub RaiseCallbackEvent(ByVal eventArgument As String) Implements System.Web.UI.ICallbackEventHandler.RaiseCallbackEvent
If eventArgument.Contains("ddl1") Then
ChangeDropDownListServer(eventArgument)
End If
End Sub
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If Not IsPostBack Then
Session("TargetLayer") = ""
End If
DropDownList1.Attributes.Add("onchange", "ChangeLayer()")
'*** Setup client callbacks
' processCallbackResult在display_dotnetadf.js中
sADFCallBackFunctionInvocation = Page.ClientScript.GetCallbackEventReference(Me, "message", "processCallbackResult", "context", "postBackError", True)
End Sub
Public Sub ChangeDropDownListServer(ByVal ea As String)
Dim parser_char() As Char = {","c}
Dim messages() As String = ea.Split(parser_char)
Dim ddl1 As String = messages(1)
Session("TargetLayer") = ddl1
End Sub
Protected Sub Page_PreRender(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.PreRender
If Not IsPostBack Then
Dim mf As ESRI.ArcGIS.ADF.Web.DataSources.IMapFunctionality = CType(Map1.GetFunctionality(1), ESRI.ArcGIS.ADF.Web.DataSources.IMapFunctionality)
Dim gisresource As ESRI.ArcGIS.ADF.Web.DataSources.IGISResource = mf.Resource
Dim supported As Boolean = gisresource.SupportsFunctionality(GetType(ESRI.ArcGIS.ADF.Web.DataSources.IQueryFunctionality))
If supported Then
Dim qfunc As ESRI.ArcGIS.ADF.Web.DataSources.IQueryFunctionality = CType(gisresource.CreateFunctionality(GetType(ESRI.ArcGIS.ADF.Web.DataSources.IQueryFunctionality), Nothing), ESRI.ArcGIS.ADF.Web.DataSources.IQueryFunctionality)
Dim lids() As Object = Nothing
Dim lnames() As String = Nothing
qfunc.GetQueryableLayers(Nothing, lids, lnames)
Dim i As Integer
For i = 0 To lnames.Length - 1 Step i + 1
DropDownList1.Items.Add(lnames(i))
Next
Session("TargetLayer") = DropDownList1.Items(0).Value
End If
End If
End Sub
End Class
Imports System.Data
Imports System.Collections
Imports System.Collections.Generic
Imports System.Configuration
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports ESRI.ArcGIS.ADF.Web.UI.WebControls
Partial Class _Default
Inherits System.Web.UI.Page
Implements ICallbackEventHandler
Public sADFCallBackFunctionInvocation As String
Private Returnstring As String = ""
Public Function GetCallbackResult() As String Implements System.Web.UI.ICallbackEventHandler.GetCallbackResult
Return Returnstring
End Function
Public Sub RaiseCallbackEvent(ByVal eventArgument As String) Implements System.Web.UI.ICallbackEventHandler.RaiseCallbackEvent
If eventArgument.Contains("ddl1") Then
ChangeDropDownListServer(eventArgument)
End If
End Sub
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If Not IsPostBack Then
Session("TargetLayer") = ""
End If
DropDownList1.Attributes.Add("onchange", "ChangeLayer()")
'*** Setup client callbacks
' processCallbackResult在display_dotnetadf.js中
sADFCallBackFunctionInvocation = Page.ClientScript.GetCallbackEventReference(Me, "message", "processCallbackResult", "context", "postBackError", True)
End Sub
Public Sub ChangeDropDownListServer(ByVal ea As String)
Dim parser_char() As Char = {","c}
Dim messages() As String = ea.Split(parser_char)
Dim ddl1 As String = messages(1)
Session("TargetLayer") = ddl1
End Sub
Protected Sub Page_PreRender(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.PreRender
If Not IsPostBack Then
Dim mf As ESRI.ArcGIS.ADF.Web.DataSources.IMapFunctionality = CType(Map1.GetFunctionality(1), ESRI.ArcGIS.ADF.Web.DataSources.IMapFunctionality)
Dim gisresource As ESRI.ArcGIS.ADF.Web.DataSources.IGISResource = mf.Resource
Dim supported As Boolean = gisresource.SupportsFunctionality(GetType(ESRI.ArcGIS.ADF.Web.DataSources.IQueryFunctionality))
If supported Then
Dim qfunc As ESRI.ArcGIS.ADF.Web.DataSources.IQueryFunctionality = CType(gisresource.CreateFunctionality(GetType(ESRI.ArcGIS.ADF.Web.DataSources.IQueryFunctionality), Nothing), ESRI.ArcGIS.ADF.Web.DataSources.IQueryFunctionality)
Dim lids() As Object = Nothing
Dim lnames() As String = Nothing
qfunc.GetQueryableLayers(Nothing, lids, lnames)
Dim i As Integer
For i = 0 To lnames.Length - 1 Step i + 1
DropDownList1.Items.Add(lnames(i))
Next
Session("TargetLayer") = DropDownList1.Items(0).Value
End If
End If
End Sub
End Class
