使用VB.net和VB编写DLL组件的方法

使用ESRI 的AO进行开发的时候，最常用的开发手段之一就是写DLL组件，使用VB或者VB.NET编写DLL组件的方法是不一样的。写DLL的时候，就是继承某个接口，而接口里面的方法和属性必须完全实现，不能够有任何的遗漏。以下便是VB和VB.NET开发AO的方法：

1.使用VB写DLL
使用一个Icommand或者Itool来写DLL组件，例子如下：
1.1在VB中开始一个ACTIVE DLL组件项目
1.2使用 工程－－引用，引用ESRI Core objects
1.3代码如下：

Option Explicit
' 实现ICommand interface
Implements ICommand

Dim m_pApp As IApplication      'ArcMap application

Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE
  ' The VB project contains a form called Form1.
  ' Picture1 is the name of a PictureBox control on the form.
  ' The Picture property of PictureBox1 is set to some bitmap on
  ' your system.
  ICommand_Bitmap = Form1.Picture1.Picture.Handle
End Property

Private Property Get ICommand_Caption() As String
  ' Set the string that appears when the command is used as a
  ' menu item.
  ICommand_Caption = "MyCommand"
End Property

Private Property Get ICommand_Category() As String
  ' Set the category of this command. This determines where the
  ' command appears in the Commands panel of the Customize dialog.
  ICommand_Category = "MyCustomTools"
End Property

Private Property Get ICommand_Checked() As Boolean

End Property

Private Property Get ICommand_Enabled() As Boolean
  ' Add some logic here to specify in what state the application
  ' should be in for the command to be enabled. In this example,
  ' the command is enabled only when there is at least one data
  ' layer loaded in ArcMap.
  Dim pMxDoc As IMxDocument
  Dim pLayerCount As Integer
  'm_pApp is set in OnCreate
  Set pMxDoc =  m_pApp.Document
  pLayerCount =  pMxDoc.FocusMap.LayerCount
  If pLayerCount > 0 Then
    ICommand_Enabled =  True
  Else
    ICommand_Enabled =  False
  End  If
End Property

Private Property Get ICommand_HelpContextID() As Long
  ICommand_HelpContextID =  1234
End Property

Private Property Get ICommand_HelpFile() As String
  ' If the help file is not registered you may need
  ' to  supply the  full path to the file
  ICommand_HelpFile = "MyHelp.hlp"
End Property

Private Property Get ICommand_Message() As String
  'Set the message string that appears in the statusbar of the
  'application when the mouse passes over the command.
  ICommand_Message = "This is my custom command"
End Property

Private Property Get ICommand_Name() As String
  ' Set the internal name of this command. By convention, this
  ' name string contains the category and caption of the command.
  ICommand_Name = "MyCustomTool_MyCommand"
End Property

Private Sub ICommand_OnClick()
  ' Add some code to do some action when the command is clicked. In this
  ' example, a message box is displayed.
  MsgBox "Clicked on my command"
End Sub

Private Sub ICommand_OnCreate(ByVal hook As Object)
  ' The hook argument is a pointer to Application object.
  ' Establish a hook to the application
  Set m_pApp = hook
End Sub

Private Property Get ICommand_Tooltip() As String
  'Set the string that appears in the screen tip.
  ICommand_Tooltip = "MyCommand"
End Property
1.4 编译为DLL组件，在项目－－属性中修改项目名和设置二进制级兼容性。

2.使用VB.NET编写DLL组件
2.1 生产项目，文件－－新建－－项目－－VB类库
2.2 添加引用，AO在.NET项目中已经有了自己专门类，不用使用COM组件，所以引入.NET中专门的命名空间即可
2.3.添加新项－－COM类
2.4 添加代码
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.Drawing
Imports ESRI.ArcObjects.Core
Imports ESRI.ArcObjects.Samples.CATIDs
'引用命名空间
<ComClass(ToolUsingImplementsVBNET.ClassId, ToolUsingImplementsVBNET.InterfaceId, ToolUsingImplementsVBNET.EventsId)> _
Public Class ToolUsingImplementsVBNET
  Implements ICommand
  Implements ITool

