gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

阅读：57319回复：116

[帝国首发]ArcGIS开发教材,0830更新,提问前请先看

楼主^#

更多发布于：2005-07-26 10:42

还没有更新完毕，请大家不要在这里回帖，谢谢！：）
如何在ArcMap的VBA环境中编程
ArcMap是ArcGIS家族的成员之一，它内置了一种集成编程环境―VBA（Visaul Basic for Apllications）。通过VBA编程，用户不但可以扩展ArcMap的菜单、工具条等，而且可以完成大多数用户的特定需求。 ArcMap中VBA编程的方法有两种,一种是写VBA宏,另一种是创建UIControl并在其事件中写入实现用户需求的代码。下面列出两种方法的一般步骤。 方法一：写VBA宏（直接在VBA编辑器中编辑函数和过程） 1、如图1，单击菜单栏中的<TOOLS>命令,选择<MACROS>的<VISUAL Basic Editor>项, 直接启动ArcMap的VBA编辑器；或者选择<MACROS>的<MACROS>项，进入如图2所示Macro对话框，在“Macro Name”文本框中输入要创建的宏的名称，并点<CREATE>按钮，启动VBA编辑器。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0101-1.jpg" border=0></DIV>
 图1 启动Macro对话框/启动VBA编辑器 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0101-2.jpg" border=0></DIV>
 图2 Macro对话框 2、在图3所示的窗口中，用户可以根据实际选择在Normal节点或者Project节点的ThisDocument、Forms、Modules中编写宏（函数或过程），Normal节点下所写的宏系统自动保存，除非用户删除，否则它将始终存在并在任何工程中都有效；而在Project节点下所写得宏随工程保存（如不保存工程，则宏也将不被保存），并中有效。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0101-3.jpg" border=0></DIV>
图3 VBA编辑器（VBE） 
 3、运行VBA宏 在VBA编辑器中写好VBA代码后，有两种方式运行：第一，点击VBA编辑器工具条中的（运行）按钮，可立即运行写好的代码；第二，退出VBA编辑器，重新启动Macro对话框，如图2，选择要运行的VBA宏名称，点击<RUN>按钮即可运行相应的VBA宏。 方法二：创建UIControl（交互式VBA编程） 1、用鼠标右击任何工具栏（条），在弹出的上托式菜单中选择<CUSTOMIZE>菜单项,如图4，进入图5所示的Customize对话框。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0101-4.jpg" border=0></DIV>
图4 启动“Customize”对话框
 2、切换到“Customize”对话框的“Commands”页，选中“UIControls”后点击<NEW UIControl>按钮，进入图6所示的“New UIControl”对话框。 3、在“New UIControl”对话框中，用户可根据需要选择UIControl类型： UIButtonControl：创建Button； UIToolControl：创建与Map交互的Tool； UIEditBoxControl：创建EditBox； UIComboBoxControl：创建ComboBox。 最后点击<CREATE>按钮只创建UIControl或者点击<CREATE and Edit>按钮创建UIControl并进入VBA编辑器。与方法一不同，此时应在UIControl的事件中进行VBA编程。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0101-5.jpg" border=0></DIV>
 图5 Customize对话框 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0101-6.jpg" border=0></DIV>
图6 New UIControl对话框
 4、UIControl创建后，在图5所示的“Customize”对话框选中UIControl并将其拖置到任意工具条上，用户便可象使用系统已有的Control一样使用所创建的UIControl。

[此贴子已经被作者于2005-8-30 15:10:07编辑过]

喜欢0 评分0

GIS麦田守望者，期待与您交流。

举报回复

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

1楼^#

发布于：2005-07-26 10:43

如何在VB环境中利用ArcObjects组件开发ActiveX DLL
 1.1.1节讨论了如何在ArcGis的VBA环境中编程，虽然通过这种方式可以完成大多数用户的定制需求，但是，在某些情况下，对于特殊的应用，用户需要脱离ArcGIS环境而在VB开发环境中开发外部独立的应用程序，这种外部独立的应用程序有两种形式： ActiveX DLL和Standard EXE。Standard EXE的开发将在1.1.4中讨论，本节将讨论ActiveX DLL的开发，其关键是引用ArcObjects对象库和实现ArcObjects接口（例如ICommand,ITool,IToolBar等）。 下面介绍在VB环境利用ArcObjects组件开发ActiveX DLL的一般步骤。 1、启动VB开发环境，在图7所示的“New Project”对话框中选择“ActiveX DLL”项,并点击<打开>按钮，进入VBE环境。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0102-1.jpg" border=0></DIV>
