【已測試通過】：：自訂工具按鈕進行矩選查詢，高亮顯示所選擇的地圖要素

自訂工具按鈕進行矩選查詢，高亮顯示所選擇的地圖要素（vb.net代碼測試通過）

：

 

 

 

 

CTRL+滑鼠滾輪放大或縮小" src="http://bbs.esrichina-bj.cn/ESRI/attachments/forumid_25/20071228_d40896bce327b2d9ba8fXn7BZwbVwWg6.jpg" width="716" border="0" resized="true">

介面控制項
4.JPG (63.64 KB)2007-12-28 09:21

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

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