GIS二次开发：第三部分 用户界面定制——VBA开发

1、用户界面定制VBA开发,上一讲 内容回顾,ArcGIS整体架构 ArcEngine与ArcObject的关系与区别 ArcEngine的体系结构 对象组件模型COM 如何阅读OMD,COM 类与接口,类对象拥有一个或多个接口 接口是定义了一组方法和属性的逻辑关系 与对象的通信是通过接口来进行的,OMD 中的类与对象,抽象类（Abstract Class） 普通类（Class） 组件类（CoClass） 接口 方法和属性,OMD 中关系符号的含义,继承 组成 用来创建 对应关系 1：N 关联,*,_,蛋,鸟,翅膀,羽毛,2,Abstract,Class,Class,Class,燕子,CoClas

2、s,巢,CoClass,*,用户界面定制VBA开发,用户界面定制VBA开发,VBA开发环境 Application对象 Document对象 定制ArcMap的界面 使用Extension扩展ArcGIS VB语法介绍 运行环境配置 帮助文档,3.1 VBA开发环境,与所有的使用VBA的应用程序类似的环境 客户化对话框（Customize dialog box） VB编辑环境（ Visual Basic Editor,Customize dialog box,3.1 VBA开发环境,使用客户化对话框（ Customize dialog box: ）进行以下操作 创建新的工具栏和命令 增加、删除

3、、修改命令 设置控件属性 存储和发布客户化结果 VB编辑环境 （Visual Basic Editor ）: 编写代码,使用客户化对话框（Customize dialog box）,打开客户化对话框，使界面进入设置模式 在客户化对话框打开的状态，你可以 从新排列或移除现有的命令条目 增加新的工具和命令 改变命令的属性,Options:管理客户化的口令等等.,客户化对话框的三个页面：,Toolbars: 管理工具栏, 创建新的工具栏,客户化对话框,Commands: 显示所有命令，拖动新的命令到工具条,A,VB编辑器,Code Modules,Procedures,Project Explore

4、r,Projects,VBA实例：创建工具栏（P25）,在“Tools”菜单中，点击“Customize”，弹出 Customize dialog 对话框 选择Toolbars一项: 点击”new”。弹出 New ToolBar 对话框 输入新的对话框名称，保存 将其拖放到ArcMap上,VBA实例：创建一个宏实现地图的放大（P26-28）,1、在“Tools”菜单中，选择“Macros”菜单中的“Macros”子菜单。 2、在“Marcros”对话框中，输入“MyZoomIn”作为名称，点击“Create”创建一个宏。 3、在弹出的代码窗口（VBA）输入以下代码： Sub MyZoomIn(

5、) Dim pDoc As IMxDocument Dim pEnv As IEnvelope Set pDoc = ThisDocument Set pEnv = pDoc.ActiveView.Extent pEnv.Expand 0.2, 0.2, True pDoc.ActiveView.Extent = pEnv pDoc.ActiveView.Refresh End Sub 4、切换回到ArcMap程序。,5、调用MyZoomIn宏。 显示“Customize”对话框。 选择“Command”页面。 选择“Macros”条目。 选择“MyZoomIn”条目，拖放到目标工具条上。,为

6、什么属性获取有使用set，写入未使有set，查阅第二讲内容，以及查阅帮助文档，了解该属性的性质，回答此问题？,3.2 Application对象,3.2 Application对象,Application对象是ArcMap的根本， 是在VBA环境下的ArcObjects变量的全局变量 是编程的一个起始点 其包括的重要对象（P44 图2-1） DataWindow Extension Document AppDisplay StatusBar Templates,3.2 Application对象,IApplication 应用实例 1）显示Application应用程序的名称 2）打开一个文档

7、 Sub Caption() Dim pApp As IApplication Set pApp = Application MsgBox pApp.Caption pApp.OpenDocument(“d:test.mxd”) End Sub,Application对象的接口 IApplication IMxAppliction IWindowPostion IVbaAppliction IEnumPrinterNames,IWindowPosition 应用实例 1）改变窗口位置及大小 Sub MoveWindow() Dim pWinPos As IWindowPostion Set p

8、WinPos = Application pWinPos.Height =300 pWinPos.Width =300 pWinPos.Left =50 pWinPos.Top=50 pWinPos.State = esriWSMinimize End Sub,IMxApplication 应用实例 1）修改选择集的样式 Sub ChangSelEnv() Dim pApp As IMxApplication Set pApp = Application Dim pSelEnv As ISelectionEnvironment Set pSelEnv = new SelectionEnviro

9、nment pSelEnv.LinearSearchDistance =3 Set pApp.SelectionEnvironment = pSelEnv End Sub,3.3 Document对象,3.3 Document对象,是ArcMap框架中的“二号人物” 是在VBA环境下的ArcObjects变量的全局变量 ThisDocument,何为文档对象？ 文档对象为ArcGIS中某一次操作的状态，以mxd文件保存,3.3 Document对象,一个mxd文件包括三种： Normal 模板 (Normal.mxt) 工程模板(*.mxt) 项目文档(*.mxd),Normal 模板 工程模

