ESRI ArcGIS应用与开发 [帝国首发]ArcGIS开发教材,0830更新,提问前请先看||做专业的GIS技术交流论坛

gis

管理员

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

100楼^#

发布于：2005-07-26 11:01

如何在ArcMap中加入Text和dBASE文件
l 要点
首先为Text文件或dBASE文件创建一个与之对应的ITable接口对象，然后通过IMap实例获得IStandaloneTable接口对象和IStandaloneTableCollection接口对象，并设置其属性，最后使用IStandaloneTableCollection.AddStandaloneTable方法将Text文件或dBASE文件加入到当前的ArcMap中。加入Text文件或dBASE文件的区别仅在于创建ITable对象时IWorkspaceFactory的类型不同，加入Text文件时是TextFileWorkspaceFactory类型，加入dBASE文件时是ShapefileWorkspaceFactory类型。
主要用到了IWorkspaceFactory接口，IWorkspace接口，IFeatureWorkspace接口，ITable接口，IStandaloneTable接口和IStandaloneTableCollection接口。
 l 程序说明
函数AddTextFile通过文件路径sFilePath和文件名sFileName找到Text文件并为其创建ITable对象
函数AddDBASEFile通过文件路径sFilePath和文件名sFileName找到dBASE文件并为其创建ITable对象
函数Add_Table_TOC将ITable对象pTable加入到当前的ArcMap中。
 l 代码

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

<TR>
<TD vAlign=top width=535 height=75>
Private Sub AddTextFile(ByVal sFilePath As String, ByVal sFileName As String)
 Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace Dim pFeatureWorkspace As IFeatureWorkspace Dim pTable As ITable Dim sDir As String 
On Error GoTo ErrorHandler:
 sDir = Dir(sFilePath ; sFileName ; ".txt") If (sDir = "") Then MsgBox (sFileName ; ".txt" ; " 文件不存在") Exit Sub End If
 'Get the ITable from the geodatabase Set pWorkspaceFactory = New TextFileWorkspaceFactory Set pWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0) Set pFeatureWorkspace = pWorkspace Set pTable = pFeatureWorkspace.OpenTable(sFileName ; ".txt")
 'Add the table Add_Table_TOC pTable
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub AddDBASEFile(ByVal sFilePath As String, ByVal sFileName As String)
 Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace Dim pFeatureWorkspace As IFeatureWorkspace Dim pTable As ITable
On Error GoTo ErrorHandler:
 'Get the ITable from the geodatabase Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0) Set pFeatureWorkspace = pWorkspace Set pTable = pFeatureWorkspace.OpenTable(sFileName)
 'Add the table Add_Table_TOC pTable
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub Add_Table_TOC(pTable As ITable)
 Dim pDoc As IMxDocument Dim pMap As IMap Dim pStandaloneTable As IStandaloneTable Dim pStandaloneTableC As IStandaloneTableCollection
On Error GoTo ErrorHandler:
 Set pDoc = ThisDocument Set pMap = pDoc.FocusMap
 'Create a new standalone table and add it 'to the collection of the focus map Set pStandaloneTable = New StandaloneTable Set pStandaloneTable.Table = pTable Set pStandaloneTableC = pMap pStandaloneTableC.AddStandaloneTable pStandaloneTable
 'Refresh the TOC pDoc.UpdateContents
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject
 'Add text file to ArcMap. Dont include .txt extension AddTextFile pVBProject.FileName ; "\..\..\..\.." ; "\data\", "Continents"
 'Add dBASE file to ArcMap AddDBASEFile pVBProject.FileName ; "\..\..\..\.." ; "\data\", "Continents"
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub</TD></TR></TABLE>

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

举报回复喜欢评分

gis

管理员

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

加关注写私信

101楼^#

发布于：2005-07-26 11:00

如何加载Shape文件
 本例实现的是在ArcMap中连接指定的Shape文件，并将其加载到当前激活的Map中。 
 l 要点
通过FeatureLayer类实现IFeatureLayer接口对象，设置IFeatureLayer.FeatureClass属性和Name属性，使用IMap.AddLayer方法将新层添加到当前地图。利用IWorkspaceFacktory接口、IFeatureWorkspace接口和IFeatureLayer接口实现连接Shape文件
 l 程序说明
函数OpenShapeFile根据输入的Shape文件路径sFilePath，将文件名为sFileName的Shape文件连接到当前激活的Map中去。
 l 代码
<TABLE height=43 width=541 align=center border=0>