图7 New Project对话框
???? 2、引用ArcObjects对象库：首先点击<PROJECT>菜单中的<REFERENCES>项，如图8，进入对象库引用对话框，如图9。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0102-2.jpg" border=0></DIV>
图8 启动对象库引用对话框 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0102-3.jpg" border=0></DIV>
图9 对象库引用对话框
???? 3、对象库引用对话框（图9）中选中“Esri ArcMap Object Library ”和“Esri Object Library” 两项，并点击<OK>按钮，返回VBE环境。 4、一般在类模块中写入实现特定ArcObjects接口的代码，如图10，然后运行<FILE>菜单中的<MAKE project1.dll>项，生成DLL文件，如图11。（project1.dll随项目名改变）。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0102-4.jpg" border=0></DIV>
图10 类模块编辑窗口 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0102-5.jpg" border=0></DIV>
图11 生成DLL文件

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

2楼^#

发布于：2005-07-26 10:47

如何在ArcMap中加载利用ArcObjects组件开发的ActiveX DLL
 用户通过1.1.2中介绍的方法开发好一个ActiveX DLL程序后，便可根据实际需要，在ArcMap环境下加载这个ActiveX DLL程序。其一般步骤如下： 1、用鼠标右击任何工具栏（条），点击弹出的上托式菜单中的<CUSTOMIZE>菜单项（参见图4）。 2、在Customize对话框中，根据被加载DLL的类型切换到“Toolbars”或者“Commands”页（参见图5），然后点击<ADD From File>按钮。 3、在“打开文件”对话框中（Windows通用“打开文件”对话框，图略），选择被加载的Dll文件，并点击<打开>按钮。 4、如果加载是“Commands”,则在图5所示的对话框中显示加载的Command，并可以将其拖置于任何工具条上；如果加载是“ToolBars”,则在图12所示的对话框中显示加载的ToolBar,选中后即可在ArcMap中显示。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0103-1.jpg" border=0></DIV>

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

3楼^#

发布于：2005-07-26 10:48

如何在VB环境中利用ArcObjects控件开发EXE
 利用ArcObjects控件开发EXE的前三步类似于1.1.2中开发“Acrtive Dll”的前三步，唯一不同的是在“New Project”对话框中选择“Standard EXE”。 4、点击<PROJECT>菜单项中的<COMPONENTS>项,打开“Components”对话框，如图13。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0104-1.jpg" border=0></DIV>
图13 打开Components对话框
???? 5、在“Components”对话框中，切换到Controls页，并选中“ESRI MapControl”项，点击<应用>或<确定>按钮，如图14。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0104-2.jpg" border=0></DIV>
图14 Components对话框
???? 6、如图15所示，加载MapControl控件之后，在VBE的控件面板中出现了MapControl控件图标，用户便可以象在Form中添加Button一样在Form中添加MapControl控件，并利用它开发EXE。 
<DIV align=center><IMG src="http://www.sdgis.com/Data/Chinese/Develop/ArcGISBook/1/pic/wd0104-3.jpg" border=0></DIV>
图15 添加MapControl控件

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

4楼^#

发布于：2005-07-26 10:51

如何创建定制的按钮(Button)
本例要实现的是如何创建定制的按钮(Button)。
l 要点
用户通过在类模块中实现ICommand接口来创建定制的按钮（COM command）。ICommand接口包括 caption、 name、 category、 bitmap、 message（StatusBarr的提示信息）、 tooltip（微帮助）、 help context id 、help file、enabled以及checked等十个属性和OnCreate、　　OnClick两个事件。从Icommand接口的OnCreate事件中获取的ArcMap的Application实例必须用一个公共变量保存，以便在其它事件中(或者其它接口的事件中甚至整个工程中)使用。
·OnCreate事件的参数hook传入的是一个Object，也就是ArcMAP的Application实例，可把它赋给一个IApplication接口的变量，便获得了ArcMAP的实例。
·在OnClick事件中写入相关代码，表示按下按钮时要实现的功能.
l 程序说明
程序在类模块中实现Icommand接口来创建自己的按钮(Button)
l 代码