10、板 项目文档,3.3 Document对象,与一个文档相关的代码可以包含在： Normal template 项目文档(mxd) 工程模板(optional) 可以在任何一个层次中客户化,类和他们相应的对象,MxDocument,Map,Layer,*,*,FeatureLayer,Application,3.3 Document对象,IMxDocument接口： IDocumentDefaultSymbols接口 IDocumentEvents接口 IDocumentEventsDisp接口,IMxDocument 应用实例 Sub Caption() Dim pDoc As IMxDocu

11、ment Dim pMap As IMap Set pDoc = ThisDocument Set pMap = pDoc.FocusMap End Sub,Symbol 应用实例 Sub changeTextSym() Dim pDoc As IDocument Set pDoc = ThisDocument Dim pDocSym As IDocumentDefaultSymbols Set pDocSym = pDoc Dim pRGB As IRgbColor Set pRGB = New RgbColor pRGB.Red = 100 pRGB.Green = 0 pRGB.Blue

12、 = 0 Dim pTextSym As ITextSymbol Set pTextSym = New TextSymbol pTextSym.Color = pRGB pDocSym.TextSymbol = pTextSym End Sub,3.4 定制ArcMap的界面,3.4 定制ArcMap的界面,3.4.1 定制状态栏 IStatusBar, 状态栏划分为多个区域（面板Panel），每个面板用一个数值代表。如MainPane 为0，AnimationPane为1，PositionPane为2，PagePostionPage 3, 若显示这四个面板，将值表示0123 6 Sub St

13、atusBar() Dim pStatusB as IStatusBar Set pStatusB= Applicaton.StatusBar pStatusBar.Panes =255 End Sub,3.4.1 状态栏上显示进度条,Sub ProgressBar() Dim pStatusBar As IStatusBar Dim i As long Dim pProgBar As IStepProgressor Set pStatusBar = Application.StatusBar Set pProgBar = pStatusBar.ProgressBar pProgBar.Pos

14、ition =0 pStatusBar.ShowProgressBar 载入。,0,900000,1,True For i=0 To 900000 PStatusBar.StepProgressBar Next End Sub,3.4 定制ArcMap的界面,3.4.2 定制浮动窗口(DockableWindow) Public Sub MoveTOC() Dim pDocWinMgr As IDockableWindowManager Dim pToc As IDockableWindow Dim pWinPos As IWindowPosition Set pDocWinMgr = App

15、lication Set pToc = pDocWinMgr.GetDockableWindow(arcid.TableofContents) Set pWinPos = pToc If pToc.IsVisible Then pToc.Dock esriDockFloat pWinPos.Move 100, 100, 120, 320 End If End Sub,3.4 定制ArcMap的界面,3.4.3 快捷键 IMxDocument : AcceleratorTable,可保存、添加、删除、快捷键 Public Sub AssignAccelerator() Dim pAccTable

16、 As IAcceleratorTable Set pAccTable = ThisDocument.Accelerators Dim addAcc As Boolean addAcc = pAccTable.Add(arcid.File_AddData, vbKeyA, True, False, False) End Sub,3.4 定制ArcMap的界面,3.4.4 CommandBars和CommandBar CommandBar命令栏可以是 工具条，菜单栏，菜单和弹出菜单四种类型。 Sub CreateBar() Dim pCmdBars As ICommandBars Dim pDo

17、c As IMxDocument Set pDoc = ThisDocument Set pCmdBars = ThisDocument.CommandBars Dim pNewBar As ICommandBar Set pNewBar = pCmdBars.Create(MyBar, esriCmdBarTypeToolbar) pNewBar.Add arcid.File_AddData pNewBar.Add arcid.PanZoom_FullExtent pNewBar.Dock esriDockBottom, pCmdBars.Find(arcid.Standard_Toolba

18、r) End Sub,3.5 UIControl的使用,3.5 UIControl的使用,四种类型 UIButtonControl UIToolControl UIEditBoxControl UIComboBoxControl,实例1：添加一个“Button”风格的工具,1、在“Tools”菜单中，选择“Customize”菜单。 2、选择“Command”页面的“UIControls”条目。 3、单击“New UIControl”按钮，选择“UIButtonControl”。 4、单击“New”按钮创建一个“Normal.UIButtonControl1”条目。 双击该条目进入代码窗体。

19、在代码窗体中输入如下代码： Private Sub UIButtonControl1_Click() MsgBox TestUIButtonControl, vbOKCancel, Test End Sub 5、把该条目添加到工具条，点击运行，观察运行结果。,实例1（添加一个“Button”风格的工具）,A,实例2：添加一个“Tool”风格的工具,1、在“Tools”菜单中，选择“Customize”菜单。 2、选择“Command”页面的“UIControls”条目。 3、单击“New UIControl”按钮，选择“UI Tool Control”。 4、单击“New”按钮创建一个“Nor