<TR>
<TD vAlign=top width=535 height=75>
Private Sub OpenShapeFile(ByVal sFilePath As String, ByVal sFileName As String)
 Dim pWorkspaceFactory As IWorkspaceFactory Dim pFeatureWorkspace As IFeatureWorkspace Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim sDir As String 
On Error GoTo ErrorHandler:
 sDir = Dir(sFilePath ; "\" ; sFileName ; ".shp") If (sDir = "") Then sDir = Dir(sFilePath ; "\" ; sFileName) If (sDir = "") Then MsgBox ("文件不存在") Exit Sub End If End If
 'Create a new ShapefileWorkspaceFactory object and open a shapefile folder Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0) 'Create a new FeatureLayer and assign a shapefile to it Set pFeatureLayer = New FeatureLayer Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass(sFileName) pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName
 'Add the FeatureLayer to the focus map Set pMxDocument = Application.Document Set pMap = pMxDocument.FocusMap pMap.AddLayer pFeatureLayer
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject OpenShapeFile pVBProject.FileName ; "\..\..\..\.." ; "\data\", "Continents"
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub</TD></TR></TABLE>

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

举报回复喜欢评分

gis

管理员

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

加关注写私信

102楼^#

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

如何创建放大镜(虫眼)
 
本例要实现的是如何创建放大镜(虫眼)，将所选区域放大一定的倍数。
l 要点
用户通过定义IMapInset、IMapInsetWindow、IDataWindowFactory三个接口，运用它们的方法、属性来创建放大镜(虫眼)。
l 程序说明
运用这个子程序生成了一个新的放大镜窗口，在本例中将放大率设定为200%代替原来的400%。
l 代码

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

<TR>
<TD width=531>
Public Sub CreateMagnifierWindow() Dim pMapInset As IMapInset Dim pMapInsetWindow As IMapInsetWindow Dim pDataWindowFactory As IDataWindowFactory Set pDataWindowFactory = New MapInsetWindowFactory If pDataWindowFactory.CanCreate(Application) Then Set pMapInsetWindow = pDataWindowFactory.Create(Application) Set pMapInset = pMapInsetWindow.MapInset 'Set the zoom percent to 200% pMapInset.ZoomPercent = 200 pMapInsetWindow.Show True End If End Sub</TD></TR></TABLE>

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

举报回复喜欢评分

gis

管理员

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

加关注写私信

103楼^#

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

如何调用ArcMap中现有的功能
如何调用ArcMap中现有的功能，比如菜单栏、工具栏中的某些功能。这些都可以通过UID来实现。本例是通过UID调用“另存为”功能。
可以通过两种方法得到UID:
方法一：运用ArcID模块
l 要点
通过ArcID获得UID,ArcID是ArcMap的VBA中的模块。只需要知道要调用功能的名称运用代码就可以实现。
l 程序说明
程序通过运用ArcID模块和命令名称来实现调用“另存为”的功能。
l 代码
Sub ExecuteCmd() Dim pCommandItem As ICommandItem ' Use ArcID module and the Name of the SaveAs command Set pCommandItem = Application.Document.CommandBars.Find(arcid.File_SaveAs) pCommandItem.Execute End Sub
方法二：直接写代码
l 要点
通过直接写代码获得UID实现调用功能。
l 程序说明
写入文件菜单项的GUID(CLSID或ProgID)来调用文件菜单项，同时还需要通过设置Subtype的值来调用文件菜单项的“另存为”功能。
l 代码

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

<TR>
<TD width=531>
Sub ExecuteCmd2() Dim pUID As New UID Dim pCommandItem As ICommandItem ' Use the GUID of the Save command pUID.Value = "{119591DB-0255-11D2-8D20-080009EE4E51}" ' or you can use the ProgID ' pUID.Value = "esriCore.MxFileMenuItem" pUID.SubType = 3 Set pCommandItem = Application.Document.CommandBars.Find(pUID) pCommandItem.Execute End Sub</TD></TR></TABLE>

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

举报回复喜欢评分

gis

管理员

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

加关注写私信

104楼^#

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

如何使用ArcGIS的对话框
添加对话框可以通过相应的接口实现。比如“添加数据对话框”使用IaddDataDialog接口，“生成点坐标对话框” 使用ICoordinateDialog接口，“生成字符串对话框”使用IGetStringDialog接口，“生成数值对话框”使用INumberDialog接口等等。本例以添加数据对话框(Add Data Dialog)为例，讲述对话框是如何通过接口实现添加的。
l 要点
用户通过实现IaddDataDialog接口来创建定制的添加数据对话框，IaddDataDialog接口包括Document和Map属性和Show事件。
l 程序说明
在程序中除了必须生成IaddDataDialog接口的实例外，还必须指定对话框的Document和Map。当为AddDataDialog指定Document和Map之后，系统会自动将用户选择的数据加入到指定Document和Map中。最后实现在ArcMap中添加数据的对话框。
l 代码

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

<TR>
<TD width=531>
Sub ShowProgress() Dim mDocument As IMxDocument Dim mAddDataDialog As IAddDataDialog Set mAddDataDialog = New AddDataDialog Set mDocument = ThisDocument mAddDataDialog.Document = mDocument mAddDataDialog.Map = mDocument.FocusMap mAddDataDialog.Show Application.hWnd, True End Sub</TD></TR></TABLE>

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

举报回复喜欢评分

gis

管理员

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

加关注写私信

105楼^#

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

如何使用状态条(StatusBar)与进度条(ProgressBar)
本例要演示的是如何使用状态条(StatusBar)与进度条(ProgressBar)。实现后的结果为在ArcMap中，状态条位于其底部，它显示ArcMAP当前状态的信息，包含进度条。
l 要点
一般情况下，通过ArcMAP的Application实例获取IstatusBar的实例,然后再通过StatusBar获取IprogressBar的实例,并将IprogressBar的实例赋给IstepProgressor类型的变量。
l 程序说明
运行函数ShowProgress将在ArcMap的下方添加一个状态条(StatusBar)和进度条(ProgressBar)。
l 代码

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

<TR>
<TD width=531>
Sub ShowProgress() On Error GoTo err1 Dim pDocument As IMxDocument Dim pMap As IMap Dim pLayer As ILayer Dim pFeatureLayer As IFeatureLayer Dim pFeatureCursor As IFeatureCursor Dim pFeatureClass As IFeatureClass Dim pFeature As IFeature Dim dSum As Double Dim lFieldIndex As Long Dim lNumFeat As Long Dim dInterval As Double Set pDocument = Application.Document Set pMap = pDocument.FocusMap Set pLayer = pMap.Layer(0) Set pFeatureLayer = pLayer Set pFeatureClass = pFeatureLayer.FeatureClass Set pFeatureCursor = pFeatureLayer.Search(Nothing, True) Dim pStatusBar As IStatusBar Set pStatusBar = Application.StatusBar Dim pStepProgressor As IStepProgressor Set pStepProgressor= pStatusBar.ProgressBar lNumFeat = pFeatureClass.FeatureCount(Nothing) dInterval = lNumFeat / 100 Set pFeature = pFeatureCursor.NextFeature ' 字段名"FID"用户根据实际而改变 lFieldIndex = pFeature.Fields.FindField("FID") Dim PauseTime, Start, Finish, TotalTime, i PauseTime = 0.5 pStepProgressor.MinRange = 1 pStepProgressor.MaxRange = lNumFeat pStepProgressor.StepValue = dInterval For i = 1 To lNumFeat dSum = dSum + pFeature.Value(lFieldIndex) Set pFeature = Nothing Set pFeature = pFeatureCursor.NextFeature pStepProgressor.Position = i pStepProgressor.Message = "Reading record " ; Str(i) ; ". Sum =" ; Str(dSum) pStepProgressor.Step pStepProgressor.Show Start = Timer Do While Timer < Start + PauseTime DoEvents Loop Next pStepProgressor.Hide Exit Sub err1: MsgBox Err.Description End Sub</TD></TR></TABLE>

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

举报回复喜欢评分

gis

管理员

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

加关注写私信

106楼^#

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

本例要实现的是如何创建、使用定制的Extension
 要点
用户需要实现IExtension接口来创建定制的Extension。IExtension接口包括Name属性和startup和shutdown事件。
·创建并注册Extension的步骤：
1．实现IExtension接口；
2．编译成DLL；
3．调用windows目录下system32子目录下的regsvr32.exe用下面的形式注册编译好的DLL
win目录\system32\regsvr32.exe <路径>\<文件名>.dll
4．运行<arcmap目录>\arcexe81\Bin\categories.exe,在打开的Component Catregory Manager中找到ESRI Mx Extensions,点击Add Object…按钮将上面注册的DLL文件加入，并选中实现IExtension接口的类名即可。
l 程序说明
用户通过在类模块中实现IExtension接口来创建定制的Extension。Extension将在ArcMap打开时自动加载，在ArcMap关闭时自动卸载。
l 代码

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

<TR>
<TD width=531>
Option Explicit Implements IExtension Dim m_pApplication As IApplication ' Need to listen for the MxDocument events Dim WithEvents m_pDocument As MxDocument 
 Private Property Get IExtension_Name() As String IExtension_Name = "My Extension" End Property 
 Private Sub IExtension_Shutdown() ' Clear the reference to the Application and MxDocument Set m_pApplication = Nothing Set m_pDocument = Nothing End Sub 
Private Sub IExtension_Startup(initializationData As Variant) ' This extension is an ArcMap Extension. When this extension in loaded on ' ArcMap startup, initializationData is passed in as a reference to the ' Application object Set m_pApplication = initializationData 'Start listening for the MxDocument events. Set m_pDocument = m_pApp.Document End Sub 
 Private Function m_pDocument_NewDocument() As Boolean ' Do something when a new document is created MsgBox "Creating a new document." End Function 
 Private Function m_pDocument_OpenDocument() As Boolean ' So something when a document is opened. MsgBox "Opening a document" End Function</TD></TR></TABLE>

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

举报回复喜欢评分

gis

管理员

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

加关注写私信

107楼^#

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

本例要实现的是如何创建定制的可停靠窗口(Dockable Window)
l 要点
用户通过在类模块中实现IDockableWindowDef接口来创建定制的可停靠窗口(Dockable Window)。IDockableWindowDef接口包括Caption、ChildHWND，UserData及Name等属性和OnCreate、OnDestroy事件。
·ChildHWND属性表示可停靠窗口包含的Window的Handle。
·OnCreate事件的参数hook传入ArcGIS的Application实例。
·创建并注册可停靠窗口的步骤：
1、实现IdockableWindowDef接口(参见实例)；
2、编译成DLL；
3、调用windows目录下system32子目录下的regsvr32.exe用下面的形式注册编译好的DLL：
win目录\system32\regsvr32.exe <路径>\<文件名>.dll
4、运行<arcmap目录>\arcexe81\Bin\categories.exe,在打开的Component Catregory Manager中找到ESRI Mx Dockable Window,点击Add Object…按钮将上面注册的DLL文件加入，并选中实现IdockableWindowDef接口的类名即可。
l 程序说明
类模块 ClsDockableWindow只是创建与注册可停靠窗口，但还不能用，还必须定义一个IdockableWindow接口的变量引用注册的类（必须用IdockableWindowsManager接口的GetDockableWindow获取，其ID号用"实现IdockableWindowDef接口的工程名project1. 实现IdockableWindowDef接口的类名class1"）。
l 代码

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

<TR>
<TD width=531>
'类模块 ClsDockableWindow Option Explicit Implements IDockableWindowDef Dim m_pApplication As IApplication 
Private Property Get IDockableWindowDef_Caption() As String IDockableWindowDef_Caption = "Dockable Window" End Property 
Private Property Get IDockableWindowDef_ChildHWND() As esriCore.OLE_HANDLE '将FrmDWin窗口的Handle赋给IDockableWindowDef_ChildHWND IDockableWindowDef_ChildHWND = FrmDWin.hWnd End Property 
Private Property Get IDockableWindowDef_Name() As String IDockableWindowDef_Name = "docwin" End Property 
Private Sub IDockableWindowDef_OnCreate(ByVal hook As Object) Set m_pApplication = hook End Sub 
Private Sub IDockableWindowDef_OnDestroy() Set m_pApplication = Nothing End Sub 
Private Property Get IDockableWindowDef_UserData() As Variant End Property 
'类模块 class1 Option Explicit Implements ICommand Dim m_pApp As IApplication Dim m_pDWMgr As IDockableWindowManager Dim m_pDWin As IDockableWindow 
Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE End Property 
Private Property Get ICommand_Caption() As String ICommand_Caption = "Dockable Window" End Property 
Private Property Get ICommand_Category() As String ICommand_Category = "Dockable Window" 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 End Property 
Private Property Get ICommand_Name() As String ICommand_Name = "DocWin" End Property 
Private Sub ICommand_OnClick() m_pDWin.Show Not m_pDWin.IsVisible End Sub 
Private Sub ICommand_OnCreate(ByVal hook As Object) Set m_pApp = hook ' QI(Dockable Window) Set m_pDWMgr = hook Dim pid As New UID pid.Value = "Prodockablewindow.Clsdockablewindow" Set m_pDWin = m_pDWMgr.GetDockableWindow(pid) End Sub 
Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = "Dockable Window" End Property</TD></TR></TABLE>

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

举报回复喜欢评分

gis

管理员

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

加关注写私信

108楼^#

发布于：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麦田守望者，期待与您交流。

举报回复喜欢评分

gis

管理员

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

加关注写私信

109楼^#

发布于：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麦田守望者，期待与您交流。

举报回复喜欢评分

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