Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Вопросец: разработка ActiveX кнопки Добавлено: 15.01.09 15:42  

Автор вопроса:  mishaprogrammer
Хочу для проги создать кнопку чтобы была похожа предположим, на office 2007. Типа создаю image и если мышь наведена запихиваю картинку 1, если же нет картинку 2. Только как в ActiveX контроле узнать наведена мышь или нет???

Ответить

  Ответы Всего ответов: 12  

Номер ответа: 1
Автор ответа:
 fAndOrIn



Вопросов: 5
Ответов: 344
  Профиль | | #1 Добавлено: 15.01.09 18:54
Можно попробовать так


Dim b_MouseInBut As Boolean

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not b_MouseInBut Then
  'загружай картинку 1
  ''''''''''''''''''''
  b_MouseInBut = True
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If b_MouseInBut Then
  'загружай картинку 2
  ''''''''''''''''''''
  b_MouseInBut = False
End If
End Sub


Пример не тестил, но вроде все на месте.

Ответить

Номер ответа: 2
Автор ответа:
 mishaprogrammer



Вопросов: 26
Ответов: 66
  Профиль | | #2 Добавлено: 15.01.09 20:55
fAndOrIn пишет:
  1.  
  2. Form_MouseMov


 

В контроле никакой формы нет. Над чтоб контрол был, и вот проблема: зафиксировать момент когда курсор покидает контрол...

Ответить

Номер ответа: 3
Автор ответа:
 fAndOrIn



Вопросов: 5
Ответов: 344
  Профиль | | #3 Добавлено: 15.01.09 21:27
Простите, не понял.
Что, весь интерфейс "проги" состоит из одной кнопки?
Если нет, то для всего, что окружает кнопку, д.б. событие "_MouseMove".
А возникновение данного события означает, что курсор ушел с нашей кнопки.
Или я в самом деле ничего не понял!

Ответить

Номер ответа: 4
Автор ответа:
 mishaprogrammer



Вопросов: 26
Ответов: 66
  Профиль | | #4 Добавлено: 15.01.09 21:29
fAndOrIn пишет:
Что, весь интерфейс "проги" состоит из одной кнопки?

да. и не проги а activex'а.

Ответить

Номер ответа: 5
Автор ответа:
 fAndOrIn



Вопросов: 5
Ответов: 344
  Профиль | | #5 Добавлено: 15.01.09 22:16
  1. Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  2.   If (X > (Command1.Width / 10)) And (X < (Command1.Width * 9 / 10)) _
  3.   And (Y > (Command1.Height / 10)) And (Y < (Command1.Height * 9 / 10)) Then
  4.     'load pic1
  5.   Else
  6.     'load pic2
  7.   End If
  8. End Sub


И мышкой отсчитываем каждый пиксель, типа никуда не торопимся!

Ответить

Номер ответа: 6
Автор ответа:
 Father



Вопросов: 0
Ответов: 159
  Профиль | | #6 Добавлено: 16.01.09 00:20
Поставь таймер и в нем проверяй кординаты.

Ответить

Номер ответа: 7
Автор ответа:
 Alex



Вопросов: 10
Ответов: 131
  Профиль | | #7 Добавлено: 16.01.09 02:29
а как тоже самое сделать для формы? (но без таймера, желательно как fAndOrIn)

Ответить

Номер ответа: 8
Автор ответа:
 Father



Вопросов: 0
Ответов: 159
  Профиль | | #8 Добавлено: 16.01.09 03:27
Код приведенный fAndOrIn для практического применения не подходит вообще. Он и сам это знает, когда предлагает
отсчитываем каждый пиксель, типа никуда не торопимся
.
Есть ф-ция TrackMouseEvent, если не пугает сабкласинг окна.

Ответить

Номер ответа: 9
Автор ответа:
 Alex



Вопросов: 10
Ответов: 131
  Профиль | | #9 Добавлено: 16.01.09 15:18
Father а пример можно, а то чтото у меня неполучается (((

Ответить

Номер ответа: 10
Автор ответа:
 Father



Вопросов: 0
Ответов: 159
  Профиль | | #10 Добавлено: 16.01.09 18:24
  1. Option Explicit 'Form
  2.  
  3. Public Sub Hover()
  4.     Me.BackColor = vbHighlight
  5. End Sub
  6.  
  7. Public Sub Leave()
  8.     Me.BackColor = vbButtonFace
  9. End Sub
  10.  
  11. Private Sub Form_Load()
  12.     SetProp Me.hwnd, "OBJPTR", ObjPtr(Me)
  13.     SetProp Me.hwnd, "FATHER", SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
  14. End Sub


  1. Option Explicit 'module
  2.  
  3. Public Type TME
  4.   cbSize As Long
  5.   dwFlags As Long
  6.   hwndTrack As Long
  7.   dwHoverTime As Long
  8. End Type
  9.  
  10. Public Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TME) As Long
  11. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  12. Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  13. Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  14. Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
  15. Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  16. Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  17. Public Declare Sub PutMem4 Lib "msvbvm60" (Destination As Any, ByVal Source As Long)
  18.  
  19. Public Const GWL_WNDPROC = (-4)
  20. Public Const WM_DESTROY = &H2
  21. Public Const WM_MOUSEMOVE = &H200
  22. 'Public Const WM_MOUSEHOVER = &H2A1
  23. Public Const WM_MOUSELEAVE = &H2A3
  24. 'Public Const TME_HOVER = &H1
  25. Public Const TME_LEAVE = &H2
  26. 'Public Const TME_NONCLIENT = &H10
  27.  
  28. Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  29.     On Error Resume Next
  30.     Dim frm As Object
  31.     PutMem4 frm, GetProp(hwnd, "OBJPTR")
  32.     Select Case Msg
  33.     Case WM_DESTROY
  34.         RemoveProp hwnd, "BHOVER"
  35.         RemoveProp hwnd, "OBJPTR"
  36.         RemoveProp hwnd, "FATHER"
  37.     Case WM_MOUSEMOVE
  38.         If Not CBool(GetProp(hwnd, "BHOVER")) Then
  39.             Dim tm As TME
  40.             SetProp hwnd, "BHOVER", True
  41.             frm.Hover
  42.             tm.cbSize = LenB(tm)
  43.             tm.hwndTrack = hwnd
  44.             tm.dwFlags = TME_LEAVE
  45.             TrackMouseEvent tm
  46.         End If
  47.     Case WM_MOUSELEAVE
  48.          SetProp hwnd, "BHOVER", False
  49.          frm.Leave
  50.     End Select
  51.     PutMem4 frm, 0&
  52.     WndProc = CallWindowProc(GetProp(hwnd, "FATHER"), hwnd, Msg, wParam, lParam)
  53. End Function

Ответить

Номер ответа: 11
Автор ответа:
 Alex



Вопросов: 10
Ответов: 131
  Профиль | | #11 Добавлено: 16.01.09 20:03
OK спасибо заработало )
+

Ответить

Номер ответа: 12
Автор ответа:
 VβÐ



Вопросов: 15
Ответов: 194
  Web-сайт: www.homacosoft.com
 Профиль | | #12 		Добавлено: 18.01.09 17:37
GetCursorPos, GetWindowRect.

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам