NorthArrows.vb
' Copyright 2012 ESRI ' ' All rights reserved under the copyright laws of the United States ' and applicable international laws, treaties, and conventions. ' ' You may freely redistribute and use this sample code, with or ' without modification, provided you include the original copyright ' notice and use restrictions. ' ' See the use restrictions. ' Imports ESRI.ArcGIS.Carto Imports ESRI.ArcGIS.Controls Imports ESRI.ArcGIS.Display Imports ESRI.ArcGIS.Geometry Imports ESRI.ArcGIS.ADF.BaseClasses Imports ESRI.ArcGIS.ADF.CATIDs Imports System.Runtime.InteropServices Public NotInheritable Class CreateNorthArrow Inherits BaseTool Private m_HookHelper As IHookHelper Private m_Feedback As INewEnvelopeFeedback Private m_Point As IPoint Private m_InUse As Boolean 'Windows API functions to capture mouse and keyboard 'input to a window when the mouse is outside the window Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Integer) As Integer Private Declare Function GetCapture Lib "user32" () As Integer Private Declare Function ReleaseCapture Lib "user32" () As Integer #Region "COM GUIDs" ' These GUIDs provide the COM identity for this class ' and its COM interfaces. If you change them, existing ' clients will no longer be able to access the class. Public Const ClassId As String = "7B8442E6-19E9-4ac5-B970-0A2130B560B3" Public Const InterfaceId As String = "8186E496-BE0C-40c3-AF96-C18736EEC826" Public Const EventsId As String = "CCB3F85E-DA13-478c-A81C-BBABC27ED41D" #End Region #Region "Component Category Registration" <ComRegisterFunction(), ComVisibleAttribute(False)> _ Public Shared Sub RegisterFunction(ByVal regKey As String) ControlsCommands.Register(regKey) End Sub <ComUnregisterFunction(), ComVisibleAttribute(False)> _ Public Shared Sub UnregisterFunction(ByVal regKey As String) ControlsCommands.Unregister(regKey) End Sub #End Region 'A creatable COM class must have a Public Sub New() with no parameters, 'otherwise, the class will not be registered in the COM registry and cannot 'be created via CreateObject. Public Sub New() MyBase.New() 'Create an IHookHelper object m_HookHelper = New HookHelperClass 'Set the tool properties MyBase.m_bitmap = New System.Drawing.Bitmap(GetType(CreateNorthArrow).Assembly.GetManifestResourceStream(GetType(CreateNorthArrow), "NorthArrow.bmp")) MyBase.m_caption = "NorthArrow" MyBase.m_category = "myCustomCommands(VBNet)" MyBase.m_message = "Add a north arrow map surround" MyBase.m_name = "myCustomCommands(VBNet)_NorthArrow" MyBase.m_toolTip = "Add a north arrow" MyBase.m_deactivate = True End Sub Public Overrides Sub OnCreate(ByVal hook As Object) m_HookHelper.Hook = hook End Sub Public Overrides Sub OnMouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer) 'Create a point in map coordinates m_Point = m_HookHelper.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y) 'Start capturing mouse events SetCapture(m_HookHelper.ActiveView.ScreenDisplay.hWnd) m_InUse = True End Sub Public Overrides Sub OnMouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer) If (Not m_InUse) Then Exit Sub 'Start an envelope feedback If (m_Feedback Is Nothing) Then m_Feedback = New NewEnvelopeFeedbackClass m_Feedback.Display = m_HookHelper.ActiveView.ScreenDisplay m_Feedback.Start(m_Point) End If 'Move the envelope feedback m_Feedback.MoveTo(m_HookHelper.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)) End Sub Public Overrides Sub OnMouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer) If (Not m_InUse) Then Exit Sub 'Stop capturing mouse events If GetCapture = m_HookHelper.ActiveView.ScreenDisplay.hWnd Then ReleaseCapture() End If 'If an envelope has not been tracked or its height/width is 0 If (m_Feedback Is Nothing) Then m_Feedback = Nothing m_InUse = False Exit Sub End If Dim envelope As IEnvelope = m_Feedback.Stop If (envelope.IsEmpty) Or (envelope.Width = 0) Or (envelope.Height = 0) Then m_Feedback = Nothing m_InUse = False Exit Sub End If 'Create the form with the SymbologyControl Dim symbolForm As New frmSymbol 'Get the IStyleGalleryItem Dim styleGalleryItem As IStyleGalleryItem styleGalleryItem = symbolForm.GetItem(esriSymbologyStyleClass.esriStyleClassNorthArrows) 'Release the form symbolForm.Dispose() If styleGalleryItem Is Nothing Then Exit Sub 'Get the map frame of the focus map Dim mapFrame As IMapFrame mapFrame = m_HookHelper.ActiveView.GraphicsContainer.FindFrame(m_HookHelper.ActiveView.FocusMap) 'Create a map surround frame Dim mapSurroundFrame As IMapSurroundFrame = New MapSurroundFrameClass 'Set its map frame and map surround mapSurroundFrame.MapFrame = mapFrame mapSurroundFrame.MapSurround = styleGalleryItem.Item 'QI to IElement and set its geometry Dim element As IElement = mapSurroundFrame element.Geometry = envelope 'Add the element to the graphics container m_HookHelper.ActiveView.GraphicsContainer.AddElement(mapSurroundFrame, 0) 'Refresh m_HookHelper.ActiveView.PartialRefresh(esriViewDrawPhase.esriViewGraphics, mapSurroundFrame, Nothing) m_Feedback = Nothing m_InUse = False End Sub End Class