Public Sub AddToolButton(name As String, Caption As String, Description As String, Optional imagefilename As String = '', Optional iOrder As Long = 47, Optional imageIndex As Long = 20)
On Error GoTo EHandler
Dim bu As Button
Set bu = GetToolButton(name)
If bu Is Nothing Then
If imagefilename <> '' Then
Dim img As ListImage
Set img = m_BillTransfer.BillForm.tlbTool.ImageList.ListImages.Add(, name, LoadPicture(imagefilename))
imageIndex = img.Index
End If
Set bu = m_BillTransfer.BillForm.tlbTool.Buttons.Add(iOrder, name, Caption, , imageIndex)
bu.Caption = Caption
bu.ToolTipText = Description
bu.Description = Caption
End If
Exit Sub
EHandler: MsgBox 'MyTransferFacade.AddToolButton错误:' + Err.Description, vbCritical, '金蝶提示' Err.Clear
End Sub​​
然后在LoadBillEnd事件的处理方法中调用此方法,就可以向工具栏添加一个按钮
不过响应按钮按下的事件则需要使用另一个事件:
事实上，在制作插件时,最好对插件对象做一个封装,然后在具体的插件中进行间接使用,而不是直接访问,因此上面的代码也应该放在封装对象中,以下的代码也是在封装对象中的
'在用户选单后，填充数据后发生'本事件来源于RetEvent事件,并由此事件引发'EventID='Bill_FillBillDataExt'
Public Event AfterSelBill(ByVal Para As KFO.IDictionary, ByRef Cancel As Boolean)Public Event BeforePressToolBtn(ByVal buttonCaption As String, Para As KFO.IDictionary, ByRef Cancel As Boolean)Public Event AfterPressToolBtn(ByVal buttonCaption As String, Para As KFO.IDictionary, ByRef Cancel As Boolean)
Private Sub m_BillTransfer_RetEvents(ByVal Para As KFO.IDictionary)On Error GoTo EHandler Dim Cancel As Boolean Cancel = False If Para.lookup('EventID') = True Then
Select Case Para('EventID')
Case 'Bill_FillBillDataExt' '单据选单后事件
Call OnAfterSelBill(Cancel)
RaiseEvent AfterSelBill(Para, Cancel)
m_BillTransfer.DoRefreshControl
Case 'frmBill_CheckData'
If Para('EventIDProp') = 0 Then
RaiseEvent BeforeCheckData(Para, Cancel)
Else
RaiseEvent AfterCheckData(Para, Cancel)
End If
Case 'Bill_ButtonClick'
If Para('EventIDProp') = 0 Then
RaiseEvent BeforePressToolBtn(Para('para')('Button'), Para, Cancel)
Else
RaiseEvent AfterPressToolBtn(Para('para')('Button'), Para, Cancel)
End If
End Select
If Cancel = True Then
Para('EventIDCancel') = Cancel
End If
Exit Sub
EHandler: MsgBox 'Err.Description, vbCritical, '金蝶提示' Err.Clear
End Sub
然后在自己的插件对象中使用你封装的对象
由于在封装对象中使用了事件,所以在插件中定义时应该是这样的:
Private WithEvents myTransfer As MyTransfferFacade
带上了WithEvents关键字
然后是响应代码
Private Sub myTransfer_AfterPressToolBtn(ByVal buttonCaption As String, Para As KFO.IDictionary, Cancel As Boolean)
If buttonCaption = '保存' Then
...you code
ElseIf buttonCaption = '配货' Then
...you code
End If
Exit Sub
End Sub
附：
可以在工业单据的工具栏上增加或处理菜单
'下面的SUB是增加菜单的代码
Private Sub m_BillTransfer_LoadBillEnd(ByVal ShowType As Long)
With m_BillTransfer.BillForm.tlbTool.Buttons
.Add .Count, 'mnuTest', '测试', , 24
End With
m_BillTransfer.BillForm.tlbTool.Buttons('PRINT').Enabled = False
m_BillTransfer.BillForm.tlbTool.Buttons('PRINTVIEW').Visible = False
End Sub
'下面的SUB是响应点击事件的代码
Private Sub m_BillTransfer_RetEvents(ByVal Para As KFO.IDictionary)
If Para('EventID') = 'Bill_ButtonClick' And Para('EventIDProp') = 1 Then
If Para('Para')('Button').Key = 'mnuTest' Then
MsgBox 'Hello,World!'
End If
End If
End Sub
---同时也找到点其他有用的东西。
之前在论坛上看到有人提问工具栏各按钮的内部名称，通过以下语句可控制工具栏的显示状态。
'使打印按钮不可用
m_BillTransfer.BillForm.tlbTool.Buttons('PRINT').Enabled = False
'使打印预览按钮不可见
m_BillTransfer.BillForm.tlbTool.Buttons('PRINTVIEW').Visible = False
以下为销售订单工具栏的内部名称
新增,NEW
复制,COPY
保存,SAVE
恢复,BillUndo
清空,UNDO
打印,PRINT
预览,PRINTVIEW
下达,CONVEY
审核,CHECK
钩稽,Hook
批录,FullStockID
红字,RedBill
蓝字,BlueBill
删除,DelEntry
添加,AddEntry
首张,MOVEFIRST
前张,MOVEPRIVOUS
后张,MOVENEXT
末张,MOVELAST
刷新,REFRESH
查看,LOOKUP
正排,ArrangeUp
SN号,mnuSNMgr
等级品,manuGradeItem
证照,manuCardWarn
倒排,ArrangeDown
替代,RepOper
分解,Schedule
退出,EXIT