VBNet - Форум - Подсветить Label в проекте VB

Вопрос: Подсветить Label в проекте VB Добавлено: 22.07.06 17:19

Автор вопроса: Stas

Привет всем!
Я в программировании человек новый, и у меня появилась небольшая проблема:
Требуется подсветить надпись в форме, я попробовал сделать это так:
'Private Sub lblEx_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'If X > 2400 And X < 3375 And Y > 3600 And Y < 3855 Then
' lblEx.Font.Underline = True
' lblEx.ForeColor = &HFF0000
'Else
' lblEx.Font.Underline = False
' lblEx.ForeColor = &H0&
'End If
'End Sub
но при быстрой проводке мыши надпись загорается но не гаснет, либо не загорается вообще.
А другого способа придумать не могу... HELP
Ответить

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

Номер ответа: 1 Автор ответа: Sacred Phoenix ICQ: 304238252 Вопросов: 52 Ответов: 927	Профиль \| \| #1	Добавлено: 22.07.06 17:29
	обрабатывай Form_MouseMove, в котором "гаси" свою надпись. Она не загорается вообще, потому что курсор при быстром движении просто не попадает на надпись. Ответить

Номер ответа: 2 Автор ответа: Stas Вопросов: 2 Ответов: 2	Профиль \| \| #2	Добавлено: 22.07.06 17:52
	Пробовал и так, но эффект такой же, т.е. иногда надпись не загорается, а другого способа нет? Мне кажется, что это не очень эфективно... Почему-то Ответить

Номер ответа: 3 Автор ответа: gvozd Разработчик Offline Client Вопросов: 164 Ответов: 1317	Web-сайт: www.gvozdsoft.com Профиль \| \| #3	Добавлено: 22.07.06 18:01
	Private Type POINTAPI X As Long Y As Long End Type Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Function isMouseOver(hwnd As Long) As Boolean im pt As POINTAPI GetCursorPos pt isMouseOver = (WindowFromPoint(pt.X, pt.Y) = hwnd) End Function Ответить

Номер ответа: 4 Автор ответа: Stas Вопросов: 2 Ответов: 2	Профиль \| \| #4	Добавлено: 22.07.06 18:15
	А кто объяснит как это привязать, или хотя-бы где проставлять значения? Ответить

Номер ответа: 5 Автор ответа: Sacred Phoenix ICQ: 304238252 Вопросов: 52 Ответов: 927	Профиль \| \| #5	Добавлено: 22.07.06 18:58
	2 gvozd: у лейблов нет св-ва .hwnd! 2 Stas: т.е. иногда надпись не загорается если объект находится на траектории движения мышки, то это совсем не значит, что курсор попадёт на объект, мышка как бы проскочит объект и всё. Мне кажется, что это не очень эфективно что понимается под словом "эффективно"? Ответить

Номер ответа: 6 Автор ответа: gvozd Разработчик Offline Client Вопросов: 164 Ответов: 1317	Web-сайт: www.gvozdsoft.com Профиль \| \| #6	Добавлено: 22.07.06 19:48
	А, да... Точно... Ответить

Номер ответа: 7 Автор ответа: Серёга ICQ: 262809473 Вопросов: 17 Ответов: 561	Web-сайт: houselab.narod.ru Профиль \| \| #7	Добавлено: 22.07.06 23:24
	Закинь на форму Timer с интервалом примерно 50, Label1 и добавь этот код: Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type POINTAPI x As Long y As Long End Type Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) Private Declare Sub GetCursorPos Lib "user32" (lpPoint As POINTAPI) Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) Private Function MouseOver(AnyLabel As Label, Parent As Form) As Boolean Dim R As RECT, SM As Integer, CP As POINTAPI, CW As POINTAPI MouseOver = False SM = Parent.ScaleMode If SM <> 3 Then Parent.ScaleMode = 3 GetClientRect Parent.hWnd, R CW.x = R.Left CW.y = R.Top ClientToScreen Parent.hWnd, CW OffsetRect R, CW.x, CW.y GetCursorPos CP If CP.x > R.Left + AnyLabel.Left And CP.x < R.Left + AnyLabel.Left + AnyLabel.Width Then If CP.y > R.Top + AnyLabel.Top And CP.y < R.Top + AnyLabel.Top + AnyLabel.Height Then MouseOver = True ': MsgBox "super" End If If SM <> 3 Then Parent.ScaleMode = SM End Function Private Sub Timer1_Timer() If MouseOver(Label1, Me) Then Label1.ForeColor = vbRed Else Label1.ForeColor = vbBlue End Sub Ответить

Номер ответа: 8 Автор ответа: Серёга ICQ: 262809473 Вопросов: 17 Ответов: 561	Web-сайт: houselab.narod.ru Профиль \| \| #8	Добавлено: 22.07.06 23:28
	На MsgBox не обращай внимания - это я убрать забыл ))))))))))) Ответить

Номер ответа: 9 Автор ответа: Sacred Phoenix ICQ: 304238252 Вопросов: 52 Ответов: 927	Профиль \| \| #9	Добавлено: 22.07.06 23:37
	Блин, ну накой здесь API, если всё решается двумя процедурами lblEx_MouseMove и Form_MouseMove?????? Ответить

Номер ответа: 10 Автор ответа: Серёга ICQ: 262809473 Вопросов: 17 Ответов: 561	Web-сайт: houselab.narod.ru Профиль \| \| #10	Добавлено: 23.07.06 01:48
	Блин, ну накой здесь API? Form_MouseMove - это хорошо, когда у тебя есть форма, а посередине этой формы одиноко торчит Label. А если у тебя на форме контролов "до едрени фени" и границы между ними чисто символические и юзер дергает мышу, как угорелый, то мыша просто будет проскакивать через эти границы. Вот и жди когда же оно наступит это событие Form_MouseMove. Так что лучше использовать мой код. Ты уж мне поверь, я сам, когда юзерконтролы писать не умел - тоже такой фигней занимался. Ответить

Номер ответа: 11 Автор ответа: Sharp Лидер форума ICQ: 216865379 Вопросов: 106 Ответов: 9979	Web-сайт: sharpc.livejournal.com Профиль \| \| #11	Добавлено: 23.07.06 14:01
	Форма Dim tme As T_TRACKMOUSEEVENT Dim Drawing As Boolean Private Sub Form_Initialize() oldWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc) tme.cbSize = LenB(tme) tme.dwFlags = TME_LEAVE tme.hwndTrack = Me.hwnd tme.dwHoverTime = HOVER_DEFAULT TrackMouseEvent tme End Sub Private Sub Form_Load() state = BS_OUT Me.Show Me.Refresh End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If IsInRect(X, Y, 10, 10, 300, 42) Then If state <> BS_DOWN Then state = BS_DOWN PaintIt End If End If End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) TrackMouseEvent tme If IsInRect(X, Y, 10, 10, 300, 42) Then If state <> BS_OVER Then state = BS_OVER PaintIt End If Else If state <> BS_OUT Then state = BS_OUT PaintIt End If End If End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If state = BS_DOWN Then state = IIf(IsInRect(X, Y, 10, 10, 300, 42), BS_OVER, BS_OUT) PaintIt End If End Sub Private Sub Form_Paint() If Not Drawing Then PaintIt End If End Sub Private Sub Form_Terminate() SetWindowLong Me.hwnd, GWL_WNDPROC, oldWndProc End Sub Private Sub Timer1_Timer() PaintIt End Sub Private Function grad(r1, g1, b1, r2, g2, b2, perc) grad = RGB(r1 + (r2 - r1) * perc, g1 + (g2 - g1) * perc, b1 + (b2 - b1) * perc) End Function Private Sub PaintIt() rawing = True If Timer1.Interval <> 0 Then Timer1.Interval = 0 c = RGB(172, 168, 153) Line (11, 10)-(300, 10), c Line (10, 11)-(10, 42), c Line (300, 11)-(300, 42), c Line (11, 42)-(300, 42), c If state = BS_OVER Then Line (11, 11)-(299, 41), RGB(226, 231, 233), BF ElseIf state = BS_DOWN Then Line (11, 11)-(299, 41), RGB(53, 115, 214), BF ElseIf state = BS_OUT Then For i = 1 To 31 Line (11, 10 + i)-(300, 10 + i), grad(254, 254, 253, 237, 234, 217, i / 31) Next End If Me.CurrentX = 50 + IIf(state = BS_DOWN, 1, 0) Me.CurrentY = 19 + IIf(state = BS_DOWN, 1, 0) Print "Hello, world!" PaintPicture Picture1.Picture, _ 14 + IIf(state = BS_DOWN, 1, 0), _ 14 + IIf(state = BS_DOWN, 1, 0) rawing = False End Sub Private Function IsInRect(X, Y, x1, y1, x2, y2) As Boolean IsInRect = (X > x1 And X < x2 And Y > y1 And Y < y2) End Function Модуль Public Const GWL_WNDPROC As Long = -4 Public Const TME_LEAVE As Long = &H2 Public Const WM_MOUSELEAVE As Long = &H2A3 Public Const HOVER_DEFAULT As Long = &HFFFFFFFF Public Const MB_ICONHAND As Long = &H10& Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function TrackMouseEvent Lib "user32.dll" (ByRef lpEventTrack As T_TRACKMOUSEEVENT) As Long Public Declare Function DefWindowProc Lib "user32.dll" Alias "efWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function MessageBeep Lib "user32.dll" (ByVal wType As Long) As Long Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByVal lpRect As Any, ByVal bErase As Long) As Long 'typedef struct tagTRACKMOUSEEVENT { ' WORD cbSize; ' WORD dwFlags; ' HWND hwndTrack; ' WORD dwHoverTime; '} TRACKMOUSEEVENT, *LPTRACKMOUSEEVENT; Public Type T_TRACKMOUSEEVENT cbSize As Long dwFlags As Long hwndTrack As Long dwHoverTime As Long End Type Public oldWndProc As Long Public Enum ButtonState BS_OUT = 1 BS_OVER = 2 BS_DOWN = 3 End Enum Public state As ButtonState Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long WndProc = 0 Select Case uMsg Case WM_MOUSELEAVE: state = BS_OUT Form1.Timer1.Interval = 10 Case Else: WndProc = CallWindowProc(oldWndProc, hwnd, uMsg, wParam, lParam) End Select End Function Не особо красиво, но работает Ответить

Номер ответа: 12 Автор ответа: Серёга ICQ: 262809473 Вопросов: 17 Ответов: 561	Web-сайт: houselab.narod.ru Профиль \| \| #12	Добавлено: 23.07.06 15:12
	Не особо красиво, но работает Да нормально Только настраивать долго. Ответить

Номер ответа: 13 Автор ответа: LamerOnLine ICQ: 334781088 Вопросов: 108 Ответов: 2822	Профиль \| \| #13	Добавлено: 24.07.06 10:03
	ИМХО, Static + MouseHover + MouseLeave... Ответить

Страница: 1 |