<TABLE height=2202 width=541 align=center border=0>

<TR>
<TD width=531 height=2198>
<CODE>Option Explicit</CODE><CODE> '实现Icommand接口 Implements ICommand Dim m_pPicture as Picture Dim m_pApplication As IApplication Private Sub Class_Initialize() '调入.RES文件中ID为101的BitMap作为该按钮的显示图片 Set m_pPicture = LoadResPicture(101, vbResBitmap) End Sub</CODE>
<CODE>Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE ICommand_Bitmap = m_pPicture End Property</CODE>
<CODE>Private Property Get ICommand_Caption() As String ICommand_Caption = "Create Button" End Property</CODE>
<CODE>Private Property Get ICommand_Category() As String ICommand_Category = " Create Button " End Property</CODE>
<CODE>Private Property Get ICommand_Checked() As Boolean End Property</CODE>
<CODE>Private Property Get ICommand_Enabled() As Boolean ICommand_Enabled = True End Property</CODE>
<CODE>Private Property Get ICommand_HelpContextID() As Long End Property</CODE>
<CODE>Private Property Get ICommand_HelpFile() As String End Property</CODE>
<CODE>Private Property Get ICommand_Message() As String End Property</CODE>
Private Property Get ICommand_Name() As String ICommand_Name = " CreateButton " End Property
Private Sub ICommand_OnClick() '加入按下按钮时实现的功能代码。在这里， '按钮按下时显示ArcMap的Document的Tittle Dim pDocument As IDocument Set pDocument = m_pApplication.Document MsgBox pDocument.Title End Sub
Private Sub ICommand_OnCreate(ByVal hook As Object) '获取ArcMap的Application实例 Set m_pApplication = hook End Sub
Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = " Create Button " End Property
Private Sub ITool_OnDblClick() '在这里加入Mouse双击时的功能代码 End Sub 
Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long) End Sub 
Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long) End Sub 
Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入Mouse单击时的功能代码 If Button = 1 Then Dim pPoint As IPoint Dim pMxApplication As IMxApplication Set pMxApplication = m_pApp Set pPoint=pMxApplication.Display.DisplayTransformation.ToMapPoint(X, Y) m_pApplication.StatusBar.Message(0) = Str(pPoint.X) ; "," ; Str(pPoint.Y) End If
End Sub
Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入Mouse移动时的功能代码 m_pApplication.StatusBar.Message(0) = "ITool_OnMouseMove" End Sub
Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入释放Mouse时的功能代码 m_pApplication.StatusBar.Message(0) = "ITool_OnMouseUp" End Sub
Private Sub ITool_Refresh(ByVal hDC As esriCore.OLE_HANDLE) End Sub</TD></TR></TABLE>

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

5楼^#

发布于：2005-07-26 10:52

本例要实现的是如何创建定制的Tool 
 要点
