| Вопрос: Панель Task Pane | Добавлено: 26.09.03 14:48 |
Автор вопроса:  Федор Власенко | Web-сайт: fregate.org.ua
|
|
Option Explicit Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _ (ByVal hWnd1 As Long, _ ByVal hWnd2 As Long, _ ByVal lpsz1 As String, _ ByVal lpsz2 As String) As Long Public Declare Function GetWindow Lib "user32" _ (ByVal hwnd As Long, _ ByVal wCmd As Long) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Public Declare Function SetWindowPos Lib "user32" _ (ByVal hwnd As Long, _ ByVal hWndInsertAfter As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal cx As Long, _ ByVal cy As Long, _ ByVal wFlags As Long) As Long Public Declare Function GetClientRect Lib "user32" _ (ByVal hwnd As Long, _ lpRect As RECT) As Long Public Declare Function SetParent Lib "user32" _ (ByVal hWndChild As Long, _ ByVal hWndNewParent As Long) As Long Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _ (ByVal lpPrevWndFunc As Long, _ ByVal hwnd As Long, _ ByVal msg As Long, _ ByVal wParam As Long, _ lParam As Long) As Long Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Long) As Long Public Declare Function GetParent Lib "user32" _ (ByVal hwnd As Long) As Long Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (Destination As Any, _ Source As Any, _ ByVal Length As Long) Public Type psevdWINDOWPOS hwnd As Long hWndInsertAfter As Long x As Long y As Long cx As Long cy As Long flags As Long End Type Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public Const GWL_EXSTYLE = (-20) Public Const GWL_STYLE = (-16) Public Const GWL_WNDPROC = -4 Public Const WS_CAPTION& = &HC00000 Public Const WS_BORDER& = &H800000 Public Const WS_POPUP& = &H80000000 Public Const WS_SYSMENU& = &H80000 Public Const WS_CHILD& = &H40000000 Public Const WS_CHILDWINDOW& = (WS_CHILD) Public Const WS_CLIPSIBLINGS& = &H4000000 Public Const WS_CLIPCHILDREN& = &H2000000 Public Const WS_VISIBLE& = &H10000000 Public Const WM_WINDOWPOSCHANGING = &H46 Public Const WM_NCLBUTTONDOWN& = &HA1 Public Const SWP_NOMOVE& = &H2 Public Const SWP_NOZORDER& = &H4 Public Const SWP_NOSIZE = &H1 Public FormHwnd As Long Public OldWindowProc As Long Public Sub CreateMyBar() Dim MyBar As CommandBar Dim butMyBar As CommandBarButton Dim FormHwnd As Long Dim frmStyle As Long, xlR As RECT 'Проверка наличия меню For Each MyBar In CommandBars If MyBar.Name = "DocBar" Then Unload MyForm SetWindowLong GetBarHwnd("DocBar"), GWL_WNDPROC, OldWindowProc Application.CommandBars("DocBar").Delete End If Next 'Создаем меню Set MyBar = Application.CommandBars.Add("DocBar", msoBarRight, False, True) MyBar.Protection = msoBarNoMove Set butMyBar = Application.CommandBars("DocBar").Controls.Add(msoControlButton) butMyBar.Height = 200 MyBar.Visible = True 'Загружаем форму Load MyForm 'Индитификатор формы FormHwnd = FindWindow("ThunderDFrame", MyForm.Caption) 'Назначаем нового родителя форме SetParent FormHwnd, GetBarHwnd("DocBar") 'Читаем и изменяем стиль формы frmStyle = GetWindowLong(FormHwnd, GWL_STYLE) _ - WS_CAPTION - WS_BORDER - WS_POPUP - WS_SYSMENU + WS_CHILDWINDOW 'Устанавливаем новые стили формы SetWindowLong FormHwnd, GWL_STYLE, frmStyle SetWindowLong FormHwnd, GWL_EXSTYLE, &H0 xlR = xldeskR() 'Устанавливаем размеры панели "DocBar" SetWindowPos GetBarHwnd("DocBar"), 0, 0, 0, 204, xlR.Bottom - xlR.Top, SWP_NOZORDER Or SWP_NOMOVE 'Показываем форму MyForm.Show 'Стартуем сабклассинг OldWindowProc = SetWindowLong(GetBarHwnd("DocBar"), GWL_WNDPROC, AddressOf NewWindowProc) End Sub Private Function xldeskR() As RECT 'Кординаты XLDESK окна GetClientRect FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString), xldeskR End Function Private Function GetBarHwnd(BarName As String) As Long 'Индетификатор панели меню GetBarHwnd = FindWindowEx(FindWindowEx(Application.hwnd, 0, "EXCEL2", vbNullString), 0, "MsoCommandBar", BarName) End Function Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Long) As Long If msg = WM_WINDOWPOSCHANGING Then |
| Ответы | Всего ответов: 3 |
|
Номер ответа: 1 Автор ответа:  User Unknown Вечный Юзер! ICQ: uu@jabber.cz Вопросов: 120 Ответов: 3302 |
Профиль | | #1 | Добавлено: 26.09.03 15:02 |
|
И чего с этим прикажешь делать?! Если ты это выложил как пример для общего доступа, то лучше выслать на mailto:user@vbnet.ru нормальные файлы проекта. |
||
|
Номер ответа: 2 Автор ответа: Федор Власенко Вопросов: 8 Ответов: 11 |
Web-сайт: Профиль | | #2 | Добавлено: 26.09.03 15:17 |
|
Как я понял в форму весь код не влез. Просьба тогда помочь в этой функции. Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Long) As Long |
||
|
Номер ответа: 3 Автор ответа: ПавелАдминистратор ICQ: 326066673 Вопросов: 368 Ответов: 5968 |
Web-сайт: Профиль | | #3 | Добавлено: 26.09.03 16:51 |
|
На размер сообщений выставлено ограничение в 7000 символов... Действительно, если это пример, то пришлите на user@vbnet.ru, а если это можно в библиотеку кодов, то alex@vbnet.ru или pavel@vbnet.ru. |
||
Страница: 1 |