|
'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 | 