用户在类模块中实现Icommand（参见1.2.1）和ITool接口。ITool接口包括 mouse move, mouse button press/release, keyboard key press/release, double-click以及right click等事件、Cursor属性和Refresh方法。
Tool既具有Button的功能，又具有与ArcMAP界面交互的功能，Button的功能代码必须写在Icommand的OnClick事件中，而所有实现交互功能的代码必须写在Itool接口的各个事件中。Itool接口的各个事件,用户可以在其中写入相关代码，表示用户与ArcMAP界面交互时一旦触发某事件要实现的功能。
l 程序说明
 程序在类模块中实现Icommand和Itool接口来创建自己的Tool.
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD width=531>
Option Explicit '实现Icommand和Itool接口 Implements ICommand Implements ITool Dim m_pApplication As IApplication Dim m_pBitmap As IPictureDisp Dim m_pCursor As IpictureDisp 
Private Sub Class_Initialize() Set m_pBitmap = LoadResPicture(101, 0) '从.RES文件中调入ID为102的图片作为按下Tool后的MouseCursor Set m_pCursor = LoadResPicture(102, 2) End Sub 
Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE ICommand_Bitmap = m_pBitmap End Property
Private Property Get ICommand_Caption() As String ICommand_Caption = "MyTool" End Property 
Private Property Get ICommand_Category() As String ICommand_Category = "MyCustomTools" End Property
Private Property Get ICommand_Checked() As Boolean End Property
Private Property Get ICommand_Enabled() As Boolean ICommand_Enabled = True End Property
Private Property Get ICommand_HelpContextID() As Long End Property 
Private Property Get ICommand_HelpFile() As String End Property 
Private Property Get ICommand_Message() As String ICommand_Message = "This is my custom tool" End Property
Private Property Get ICommand_Name() As String ICommand_Name = "MyCustomTool_MyTool" End Property
Private Sub ICommand_OnClick() '加入按下按钮时实现的功能代码 MsgBox "Clicked on my command" End Sub
Private Sub ICommand_OnCreate(ByVal hook As Object) '获取ArcMAP的Application实例 Set m_pApplication = hook End Sub
Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = "MyTool" End Property 
Private Property Get ITool_Cursor() As esriCore.OLE_HANDLE ITool_Cursor = m_pCursor End Property
Private Function ITool_Deactivate() As Boolean '如果ITool_Deactivate设为False，则Tool不可用 ITool_Deactivate = True End Function
Private Function ITool_OnContextMenu(ByVal X As Long, ByVal Y As Long) As Boolean '在这里可以加入用户代码，点击Mouse右键时显示一个定制的context menu End Function 
Private Sub ITool_OnDblClick() '在这里加入Mouse双击时的功能代码 End Sub 
Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long) End Sub 
Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long) End Sub 
Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入Mouse单击时的功能代码 If Button = 1 Then Dim pPoint As IPoint Dim pMxApplication As IMxApplication Set pMxApplication = m_pApp Set pPoint=pMxApplication.Display.DisplayTransformation.ToMapPoint(X, Y) m_pApplication.StatusBar.Message(0) = Str(pPoint.X) ; "," ; Str(pPoint.Y) End If
End Sub
Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入Mouse移动时的功能代码 m_pApplication.StatusBar.Message(0) = "ITool_OnMouseMove" End Sub
Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入释放Mouse时的功能代码 m_pApplication.StatusBar.Message(0) = "ITool_OnMouseUp" End Sub
Private Sub ITool_Refresh(ByVal hDC As esriCore.OLE_HANDLE) End Sub
Private Property Get ICommand_Name() As String ICommand_Name = "MyCustomTool_MyTool" End Property
Private Sub ICommand_OnClick() '加入按下按钮时实现的功能代码 MsgBox "Clicked on my command" End Sub
Private Sub ICommand_OnCreate(ByVal hook As Object) '获取ArcMAP的Application实例 Set m_pApplication = hook End Sub
Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = "MyTool" End Property 
Private Property Get ITool_Cursor() As esriCore.OLE_HANDLE ITool_Cursor = m_pCursor End Property
Private Function ITool_Deactivate() As Boolean '如果ITool_Deactivate设为False，则Tool不可用 ITool_Deactivate = True End Function
Private Function ITool_OnContextMenu(ByVal X As Long, ByVal Y As Long) As Boolean '在这里可以加入用户代码，点击Mouse右键时显示一个定制的context menu End Function 
Private Sub ITool_OnDblClick() '在这里加入Mouse双击时的功能代码 End Sub 
Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long) End Sub 
Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long) End Sub 
Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入Mouse单击时的功能代码 If Button = 1 Then Dim pPoint As IPoint Dim pMxApplication As IMxApplication Set pMxApplication = m_pApp Set pPoint=pMxApplication.Display.DisplayTransformation.ToMapPoint(X, Y) m_pApplication.StatusBar.Message(0) = Str(pPoint.X) ; "," ; Str(pPoint.Y) End If
End Sub
Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入Mouse移动时的功能代码 m_pApplication.StatusBar.Message(0) = "ITool_OnMouseMove" End Sub
Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, _ ByVal X As Long, ByVal Y As Long) '加入释放Mouse时的功能代码 m_pApplication.StatusBar.Message(0) = "ITool_OnMouseUp" End Sub
Private Sub ITool_Refresh(ByVal hDC As esriCore.OLE_HANDLE) End Sub</TD></TR></TABLE>

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

6楼^#

发布于：2005-07-26 10:53

