不才想在ie中自做一工具条，在其上做按钮，点击后在事件代码中做出响应；
从这里http://www.klemid.de/bar_sample.aspx下载了Samplebar.zip,但他的按钮不美观，，是vb中普通的凸起的按钮，我想要的是象ie自身工具栏那样的平面型按钮，改其代码现在按钮显示出来了，但无法捕获按钮鼠标事件，只能捕获键盘事件；那位大哥大研究过这个程序就请拉不才一把！不甚感激！Private Sub AddToolbarButtons()
'create the actual toolbar buttons
'm_buttons(1) acts as a placeholder for the controls taken from frmToolbar
'those controls are added in CreateToolbar
'建立toolbar上的按钮，m_buttons(1)作为来自frmtoolbar的控件位置分隔，控件在CreateToolbar中添加Const PROC_NAME = "AddToolbarButtons"
Log4VB "Entered", MODULE_NAME, PROC_NAME, 1Const strButtonFile = "&MyToolBar说明"
Const strButtonSearch = "&Search At"
ReDim m_Buttons(0 To 3)'kind of 'File' menu'文件菜单
m_Buttons(0).idCommand = ID_FILE
m_Buttons(0).iString = StrPtr(strButtonFile) '菜单文字
m_Buttons(0).fsStyle = CTBDropDown Or CTBAutoSize '按钮类型
'm_Buttons(0).fsStyle = TBSTYLE_BUTTON + TBSTYLE_AUTOSIZE
m_Buttons(0).fsState = TBSTATE_ENABLED '菜单可见
m_Buttons(0).iBitmap = 0 '图标编号'the separator provides space for controls from the form
'***Add code here for new controls
m_Buttons(1).fsStyle = BTNS_SEP
m_Buttons(1).iBitmap = 260 'adapt this value appropriately'drop down menu providing the web sites'搜索菜单
m_Buttons(2).idCommand = ID_SEARCH
m_Buttons(2).iString = StrPtr(strButtonSearch)
m_Buttons(2).fsStyle = CTBDropDown Or CTBAutoSize
m_Buttons(2).fsState = TBSTATE_ENABLED
m_Buttons(2).iBitmap = 1
'm_Buttons(3) 是我加的flat型Tbbutton按钮，可正确显示捕获键盘事件，怎么捕获鼠标单击事件？m_Buttons(3).idCommand = 3
m_Buttons(3).iString = StrPtr(strButtontext)
m_Buttons(3).fsStyle = CTBDropDown Or CTBAutoSize
m_Buttons(3).fsState = TBSTATE_ENABLED
m_Buttons(3).iBitmap = 1
SendMessage m_lToolWnd, TB_ADDBUTTONSW, 4, m_Buttons(0)End Sub
Private Sub CreateToolbar()
'create a toolbar using API calls
Const PROC_NAME = "CreateToolbar"
Log4VB "Entered", MODULE_NAME, PROC_NAME, 1Dim tTB As TBBUTTON
Dim udtPos As WINDOWPOS
Dim udtRect As RECT
Dim X&, Y&, cx&, cy&, nHeight&
Dim nID As Long
Dim oControl As Object'The window that will receive the toolbar messages is the form
m_lMsgWnd = frmToolbar.hwnd'Create the toolbar window
'WS_TABSTOP allows to tab into the toolbar from other IE parts'使toolbar可接受ie中的tab键
m_lToolWnd = CreateToolbarEx(m_lMsgWnd, WS_TABSTOP Or WS_CHILD Or _
CCS_NODIVIDER Or CCS_NORESIZE Or _
TBSTYLE_LIST Or TBSTYLE_TOOLTIPS Or TBSTYLE_FLAT Or TBSTYLE_TRANSPARENT, _
0, 0, 0, 0, tTB, 0, 16, 16, 16, 16, LenB(tTB))'create toolbar's child controls
AddToolbarIcons
'Make sure we can have drop-down buttons:'使可以建立下拉按钮
SendMessageLong m_lToolWnd, TB_SETEXTENDEDSTYLE, 0, TBSTYLE_EX_DRAWDDARROWS
AddToolbarButtons '建立toolbar上来自菜单的按钮,'add the combo box添加comb box下拉框
On Error Resume Next
With frmToolbar.cboSearch
m_lEdit = .hwnd
'make it a child of the toolbar window
SetParent .hwnd, m_lToolWnd '让frmToolbar.cboSearch下拉框做toolbar的child
cy = .Height / Screen.TwipsPerPixelY
cx = .Width / Screen.TwipsPerPixelX
End With
'let combo box start right after first button'下拉框放在第一按钮的右边
X = GetButtonWidth(ID_FILE) + 5
MoveWindow m_lEdit, X, (nControlHeight - cy) / 2, cx, cy, False'create an array keeping the handles of the controls in frmToolbar
On Error Resume Next
ReDim m_Controls(frmToolbar.Controls.Count)
For Each oControl In frmToolbar.Controls
nID = GetWindowLong(oControl.hwnd, GWL_ID)
m_Controls(nID) = oControl.hwnd
Next'Add the textbox'添加textbox文本框
On Error Resume Next
'let text box start right after combobox
X = GetButtonWidth(ID_FILE) + 90
'X = X + cx + 5
With frmToolbar.txtTest
m_lEdit = .hwnd
'make it a child of the toolbar window
SetParent .hwnd, m_lToolWnd '让frmToolbar.textbox文本框做toolbar的child
cy = .Height / Screen.TwipsPerPixelY
cx = .Width / Screen.TwipsPerPixelX
End With
MoveWindow m_lEdit, X, (nControlHeight - cy) / 2, cx, cy, False 'Add the button'添加按钮,,,,,,,,,,,,,,,,,,,,,,,,,,,,凸起的,不想要的按钮
On Error Resume Next
'let text box start right after text box
X = X + cx + 5
With frmToolbar.cmdTest
m_lEdit = .hwnd
'make it a child of the toolbar window
SetParent .hwnd, m_lToolWnd '让frmToolbar.cmdbutton按钮做toolbar的child
cy = .Height / Screen.TwipsPerPixelY
cx = .Width / Screen.TwipsPerPixelX
End With
MoveWindow m_lEdit, X, (nControlHeight - cy) / 2, cx, cy, False'***Add code here for new controls'在这里添加其他控件'tell the subclassing mechanism which messages we want to handle
AttachMessage Me, m_lMsgWnd, WM_COMMAND
AttachMessage Me, m_lMsgWnd, WM_NOTIFYEnd Sub
。。以下是键盘捕获原文
Private Sub IInputObject_TranslateAcceleratorIO(lpMsg As olelib.MSG)
'handle backspace and other keys before IE does
Const PROC_NAME = "IInputObject_TranslateAcceleratorIO"
Log4VB "Entered (" & MsgToText(lpMsg.message) & ")", MODULE_NAME, PROC_NAMEDim hwnd As Long 'handle of the current input control'window having the focus currently
hwnd = m_hWndFocusSelect Case lpMsg.message
Case WM_KEYDOWN
Log4VB "Key code is " & lpMsg.wParam, MODULE_NAME, PROC_NAME, 3
Select Case lpMsg.wParam
Case vbKeyBack
'forward message to the input control
SendMessageLong hwnd, WM_CHAR, lpMsg.wParam, lpMsg.lParam
'we cared!
Exit Sub
Case vbKeyDelete, vbKeyUp, vbKeyDown
'forward message to the input control
SendMessageLong hwnd, WM_KEYDOWN, lpMsg.wParam, lpMsg.lParam
'we cared!
Exit Sub
End Select
Case WM_SYSKEYDOWN, WM_SYSKEYUP
'we handle our own toolbar accelerators
'works only when we have the focus
Log4VB "Key code is " & lpMsg.wParam, MODULE_NAME, PROC_NAME, 3
Select Case lpMsg.wParam
Case vbKeyM:
Call DropDown(ID_FILE) '展开下拉框
Exit Sub
Case vbKeyS:
Call DropDown(ID_SEARCH) '展开下拉框
Exit Sub
Case vbKeyT:
Call frmToolbar.cmdTest_Click
Exit Sub
'***Add code here for new controls'在这里添加其他控件代码
End Select
#If 0 Then 'removed 2004-10-17
Case WM_CHAR
Log4VB "Key code is " & lpMsg.wParam, MODULE_NAME, PROC_NAME, 3
If lpMsg.wParam = vbKeyReturn Then
Log4VB "User pressed return", MODULE_NAME, PROC_NAME, 3
Exit Sub
End If
#End If
End Select'default is: we didn't care and leave handling up to IE
Err.Raise E_FAILEnd Sub
从这里http://www.klemid.de/bar_sample.aspx下载了Samplebar.zip,但他的按钮不美观，，是vb中普通的凸起的按钮，我想要的是象ie自身工具栏那样的平面型按钮，改其代码现在按钮显示出来了，但无法捕获按钮鼠标事件，只能捕获键盘事件；那位大哥大研究过这个程序就请拉不才一把！不甚感激！Private Sub AddToolbarButtons()
'create the actual toolbar buttons
'm_buttons(1) acts as a placeholder for the controls taken from frmToolbar
'those controls are added in CreateToolbar
'建立toolbar上的按钮，m_buttons(1)作为来自frmtoolbar的控件位置分隔，控件在CreateToolbar中添加Const PROC_NAME = "AddToolbarButtons"
Log4VB "Entered", MODULE_NAME, PROC_NAME, 1Const strButtonFile = "&MyToolBar说明"
Const strButtonSearch = "&Search At"
ReDim m_Buttons(0 To 3)'kind of 'File' menu'文件菜单
m_Buttons(0).idCommand = ID_FILE
m_Buttons(0).iString = StrPtr(strButtonFile) '菜单文字
m_Buttons(0).fsStyle = CTBDropDown Or CTBAutoSize '按钮类型
'm_Buttons(0).fsStyle = TBSTYLE_BUTTON + TBSTYLE_AUTOSIZE
m_Buttons(0).fsState = TBSTATE_ENABLED '菜单可见
m_Buttons(0).iBitmap = 0 '图标编号'the separator provides space for controls from the form
'***Add code here for new controls
m_Buttons(1).fsStyle = BTNS_SEP
m_Buttons(1).iBitmap = 260 'adapt this value appropriately'drop down menu providing the web sites'搜索菜单
m_Buttons(2).idCommand = ID_SEARCH
m_Buttons(2).iString = StrPtr(strButtonSearch)
m_Buttons(2).fsStyle = CTBDropDown Or CTBAutoSize
m_Buttons(2).fsState = TBSTATE_ENABLED
m_Buttons(2).iBitmap = 1
'm_Buttons(3) 是我加的flat型Tbbutton按钮，可正确显示捕获键盘事件，怎么捕获鼠标单击事件？m_Buttons(3).idCommand = 3
m_Buttons(3).iString = StrPtr(strButtontext)
m_Buttons(3).fsStyle = CTBDropDown Or CTBAutoSize
m_Buttons(3).fsState = TBSTATE_ENABLED
m_Buttons(3).iBitmap = 1
SendMessage m_lToolWnd, TB_ADDBUTTONSW, 4, m_Buttons(0)End Sub
Private Sub CreateToolbar()
'create a toolbar using API calls
Const PROC_NAME = "CreateToolbar"
Log4VB "Entered", MODULE_NAME, PROC_NAME, 1Dim tTB As TBBUTTON
Dim udtPos As WINDOWPOS
Dim udtRect As RECT
Dim X&, Y&, cx&, cy&, nHeight&
Dim nID As Long
Dim oControl As Object'The window that will receive the toolbar messages is the form
m_lMsgWnd = frmToolbar.hwnd'Create the toolbar window
'WS_TABSTOP allows to tab into the toolbar from other IE parts'使toolbar可接受ie中的tab键
m_lToolWnd = CreateToolbarEx(m_lMsgWnd, WS_TABSTOP Or WS_CHILD Or _
CCS_NODIVIDER Or CCS_NORESIZE Or _
TBSTYLE_LIST Or TBSTYLE_TOOLTIPS Or TBSTYLE_FLAT Or TBSTYLE_TRANSPARENT, _
0, 0, 0, 0, tTB, 0, 16, 16, 16, 16, LenB(tTB))'create toolbar's child controls
AddToolbarIcons
'Make sure we can have drop-down buttons:'使可以建立下拉按钮
SendMessageLong m_lToolWnd, TB_SETEXTENDEDSTYLE, 0, TBSTYLE_EX_DRAWDDARROWS
AddToolbarButtons '建立toolbar上来自菜单的按钮,'add the combo box添加comb box下拉框
On Error Resume Next
With frmToolbar.cboSearch
m_lEdit = .hwnd
'make it a child of the toolbar window
SetParent .hwnd, m_lToolWnd '让frmToolbar.cboSearch下拉框做toolbar的child
cy = .Height / Screen.TwipsPerPixelY
cx = .Width / Screen.TwipsPerPixelX
End With
'let combo box start right after first button'下拉框放在第一按钮的右边
X = GetButtonWidth(ID_FILE) + 5
MoveWindow m_lEdit, X, (nControlHeight - cy) / 2, cx, cy, False'create an array keeping the handles of the controls in frmToolbar
On Error Resume Next
ReDim m_Controls(frmToolbar.Controls.Count)
For Each oControl In frmToolbar.Controls
nID = GetWindowLong(oControl.hwnd, GWL_ID)
m_Controls(nID) = oControl.hwnd
Next'Add the textbox'添加textbox文本框
On Error Resume Next
'let text box start right after combobox
X = GetButtonWidth(ID_FILE) + 90
'X = X + cx + 5
With frmToolbar.txtTest
m_lEdit = .hwnd
'make it a child of the toolbar window
SetParent .hwnd, m_lToolWnd '让frmToolbar.textbox文本框做toolbar的child
cy = .Height / Screen.TwipsPerPixelY
cx = .Width / Screen.TwipsPerPixelX
End With
MoveWindow m_lEdit, X, (nControlHeight - cy) / 2, cx, cy, False 'Add the button'添加按钮,,,,,,,,,,,,,,,,,,,,,,,,,,,,凸起的,不想要的按钮
On Error Resume Next
'let text box start right after text box
X = X + cx + 5
With frmToolbar.cmdTest
m_lEdit = .hwnd
'make it a child of the toolbar window
SetParent .hwnd, m_lToolWnd '让frmToolbar.cmdbutton按钮做toolbar的child
cy = .Height / Screen.TwipsPerPixelY
cx = .Width / Screen.TwipsPerPixelX
End With
MoveWindow m_lEdit, X, (nControlHeight - cy) / 2, cx, cy, False'***Add code here for new controls'在这里添加其他控件'tell the subclassing mechanism which messages we want to handle
AttachMessage Me, m_lMsgWnd, WM_COMMAND
AttachMessage Me, m_lMsgWnd, WM_NOTIFYEnd Sub
。。以下是键盘捕获原文
Private Sub IInputObject_TranslateAcceleratorIO(lpMsg As olelib.MSG)
'handle backspace and other keys before IE does
Const PROC_NAME = "IInputObject_TranslateAcceleratorIO"
Log4VB "Entered (" & MsgToText(lpMsg.message) & ")", MODULE_NAME, PROC_NAMEDim hwnd As Long 'handle of the current input control'window having the focus currently
hwnd = m_hWndFocusSelect Case lpMsg.message
Case WM_KEYDOWN
Log4VB "Key code is " & lpMsg.wParam, MODULE_NAME, PROC_NAME, 3
Select Case lpMsg.wParam
Case vbKeyBack
'forward message to the input control
SendMessageLong hwnd, WM_CHAR, lpMsg.wParam, lpMsg.lParam
'we cared!
Exit Sub
Case vbKeyDelete, vbKeyUp, vbKeyDown
'forward message to the input control
SendMessageLong hwnd, WM_KEYDOWN, lpMsg.wParam, lpMsg.lParam
'we cared!
Exit Sub
End Select
Case WM_SYSKEYDOWN, WM_SYSKEYUP
'we handle our own toolbar accelerators
'works only when we have the focus
Log4VB "Key code is " & lpMsg.wParam, MODULE_NAME, PROC_NAME, 3
Select Case lpMsg.wParam
Case vbKeyM:
Call DropDown(ID_FILE) '展开下拉框
Exit Sub
Case vbKeyS:
Call DropDown(ID_SEARCH) '展开下拉框
Exit Sub
Case vbKeyT:
Call frmToolbar.cmdTest_Click
Exit Sub
'***Add code here for new controls'在这里添加其他控件代码
End Select
#If 0 Then 'removed 2004-10-17
Case WM_CHAR
Log4VB "Key code is " & lpMsg.wParam, MODULE_NAME, PROC_NAME, 3
If lpMsg.wParam = vbKeyReturn Then
Log4VB "User pressed return", MODULE_NAME, PROC_NAME, 3
Exit Sub
End If
#End If
End Select'default is: we didn't care and leave handling up to IE
Err.Raise E_FAILEnd Sub
解决方案 »
- VB串口通信
- 怎么判断Textbox文本框输入的值是否可以转换为Double类型呢，并且要求小数位只保留2位
- 帮我看下怎么写这代码
- 请老师看看这段MSFlexGrid控件的代码，帮忙修改一下
- 有人是自学VB的吗?进来一下
- 怎么得到服务器的当前时间？
- 有一个问题，大家看一下
- VB访问EXCEL如何写SQL语句？
- 有没有支持透明的PictureBox(同时支持Paint,可做容器)
- 关于给ActiveX dll 属性赋值问题，请路过的大侠停停脚步！
- ★杭州的大吓请进来一下，我现在在武汉，工作经验一年,一家杭州的公司叫我过去，试用期1500，什么都不管，我不知道在哪边1500能不能养活
- 想把窗体的相关设置连起来,但没经验.
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MDIACTIVATE = &H222
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
要那个加那个呀