Не юзай MouseMove, юзай GetCursorPos!

Ответить

А где этот GetCursorPos и как им пользоваться?

Ответить

А где этот GetCursorPos и как им пользоваться?

Ответить

Этот пример конечно не притиндует на то чтобы

называться идеальным но у меня работает нормально.

/пример:

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.ForeColor = QBColor(9)  / QBColor = от 0 (чёрн.) до 15 (бел.)
Label1.FontBold = True

End Sub

/реакция на выход за пределы Label

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.ForeColor = QBColor(0)
Label1.FontBold = False

End Sub

Ответить

А как по мне, так лучше бы с GetCursorPos...(это такая апи функция)

Ответить

Держи, специально для тебя сделал.

'''Модуль класса (Class1)
Private WithEvents DemoLabel As Label
Property Let MkEqu(DemoLabel2 As Object)
Set DemoLabel = DemoLabel2
End Property

Sub DemoLabel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Form1.GetIndex DemoLabel.Name
End Sub

'''Модуль формы
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXBORDER = 5
Private Const SM_CYBORDER = 6
Private Const SM_CYCAPTION = 4

Private MyLabel(4) As VB.Label
Dim LabelEvent(4) As New Class1

Private Sub Form_Load()
For CreateLabels = 0 To 4
 Set MyLabel(CreateLabels) = Me.Controls.Add("VB.Label", "Label" & LTrim(Str(CreateLabels + 1)), Me)
 MyLabel(CreateLabels).Visible = True
 MyLabel(CreateLabels).Caption = "CustomLabel-" & LTrim(Str(CreateLabels + 1))
 MyLabel(CreateLabels).AutoSize = True
 MyLabel(CreateLabels).Left = (ScaleWidth / 2) - (MyLabel(CreateLabels).Width / 2)
 If CreateLabels > 0 Then MyLabel(CreateLabels).Top = MyLabel(CreateLabels - 1).Top + MyLabel(CreateLabels - 1).Height + (3 * Screen.TwipsPerPixelY) Else MyLabel(CreateLabels).Top = 10 * Screen.TwipsPerPixelY
 LabelEvent(CreateLabels).MkEqu = MyLabel(CreateLabels)
Next CreateLabels
End Sub

Private Sub Timer1_Timer()
TitleHeight = GetSystemMetrics(SM_CYCAPTION) + 2
MeBorderWidth = GetSystemMetrics(SM_CXBORDER)
MeBorderHeight = GetSystemMetrics(SM_CYBORDER)

CurrentIndex = Val(Timer1.Tag)
Dim CursorPoint As POINTAPI
Call GetCursorPos(CursorPoint)

TPY = Screen.TwipsPerPixelY: LPX = Screen.TwipsPerPixelX

LabelLeft = 1 + MeBorderWidth + (Me.Left + MyLabel(CurrentIndex).Left) / LPX
LabelTop = MeBorderHeight + TitleHeight + ((Me.Top + MyLabel(CurrentIndex).Top) / TPY)
LabelRight = LabelLeft + (MyLabel(CurrentIndex).Width) / LPX
LabelBottom = LabelTop + (MyLabel(CurrentIndex).Height / TPY)

If CursorPoint.X < LabelLeft Or CursorPoint.X > LabelRight Or CursorPoint.Y < LabelTop Or CursorPoint.Y > LabelBottom Then
 Timer1.Interval = 0: Timer1.Tag = -1
 ClearSelection
 MousePointer = 0
End If
End Sub
Sub GetIndex(LabelName As String)
For GetLblIndex = 0 To 4
 If MyLabel(GetLblIndex).Name = LabelName Then Exit For
Next GetLblIndex
If Timer1.Tag <> GetLblIndex Then
 ClearSelection
 MyLabel(GetLblIndex).BackColor = QBColor(1): MyLabel(GetLblIndex).ForeColor = QBColor(15)
 Timer1.Tag = GetLblIndex
 Timer1.Interval = 10
 MousePointer = 14
End If

End Sub
Sub ClearSelection()
 For ClearAll = 0 To 4
  MyLabel(ClearAll).BackColor = Me.BackColor
  MyLabel(ClearAll).ForeColor = Me.ForeColor
 Next ClearAll
End Sub

Ответить

2  CyRax: Вот наворотил! спасибо!

Да и ваще всем спасибо, что ламаков(вроде меня :--) не пинаете, щас все способы попробую, о результатах сообщу

Ответить

Попрбовал....
Вариант CyRax'a Работает  и выглядит прикольно, но мне неохота копаться в своей проге, чтоб этот код туда всунуть, да и времени нет.

Остановился на варианте, который предложил &&&&M-простой как три копейки, вписать в мою прогу-дело пяти секунд, заменил Label1.ForeColor на Label1.BackColor  и получил то, что нужно!

З.Ы. Ещё раз всем спасибо!

Ответить

Ничего дружище, я всё равно её на сайт отослал.

Не тебе, так кому-нибудь другому пригодится

Ответить