如何创建定制的工具条(Tool Bar)
本例要实现的是如何创建定制的工具条(Tool Bar)。就必须在类模块中实现IToolBarDef接口。IToolBarDef接口包括 Caption、ItemCount及Name三个属性和GetItemInfo方法。
l 要点
通过在类模块中实现IToolBarDef接口。IToolBarDef接口包括 Caption、ItemCount及Name三个属性和GetItemInfo方法。
·ItemCount属性表示ToolBar显示的条目(Button、Tool或其它控件)数。 
· GetItemInfo方法定义工具条上各条目的CLSID，其中，参数pos表示条目在ToolBar中的位置，itemDef 是定义相应位置的条目的IItemDef 对象。
·工具条条目的CLSID分为两种：
1、系统CLSID，代表ArcGIS的一个功能，其引用方式为"esriCore.命令名称"，如"esriCore.AddDataCommand"、"esriCore.FileSaveCommand"等。
2、用户定制CLSID，表示用户自己定义的功能。其引用方式为"工程名称.定制功能类名称"，如" ToolBarDef.ClsBar "。必须注意，这里“定制功能类名称”是工程中实现的一个功能类名称，“工程名称”即为当前工程的名称（不是DLL文件名，也不是工具条的名称），每次新建一个工程时，系统默认的工程名在某些情况下无法使用（在中文版的VB中是一个乱字符），必须改名后方能用。
l 程序说明
程序在类模块中实现IToolBarDef接口来创建自己的工具条(ToolBar)。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD align=left width=531>
Option Explicit Implements IToolBarDef 
Private Property Get IToolBarDef_Caption() As String IToolBarDef_Caption = "CustomToolBar" End Property
Private Sub IToolBarDef_GetItemInfo(ByVal pos As Long, ByVal itemDef As_ esriCore.IItemDef) '这里假设在当前工程(工程名称为ToolBarDef)中定义了一个类模块(名为ClsBar)， '它实现了Icommand接口(可参照1.2.1) Select Case pos Case 0 '用户自定义条目 itemDef.ID = "ToolBarDef.ClsBar" itemDef.Group = False Case 1 '系统条目 itemDef.ID = "esriCore.AddDataCommand" itemDef.Group = False End Select End Sub 
Private Property Get IToolBarDef_ItemCount() As Long IToolBarDef_ItemCount = 2
End Property 
Private Property Get IToolBarDef_Name() As String IToolBarDef_Name = "CustomToolBar"
End Property</TD></TR></TABLE>

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

7楼^#

发布于：2005-07-26 10:53

本例要实现的是如何创建定制的MultiItem。
l 要点
需要实现IMultiItem接口，但不需要同时实现Icommand接口。IMultiItem接口包括Caption,itemCaption,ItemBitmap,ItemEnabled,ItemChecked, Message及Name等属性和OnItemClick, OnPopup事件。
·itemCaption,ItemBitmap,ItemEnabled,ItemChecked等属性的参数index表示当前Item的下标索引。
 ·OnPopup事件的参数hook同Icommand接口的OnCreate事件的参数hook一样，传入ArcGIS的Application实例，同时，该事件返回将要显示的Item数目。
