sirc_lizheng
伴读书童
伴读书童
  • 注册日期2004-07-09
  • 发帖数148
  • QQ
  • 铜币495枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:2734回复:9

AE+vb:工具条设置问题!

楼主#
更多 发布于:2005-09-05 13:00
<P>请问总统:</P>
<P>1 不知道用那个函数或者功能可以设置ToolbarControl工具条可以托动!</P>
<P>2 还有ToolbarControl工具条工具条上的工具项如果超过工具条的范围怎样处理?!</P>
<P>3 如果自己用命令写工具项的功能,然后加到ToolbarControl工具条里,好像软件自带的例子有限,不知道有没有这样的资源可以下载。</P>
<P>4自己写的工具项的功能加到VB自己带的工具条里,会不会很麻烦!需要注意什么?比如关联等怎样关联?</P>
喜欢0 评分0
sirc_lizheng
伴读书童
伴读书童
  • 注册日期2004-07-09
  • 发帖数148
  • QQ
  • 铜币495枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2005-09-08 17:07
帝国总统,你的代码我好像有点整不清楚,能具体点吗?
举报 回复(0) 喜欢(0)     评分
kisssy
卧底
卧底
  • 注册日期2004-04-18
  • 发帖数235
  • QQ
  • 铜币614枚
  • 威望2点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2005-09-07 20:55
activebar 安装之后应该是有Sample的
个人专栏: https://zhuanlan.zhihu.com/c_165676639
举报 回复(0) 喜欢(0)     评分
sirc_lizheng
伴读书童
伴读书童
  • 注册日期2004-07-09
  • 发帖数148
  • QQ
  • 铜币495枚
  • 威望0点
  • 贡献值0点
  • 银元0个
3楼#
发布于:2005-09-07 18:33
请问有没有关于activebar的中文使用说明阿!
举报 回复(0) 喜欢(0)     评分
sirc_lizheng
伴读书童
伴读书童
  • 注册日期2004-07-09
  • 发帖数148
  • QQ
  • 铜币495枚
  • 威望0点
  • 贡献值0点
  • 银元0个
4楼#
发布于:2005-09-07 18:19
谢谢高手的指点,我会尽快实现,然后把结果和问题反映一下的,谢谢总统。kisssy。reecho。
举报 回复(0) 喜欢(0)     评分
reecho
路人甲
路人甲
  • 注册日期2004-07-16
  • 发帖数31
  • QQ
  • 铜币184枚
  • 威望0点
  • 贡献值0点
  • 银元0个
5楼#
发布于:2005-09-06 15:40
<P>已经实现了,谢谢了!</P>
举报 回复(0) 喜欢(0)     评分
kisssy
卧底
卧底
  • 注册日期2004-04-18
  • 发帖数235
  • QQ
  • 铜币614枚
  • 威望2点
  • 贡献值0点
  • 银元0个