20、mal.UI Tool Control1”条目。 双击该条目进入代码窗体。 5、把该条目添加到工具条，点击运行，观察运行结果。,实例2、添加一个“Tool”风格的工具 (图形放大) P29-30,Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long) If button = 1 Then Dim pDoc As IMxDocument Dim pScreenDisp As IScreenDisplay Dim pRubber

21、Env As IRubberBand Dim pEnv As IEnvelope Set pDoc = ThisDocument Set pScreenDisp = pDoc.ActiveView.ScreenDisplay Set pRubberEnv = New RubberEnvelope Set pEnv = pRubberEnv.TrackNew(pScreenDisp, Nothing) pDoc.ActiveView.Extent = pEnv pDoc.ActiveView.Refresh End If End Sub,实例、添加一个“Tool”风格的工具 (图形放大) （P2

22、9-30）,Private Function UIToolControl1_Enabled() As Boolean Dim pDoc As IMxDocument Set pDoc = ThisDocument If pDoc.FocusMap.LayerCount 0 Then UIToolControl1_Enabled = True ElseIf pDoc.FocusMap.LayerCount = 0 Then UIToolControl1_Enabled = False End If End Function,Private Function UIToolControl1_Curs

23、orID() As Variant UIToolControl1_CursorID = 3 crosshair End Function Private Function UIToolControl1_ToolTip() As String UIToolControl1_ToolTip =Zoom to rectangle End Function 把该条目添加到工具条，点击运行，观察运行结果。,3.6 使用Extersion扩展GIS,Extension是基于COM组件 实现COM 扩展 在软件组件之间的扩展之间能共享数据 接口: IExtension, IExtensionConfig E

24、xtensionManager是对任一IExtension的管理接口。 P31P36 P60,VB语法介绍,VBA中对象的调用语法,Object.Property 对象属性的获取 Object.Property = value 对象属性的赋值 Object.Method arg1, ., argN 对象方法的调用,MsgBox The map name is & myMap.Name,myMap.Name = Zaire.mxd,myMap.AddLayer CityLayer myMap.SelectFeature CityLayer, KahembaPoint myMap.ClearSel

25、ection,在VBA中使用变量,变量定义 使用变量: 申明, 赋值, 比较 过程的参数传值和返回值 比较两个变量的值 分支: 判断语句 变量的作用域,Dim (dimension) statement,申明一个变量 指定变量的类型,Declare variables Dim strFilePathName As String Dim datSparkysBirthday As Date Dim intCount As Integer Other ways to declare variables (to be discussed later). Private strFilePathName

26、 As String Public datSparkysBirthday As Date Static intCount As Integer,变量赋值,直接赋值或通过返回值赋值 如果是一个功能过程的返回值赋值，使用圆括号,Assign values directly intCount = 23 Assign a function return value strFilePathName = InputBox(File to open: ) Assign an object property strMapName = ThisDocument.Title,!,变量赋值,An empty box

27、 for storing values Of a specific type (integer, date, string, etc.) The value stored can change,the VB version of: a + b = c, is dblCSquare = (dblA * dblA) + (dblB * dblB) 转换温度的计算 intTempCelsius = InputBox (Enter temperature (C): ) intTempFahrenheit = (intTempCelsius * 1.8) + 32,MsgBox 消息弹出对话框,MsgB

28、ox 表达式 实例 MsgBox “Good” Dim sum as Integer sum =10 MsgBox sum MsgBox sum =10,Sub 过程 Function 函数,Sub过程 （无返回值） Functions函数 （有返回值） 给函数赋返回值的方式 函数名 值 调用函数的返回值: Value = Function ( arguments ),比较变量的值,Use relational operators ( , , = ) Return a Boolean result (true/false) Functions IsDate IsNumeric IsNull T

29、ypeName,intAnswer = MsgBox (Delete File?, vbYesNo) MsgBox intAnswer = vbYes,MsgBox Number? & IsNumeric(VagueVariable) strType = TypeName (VagueVariable) MsgBox Variable is of data type & strType,判断语句: The If Then statement,根据条件分支执行 Use a Boolean expression 作出决定如何执行,If intLayerCount 1 Then MsgBox The

30、re are no layers in your map!, vbExclaimation End If,Syntax example: If a condition is true Then do something. End If,If Then语句,Exit Sub: Exits procedure before completion ElseIf: Check another condition Else: Code for a False condition,Private Sub WelcomeUser() If strUser = Mark Then MsgBox Welcome

31、 Mark ElseIf strUser = Dana Then MsgBox Welcome Dana Else MsgBox You are not an authorized user! Exit Sub End If Code here to add layers to the map Code here to start an edit session End Sub,判断语句: Select Case statement,根据一个变量的值来进行分支 可以是一个值的范围或者一个值的列表 大小写敏感 相当于几个IF Then 语句,Select Case someVariable Case Is = someValue Do this Case someValueA, someValueB, someValueX Do that Case startValue To endValue Do the other Case Else MsgBox Invalid entry! End Select,Select Case MyVar Case reddocument.bgColor = red Case greendocumen