·OnItemClick事件的参数Index表示用户当前点击的Item的索引，用户根据该索引分别定义点击各个Item时实现的功能。
l 程序说明
程序在类模块中实现IMultiItem接口来创建定制自己的MultiItem。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD width=531>
Option Explicit
Implements IMultiItem
Private m_pApp As IApplication 'ArcMap的Document
Private m_pMxDoc As IMxDocument '当前Focus Map
Private m_pMap As IMap 'Map中的层数
Private m_pLayerCnt As Long 
Private Property Get IMultiItem_Caption() As String IMultiItem_Caption = "ZoomToLayers"
End Property
Private Property Get IMultiItem_HelpContextID() As Long
End Property 
Private Property Get IMultiItem_HelpFile() As String
End Property
Private Property Get IMultiItem_ItemBitmap(ByVal Index As Long) As esriCore.OLE_HANDLE
End Property
Private Property Get IMultiItem_ItemCaption(ByVal Index As Long) As String Dim i As Integer ' 遍历每一个层 For i = 0 To m_pLayerCnt - 1 ' 如果层号与当前Item的Index相同，就设置该Item的Caption If Index = i Then IMultiItem_ItemCaption = "Zoom to " ; m_pMap.Layer(i).Name End If Next End Property
Private Property Get IMultiItem_ItemChecked(ByVal Index As Long) As Boolean End Property 　 
Private Property Get IMultiItem_ItemEnabled(ByVal Index As Long) As Boolean Dim i As Integer ' 遍历每一个层 For i = 0 To m_pLayerCnt - 1 '如果层号与当前Item的Index相同,则当前Item的Enable根据该层的Visible设置。 If Index = i Then If m_pMap.Layer(i).Visible Then IMultiItem_ItemEnabled = True End If End If Next End Property
Private Property Get IMultiItem_Message() As String IMultiItem_Message = "Zooms to the layer." End Property
Private Property Get IMultiItem_Name() As String IMultiItem_Name = "ZoomMulti" End Property 
Private Sub IMultiItem_OnItemClick(ByVal Index As Long) Dim i As Integer Dim pEnv As IEnvelope Dim m_BookMark As IAOIBookmark ' 遍历每一个层 For i = 0 To m_pLayerCnt – 1 '如果层号与当前Item的Index相同,则以该层的AreaOfInterest 为范围执行Zoom If Index = i Then Set pEnv = m_pMap.Layer(i).AreaOfInterest Set m_BookMark = New AOIBookmark Set m_BookMark.Location = pEnv m_BookMark.ZoomTo m_pMap m_pMxDoc.ActiveView.Refresh End If Next End Sub 
Private Function IMultiItem_OnPopup(ByVal hook As Object) As Long Set m_pApp = hook ' 获取Map中的层数 Set m_pMxDoc = m_pApp.Document Set m_pMap = m_pMxDoc.FocusMap m_pLayerCnt = m_pMap.LayerCount ' 显示的Item数等于层数 IMultiItem_OnPopup = m_pLayerCnt End Function </TD></TR></TABLE>

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

8楼^#

发布于：2005-07-26 10:54

本例要实现的是如何创建定制的菜单(Menu)
l 要点
用户通过在类模块中实现IMenuDef接口来创建定制的菜单(Menu),如果要使菜单出现在Customize Dialog的Menus类型中，必须同时实现IrootLevelMenu接口，它表明菜单为root menu。IMenuDef接口包括 Caption、ItemCount及Name三个属性和GetItemInfo方法。类似IToolBarDef(参照1.2.3)
l 程序说明
程序在类模块中实现IMenuDef接口来创建定制的菜单(Menu)。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD width=531>
Option Explicit 
 'Implement the IMenuDef interface and IRootLevelMenu interface Implements IMenuDef Implements IRootLevelMenu 
 Private Property Get IMenuDef_Caption() As String ' Set the string that appears as the menu's title IMenuDef_Caption = "MyMenu" End Property 
 Private Sub IMenuDef_GetItemInfo(ByVal pos As Long, _ ByVal itemDef As esriCore.IItemDef) ' Define the commands that will be on the menu. The built-in ArcMap ' Full Extent command, and Fixed Zoom In command are added to this custom menu. ' ID is the ClassID of the command. Group determines whether the command ' begins a new group on the menu Select Case pos Case 0 itemDef.ID = "promenu.clsmultitem" itemDef.Group = False Case 1 itemDef.ID = "esriCore.FullExtentCommand" itemDef.Group = True Case 2 itemDef.ID = "esriCore.ZoomInFixedCommand" itemDef.Group = False End Select End Sub 
 Private Property Get IMenuDef_ItemCount() As Long ' Set how many commands will be on the menu IMenuDef_ItemCount = 3 End Property 
 Private Property Get IMenuDef_Name() As String ' Set the internal name of the menu. IMenuDef_Name = "MyMenu" End Property</TD></TR></TABLE>

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15951
QQ
铜币25345枚
威望15368点
贡献值0点
银元0个

加关注写私信

9楼^#

发布于：2005-07-26 10:55