6楼#
发布于:2005-09-06 15:18
<P>应该没那么复杂吧!(注意隐藏ToolBarControl)</P>
<P>1、if Use vb ToolBar</P>
<P>Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)<BR>Select Case Button.Index<BR>      Case 1:   '放大<BR>        Set pCom = ToolBarControl1.GetItem(0).Command<BR>        Set ToolBarControl1.CurrentTool = pCom</P>
<P>      Case 2: '缩小<BR>        Set pCom = ToolBarControl1.GetItem(1).Command<BR>        Set ToolBarControl1.CurrentTool = pCom<BR>      Case 3:     '平移<BR>        Set pCom = ToolBarControl1.GetItem(2).Command<BR>        Set ToolBarControl1.CurrentTool = pCom<BR>      Case 4:   '全图<BR>        ToolBarControl1.GetItem(3).Command.OnClick <BR>''''''Case As you wish<BR>End Select<BR>End Sub</P>
<P>2、Else if Use ActiveBar2</P>
<P>Private Sub ActiveBar1_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool) </P>
<P>    Dim pCom As ICommand</P>
<P>    Select Case Tool.Name<BR><BR>      Case "btnZoomin":   '放大<BR>        Set pCom = ToolBarControl1.GetItem(0).Command<BR>        Set ToolBarControl1.CurrentTool = pCom</P>
<P>      Case "btnZoomout": '缩小<BR>        Set pCom = ToolBarControl1.GetItem(1).Command<BR>        Set ToolBarControl1.CurrentTool = pCom<BR>      Case "btnPan":     '平移<BR>        Set pCom = ToolBarControl1.GetItem(2).Command<BR>        Set ToolBarControl1.CurrentTool = pCom<BR>      Case "btnGlobe":   '全图<BR>        ToolBarControl1.GetItem(3).Command.OnClick <BR><BR>    End Select<BR>    Set pCom = Nothing<BR>End Sub</P>
个人专栏: https://zhuanlan.zhihu.com/c_165676639
举报 回复(0) 喜欢(0)     评分
reecho
路人甲
路人甲
  • 注册日期2004-07-16
  • 发帖数31
  • QQ
  • 铜币184枚
  • 威望0点
  • 贡献值0点
  • 银元0个
7楼#
发布于:2005-09-06 11:28
<DIV class=quote><B>以下是引用<I>kisssy</I>在2005-9-5 15:11:53的发言:</B><BR>
<P>第4条“自己写的工具项的功能加到VB自己带的工具条”,这很麻烦吗?</P>
<P>你所有的问题,我觉得你可以这么做。</P>
<P>添加VB工具条,添加ToolbarControl(添加你所需的按钮)</P>
<P>同样VB工具条也添加同样数目的按钮(与ToolbarControl一一对应)</P>
<P>隐藏ToolbarControl,显示VB工具条。</P>
<P>当点击VB工具条某一按钮,再去关联ToolbarControl与其对应的按钮。</P>
<P>如果还想很好的实现你的第一条,推荐你使用一下ActiveBar,这样你想怎么拖就怎么拖,想怎么Dock就怎么Dock。</P></DIV>
<P>可不可以再详细点告知怎么关联toolbarcontrol?谢谢了!</P>
举报 回复(0) 喜欢(0)     评分
kisssy
卧底
卧底
  • 注册日期2004-04-18
  • 发帖数235
  • QQ
  • 铜币614枚
  • 威望2点
  • 贡献值0点
  • 银元0个
8楼#
发布于:2005-09-05 15:11
<P>第4条“自己写的工具项的功能加到VB自己带的工具条”,这很麻烦吗?</P>
<P>你所有的问题,我觉得你可以这么做。</P>
<P>添加VB工具条,添加ToolbarControl(添加你所需的按钮)</P>
<P>同样VB工具条也添加同样数目的按钮(与ToolbarControl一一对应)</P>
<P>隐藏ToolbarControl,显示VB工具条。</P>
<P>当点击VB工具条某一按钮,再去关联ToolbarControl与其对应的按钮。</P>
<P>如果还想很好的实现你的第一条,推荐你使用一下ActiveBar,这样你想怎么拖就怎么拖,想怎么Dock就怎么Dock。</P>
个人专栏: https://zhuanlan.zhihu.com/c_165676639
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
9楼#
发布于:2005-09-05 15:04
<P>1\开发帮助里有 Customization的例子,你在帮助里查找就行</P>
<P>2、超过就用多个喽,或者下拉的工具菜单,方法应该很多</P>
<P>3、其实这个在帮助里也有一些的,看你如何应用了,下面是一个类,可以放在一个dll工程里编译后,可以直接加到vb自己带的工具条里,加的方法,可以参照下面的方法:类模块也在下面</P>
<P>   Private Sub BuildCommandCollection()</P>
<P>  Set m_pCommandCollection = New Collection<BR>  Set m_pButtons = New Collection<BR>  Set m_pButtonRange = New Collection<BR>  <BR>  Dim pCommand As ICommand<BR>  <BR>  ' CoCreate all the sample commands and stuff them into the list<BR>  <BR>'  AddCommand New AfCommandsVC.OpenMapDocument, False<BR>'  AddCommand New AfCommandsVC.SaveMapToDocument, False<BR>  <BR>  AddCommand Nothing, True<BR>  AddCommand New AfCommandsVB.AddData, False<BR>  AddCommand New AfCommandsVB.RemoveData, False<BR>  AddCommand New AfCommandsVB.TableOfContents, False<BR>  AddCommand New AfCommandsVB.Layers, False<BR>  <BR>  AddCommand Nothing, True<BR>  AddCommand New AfCommandsVB.ZoomIn, False<BR>  AddCommand New AfCommandsVB.ZoomOut, False<BR>  AddCommand New AfCommandsVB.Pan, False<BR>  AddCommand New AfCommandsVB.PanLeft, False<BR>  AddCommand New AfCommandsVB.PanUp, False<BR>  AddCommand New AfCommandsVB.PanDown, False<BR>  AddCommand New AfCommandsVB.PanRight, False<BR>  AddCommand New AfCommandsVB.FullExtent, False<BR>  AddCommand New AfCommandsVB.RefreshScreen, False<BR>  AddCommand New AfCommandsVB.UndoExtentStack, False<BR>  AddCommand New AfCommandsVB.RedoExtentStack, False<BR>  <BR>  AddCommand Nothing, True<BR>  AddCommand New AfCommandsVB.Measure, False<BR>  AddCommand New AfCommandsVB.Identify, False<BR>  AddCommand New AfCommandsVB.Select, False<BR>'  AddCommand New AfCommandsVB.Query, False<BR>  AddCommand New AfCommandsVB.AttributeReport, False<BR>  AddCommand New AfCommandsVB.ClearSelection, False<BR>  <BR>  AddCommand Nothing, True<BR>  AddCommand New AfCommandsVB.StartEdit, False<BR>  AddCommand New AfCommandsVB.SaveEdits, False<BR>  AddCommand New AfCommandsVB.AbandonEdits, False<BR>  AddCommand New AfCommandsVB.StopEditing, False<BR>  AddCommand New AfCommandsVB.Undo, False<BR>  AddCommand New AfCommandsVB.Redo, False<BR>  AddCommand New AfCommandsVB.Digitize, False<BR>  AddCommand New AfCommandsVB.Edit, False<BR>  <BR>  AddCommand Nothing, True<BR>  AddCommand New AfCommandsVB.Export, False<BR>  AddCommand New AfCommandsVB.Print, False</P>
<P>  Form_Resize</P>
<P>End Sub</P>
<P>类模块内容,接口可以参照  </P>
<P>这个是简单的“全图显示”功能</P>
<P>Option Explicit<BR>Private m_pMap As esriCarto.IMap<BR>Private m_pApp As esriFramework.IApplication<BR>Private m_pBitmap As IPictureDisp</P>
<P>Implements ICommand<BR>' Constant used by the Error handler function - DO NOT REMOVE<BR>Const c_ModuleFileName = "C:\AF\AfControls\VBCommands\clsFullExtent.cls"</P>

<P><BR>Private Function GetMap() As esriCarto.IMap<BR>  On Error GoTo ErrorHandler</P>
<P>  If (Not m_pMap Is Nothing) Then<BR>    Set GetMap = m_pMap<BR>  ElseIf (Not m_pApp Is Nothing) Then<BR>    Dim pMxDoc As esriArcMapUI.IMxDocument<BR>    Set pMxDoc = m_pApp.Document<BR>    Set GetMap = pMxDoc.FocusMap<BR>  End If</P>
<P><BR>  Exit Function<BR>ErrorHandler:<BR>  HandleError False, "GetMap " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Function</P>
<P>Private Sub Class_Initialize()<BR>  On Error GoTo ErrorHandler</P>
<P>  Set m_pBitmap = LoadResPicture("FullExtent", vbResBitmap)</P>
<P><BR>  Exit Sub<BR>ErrorHandler:<BR>  HandleError True, "Class_Initialize " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Sub</P>
<P>Private Sub Class_Terminate()<BR>  On Error GoTo ErrorHandler</P>
<P>  Set m_pMap = Nothing<BR>  Set m_pApp = Nothing</P>
<P><BR>  Exit Sub<BR>ErrorHandler:<BR>  HandleError True, "Class_Terminate " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Sub</P>
<P>Private Property Get ICommand_Enabled() As Boolean<BR>  On Error GoTo ErrorHandler</P>
<P>  If (GetMap Is Nothing) Then Exit Property<BR>  ICommand_Enabled = (GetMap.layerCount > 0)</P>
<P><BR>  Exit Property<BR>ErrorHandler:<BR>  HandleError True, "ICommand_Enabled " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Property<BR> <BR>Private Property Get ICommand_Checked() As Boolean<BR>  On Error GoTo ErrorHandler</P>
<P>  ICommand_Checked = False</P>
<P><BR>  Exit Property<BR>ErrorHandler:<BR>  HandleError True, "ICommand_Checked " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Property<BR> <BR>Private Property Get ICommand_Name() As String<BR>  On Error GoTo ErrorHandler</P>
<P>  ICommand_Name = "View_Full Extent"</P>
<P><BR>  Exit Property<BR>ErrorHandler:<BR>  HandleError True, "ICommand_Name " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Property</P>
<P>Private Property Get ICommand_Caption() As String<BR>  On Error GoTo ErrorHandler</P>
<P>  ICommand_Caption = "Full Extent"</P>
<P><BR>  Exit Property<BR>ErrorHandler:<BR>  HandleError True, "ICommand_Caption " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Property<BR> <BR>Private Property Get ICommand_Tooltip() As String<BR>  On Error GoTo ErrorHandler</P>
<P>  ICommand_Tooltip = "Zoom Display To Full Data Extent"</P>
<P><BR>  Exit Property<BR>ErrorHandler:<BR>  HandleError True, "ICommand_Tooltip " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Property<BR> <BR>Private Property Get ICommand_Message() As String<BR>  On Error GoTo ErrorHandler</P>
<P>  ICommand_Message = "Zooms the Display To Full Extent of the Data"</P>
<P><BR>  Exit Property<BR>ErrorHandler:<BR>  HandleError True, "ICommand_Message " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Property<BR> <BR>Private Property Get ICommand_HelpFile() As String<BR>  On Error GoTo ErrorHandler</P>
<P>  ' TOD Add your implementation here</P>
<P><BR>  Exit Property<BR>ErrorHandler:<BR>  HandleError True, "ICommand_HelpFile " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Property<BR> <BR>Private Property Get ICommand_HelpContextID() As Long<BR>  On Error GoTo ErrorHandler</P>
<P>  ' TOD Add your implementation here</P>
<P><BR>  Exit Property<BR>ErrorHandler:<BR>  HandleError True, "ICommand_HelpContextID " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Property<BR> <BR>Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE<BR>  On Error GoTo ErrorHandler</P>
<P>  ICommand_Bitmap = m_pBitmap</P>
<P><BR>  Exit Property<BR>ErrorHandler:<BR>  HandleError True, "ICommand_Bitmap " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Property<BR> <BR>Private Property Get ICommand_Category() As String<BR>  On Error GoTo ErrorHandler</P>
<P>  ICommand_Category = "View"</P>
<P><BR>  Exit Property<BR>ErrorHandler:<BR>  HandleError True, "ICommand_Category " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Property<BR> <BR>Private Sub ICommand_OnCreate(ByVal hook As Object)<BR>  On Error GoTo ErrorHandler</P>
<P>  If (TypeOf hook Is IApplication) Then<BR>    Set m_pApp = hook<BR>  ElseIf (TypeOf hook Is IMapControl2) Then<BR>    Dim pMapControl As IMapControl2<BR>    Set pMapControl = hook<BR>    Set m_pMap = pMapControl.Map<BR>  End If</P>
<P><BR>  Exit Sub<BR>ErrorHandler:<BR>  HandleError True, "ICommand_OnCreate " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Sub<BR> <BR>Private Sub ICommand_OnClick()<BR>  On Error GoTo ErrorHandler</P>
<P>  Dim pActiveView As esriCarto.IActiveView<BR>  Set pActiveView = GetMap<BR>  pActiveView.Extent = pActiveView.FullExtent<BR>  pActiveView.Refresh</P>
<P><BR>  Exit Sub<BR>ErrorHandler:<BR>  HandleError True, "ICommand_OnClick " ; c_ModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1<BR>End Sub</P>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
游客

返回顶部