#Region "COM GUIDs"
  Public Const ClassId As String = "8F1F6654-7FB8-491B-B50A-96EC444E5B53"
  Public Const InterfaceId As String = "E1FB3337-2BBC-42FE-B040-0EA9D42A03ED"
  Public Const EventsId As String = "E35B29D4-4FD8-4768-A4AD-4B489C202C22"
#End Region

#Region "Register Unregister Component"
  <ComRegisterFunction(), ComVisible(False)> _
  Public Shared Sub OnRegister(ByVal regKey As String)
    MxCommand.Register(regKey)
  End Sub

  <ComUnregisterFunction(), ComVisible(False)> _
  Public Shared Sub OnUnRegister(ByVal regKey As String)
    MxCommand.Unregister(regKey)
  End Sub
#End Region

  Private m_app As IApplication
  Private m_bitmap As Bitmap
  Private m_hBitmap As IntPtr
  Private m_cursor As System.Windows.Forms.Cursor

  ' Needed to clear up the Hbitmap unmanaged resource
  <DllImport("gdi32.dll")> _
Private Shared Function DeleteObject(ByVal hObject As IntPtr) As Boolean
  End Function

  Public Sub New()
    MyBase.New()
    m_cursor = New System.Windows.Forms.Cursor(Me.GetType.Assembly.GetManifestResourceStream("ESRISamples.Cursor2.cur"))

    m_bitmap = New System.Drawing.Bitmap((Me.GetType.Assembly.GetManifestResourceStream("ESRISamples.happy2.bmp")))
    If Not (m_bitmap Is Nothing) Then
      m_bitmap.MakeTransparent(m_bitmap.GetPixel(1, 1))
      m_hBitmap = m_bitmap.GetHbitmap()
    End If
    ' The GetHbitmap method creates an unmanaged Windows GDI bitmap object.
    ' You have to delete this object manually because the .NET runtime garbage
    ' collector doesn't clear it up. See below.
  End Sub

  Protected Overrides Sub Finalize()
    ' Must de-allocate hBitmap with Windows.DeleteObject
    If (m_hBitmap.ToInt32() <> 0) Then
      DeleteObject(m_hBitmap)
    End If
  End Sub

  Public Sub OnClick() Implements ESRI.ArcObjects.Core.ICommand.OnClick
    ' Add some code to do some action when the command is clicked. In this
    ' example, a message box is displayed.
    MessageBox.Show("Clicked on my command.")
  End Sub

  Public Sub OnCreate(ByVal hook As Object) Implements ESRI.ArcObjects.Core.ICommand.OnCreate
    If TypeOf hook Is IMxApplication Then
      m_app = hook
    End If
  End Sub

  Public ReadOnly Property Bitmap() As Integer Implements ESRI.ArcObjects.Core.ICommand.Bitmap
    Get
      If (m_hBitmap.ToInt32() <> 0) Then
        Bitmap = m_hBitmap.ToInt32()
      End If
    End Get
  End Property

  Public ReadOnly Property Caption() As String Implements ESRI.ArcObjects.Core.ICommand.Caption
    Get
      Caption = "Tool using implements VB.NET"
    End Get
  End Property


  Public ReadOnly Property Category() As String Implements ESRI.ArcObjects.Core.ICommand.Category
    Get
      Category = "Developer Samples"
    End Get
  End Property

  Public ReadOnly Property Checked() As Boolean Implements ESRI.ArcObjects.Core.ICommand.Checked
    Get
      Checked = False
    End Get
  End Property

  Public ReadOnly Property Enabled() As Boolean Implements ESRI.ArcObjects.Core.ICommand.Enabled
    Get
      ' Add some logic here to specify in what state the application
      ' should be in for the command to be enabled. In this example,
      ' the command is enabled only when there is at least one data
      ' layer loaded in ArcMap.
      Dim mxDoc As IMxDocument
      Dim layerCount As Integer

      mxDoc = m_app.Document
      layerCount = mxDoc.FocusMap.LayerCount
      If layerCount > 0 Then
        Enabled = True
      Else
        Enabled = False
      End If
    End Get
  End Property

  Public ReadOnly Property HelpContextID() As Integer Implements ESRI.ArcObjects.Core.ICommand.HelpContextID
    Get

    End Get
  End Property

  Public ReadOnly Property HelpFile() As String Implements ESRI.ArcObjects.Core.ICommand.HelpFile
    Get

    End Get
  End Property

  Public ReadOnly Property Message() As String Implements ESRI.ArcObjects.Core.ICommand.Message
    Get
      Message = "Sample Tool using Implements VB.NET"
    End Get
  End Property

  Public ReadOnly Property Name() As String Implements ESRI.ArcObjects.Core.ICommand.Name
    Get
      Name = "DeveloperSamples_ToolUsingImplementsVBNET"
    End Get
  End Property

  Public ReadOnly Property Tooltip() As String Implements ESRI.ArcObjects.Core.ICommand.Tooltip
    Get
      Tooltip = "Tool using implements VB.NET"
    End Get
  End Property

  Public ReadOnly Property Cursor() As Integer Implements ESRI.ArcObjects.Core.ITool.Cursor
    Get
      If (Not m_cursor Is Nothing) Then
        Cursor = m_cursor.Handle.ToInt32
      End If
    End Get
  End Property

  Public Function Deactivate() As Boolean Implements ESRI.ArcObjects.Core.ITool.Deactivate
    Deactivate = True
  End Function

  Public Function OnContextMenu(ByVal X As Integer, ByVal Y As Integer) As Boolean Implements ESRI.ArcObjects.Core.ITool.OnContextMenu

  End Function

  Public Sub OnDblClick() Implements ESRI.ArcObjects.Core.ITool.OnDblClick

  End Sub

  Public Sub OnKeyDown(ByVal keyCode As Integer, ByVal Shift As Integer) Implements ESRI.ArcObjects.Core.ITool.OnKeyDown
    ' Add some code to do some action when a keyboard button is pressed.
    ' This example reports the pressed key in the statusbar message.
    m_app.StatusBar.Message(0) = "Key: " & Chr(keyCode)
  End Sub

  Public Sub OnKeyUp(ByVal keyCode As Integer, ByVal Shift As Integer) Implements ESRI.ArcObjects.Core.ITool.OnKeyUp

  End Sub

  Public Sub OnMouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer) Implements ESRI.ArcObjects.Core.ITool.OnMouseDown
    If (Button = 1) Then
      ' Convert x and y to map units.
      Dim point As IPoint
      Dim mxApp As IMxApplication
      mxApp = m_app
      point = mxApp.Display.DisplayTransformation.ToMapPoint(X, Y)

      ' Set the statusbar message.
      m_app.StatusBar.Message(0) = point.X & "," & point.Y
    End If
  End Sub

  Public Sub OnMouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer) Implements ESRI.ArcObjects.Core.ITool.OnMouseMove
    ' Add some code to do some action when the mouse is moved.
    ' This example changes the statusbar message.
    m_app.StatusBar.Message(0) = "ITool_OnMouseMove"
  End Sub

  Public Sub OnMouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer) Implements ESRI.ArcObjects.Core.ITool.OnMouseUp
    ' Add some code to do some action when the mouse is released.
    ' This example changes the statusbar message.
    m_app.StatusBar.Message(0) = "ITool_OnMouseUp"
  End Sub

  Public Sub Refresh(ByVal hDC As Integer) Implements ESRI.ArcObjects.Core.ITool.Refresh

  End Sub
End Class