如何创建定制的ToolControl
本例要实现的是如何创建定制的ToolControl。ToolControl是指具有ComboBox的下拉列表或 EditBox的编辑功能的一类控件。要创建定制的ToolControl，必须在类模块中实现ICommand 和 IToolControl接口。IToolControl接口包括hWnd属性和OnDrop, OnFocus事件。
l 要点
·IToolControl接口的hWnd属性，接受一个Window Handle。
·IToolControl接口的OnDrop事件，支持ToolControl的拖放，传入参数barType表示Bar类型。
·IToolControl接口的OnFocus事件，传入IcompletionNotify类型的参数complete，可以通过执行IcompletionNotify接口的SetComplete方法告之ArcMAP，ToolControl可以失去Focus。
l 程序说明
本例中涉及三个模块，详细描述如下,其中，在类模块中实现了IToolBarDef接口来创建自己的ToolControl。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD width=531>
'1、frmImageCombo.frm模块，定义选中Combox某一项之后实现的功能。要求在Form上放置一个 'ImageComb控件（名为ImageCombo1）和一个ImageList控件（名为ImageList1），并在ImageList1 '中添加三张图片。
Private Sub Form_Load() ' 设置ImageCombo1的选择Item Me.ImageCombo1.ImageList = Me.ImageList1 Me.ImageCombo1.ComboItems.Add 1, "Red", "Red" Me.ImageCombo1.ComboItems.Add 2, "Blue", "Blue" Me.ImageCombo1.ComboItems.Add 3, "Green", "Green" Me.ImageCombo1.ComboItems(1).Image = 1 Me.ImageCombo1.ComboItems(2).Image = 2 Me.ImageCombo1.ComboItems(3).Image = 3 End Sub 
Private Sub ImageCombo1_Click() ' 选择颜色 Dim sel As Variant sel = Me.ImageCombo1.SelectedItem Dim color As Variant Select Case sel Case "Blue" color = vbBlue Case "Red" color = vbRed Case "Green" color = vbGreen End Select Dim pDocument As IMxDocument Set pDocument = g_pApplication.Document ' 设置颜色 Dim pRgbColor As IrgbColor Set pRgbColor = New RgbColor pRgbColor.RGB = color ' 改变选中部分的颜色 Dim pSelectionEnvironment As ISelectionEnvironment Set pSelectionEnvironment = New SelectionEnvironment Set pSelectionEnvironment.DefaultColor = pRgbColor ' 刷新视图 pDocument.ActivatedView.Refresh ' 通知ArcMap,ToolControl现在可以失去Focus g_pCompletionNotify.SetComplete End Sub 
' 2、modPublicVars.bas模块，定义工程中用到的全局变量。 Option Explicit Public g_pApplication As IApplication Public g_pCompletionNotify As IcompletionNotify
' 3、CustImageCombo.cls模块，实现接口Icommand和IToolControl。 Option Explicit Implements ICommand Implements IToolControl 
Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE End Property 
Private Property Get ICommand_Caption() As String ICommand_Caption = "Custom ImageCombo" End Property 
Private Property Get ICommand_Category() As String ICommand_Category = "Developer Samples" End Property 
Private Property Get ICommand_Checked() As Boolean End Property 
Private Property Get ICommand_Enabled() As Boolean ICommand_Enabled = True End Property 
Private Property Get ICommand_HelpContextID() As Long End Property 
Private Property Get ICommand_HelpFile() As String End Property 
Private Property Get ICommand_Message() As String ICommand_Message = "Change feature selection color" End Property 
Private Property Get ICommand_Name() As String ICommand_Name = "DevelperSamples_CustomImageCombo" End Property 
Private Sub ICommand_OnClick() End Sub 
Private Sub ICommand_OnCreate(ByVal hook As Object) Set g_pApp = hook End Sub 
Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = "Change Selection Color" End Property 
Private Property Get IToolControl_hWnd() As esriCore.OLE_HANDLE '将frmImageCombo.ImageCombo1的Window Handle赋给IToolControl_hWnd IToolControl_hWnd = frmImageCombo.ImageCombo1.hWnd End Property 
Private Function IToolControl_OnDrop(ByVal barType As esriCore.esriCmdBarType) As Boolean '仅能将ToolControl拖放到ToolBar上 If barType = esriCmdBarTypeToolbar Then IToolControl_OnDrop = True End If
End Function 
Private Sub IToolControl_OnFocus(ByVal complete As esriCore.ICompletionNotify) Set g_pCompletionNotify = complete End Sub</TD></TR></TABLE>

GIS麦田守望者，期待与您交流。

举报回复喜欢评分

您需要登录后才可以回帖，登录或者注册

[帝国首发]ArcGIS开发教材,0830更新,提问前请先看

最新喜欢：