Change colour with mousemove

[adamsm]

Hi anyone,

How could I make the folowing code to change colour with mouse move?

Private Sub Rectangle17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.Rectangle17.BackColor = RGB(149, 28, 2) 'orange
End Sub

Any help on this would be kindly appreciated.

 

[Domenic]

As per the Developer Reference or help file...

"The MouseMove event applies to forms, controls on a form, and labels."

 

[adamsm]

Thanks for the reply & help.

 

[mikerickson]

Change color with mousemove. Perhaps putting something like this the code module for a userform with a label will work?

Dim MouseOff As Boolean

Private Sub Label1_Click()
    MouseOff = Not MouseOff
End Sub

Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim localX As Double, localY As Double
    Dim colorValue As Double, rV As Double, gV As Double, bV As Double
    If Not MouseOff Then
        With Label1
            localX = x / .Width - 1 / 2
            localY = y / .Height - 1 / 2
            colorValue = RGBfromXY(localX, localY, rV, gV, bV)
            .BackColor = colorValue
            .BorderColor = .BackColor
        End With
    
        Me.Caption = "RGB(" & Int(rV) & ", " & Int(gV) & ", " & Int(bV) & ")"
    End If
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    MouseOff = False
End Sub

Private Sub UserForm_Initialize()
    With Label1
        .BorderColor = RGB(255, 255, 255)
        .BackColor = RGB(0, 0, 0)
        .BorderStyle = fmBorderStyleSingle
        .Caption = vbNullString
        .Width = 200
        .Height = .Width
    End With
End Sub

Function RGBfromXY(xVal As Double, yVal As Double, Optional rV As Double, Optional gV As Double, Optional bV As Double) As Double
    Dim Radius As Double, Angle As Double
    Radius = (xVal ^ 2 + yVal ^ 2) ^ 0.5
    If Radius > 1 Then Radius = 1
    If xVal <> 0 Then
        Angle = Atn(yVal / xVal) / Application.Pi() * 180
        If xVal < 0 Then Angle = Angle + 180
    ElseIf yVal > 0 Then
        Angle = 90
    Else
        Angle = 270
    End If
    If Angle < 0 Then Angle = Angle + 360
    RGBfromXY = RGBfromRTheta(Radius, Angle, rV, gV, bV)
End Function
 
Function RGBfromRTheta(Radius As Double, theta As Double, Optional ByRef RValue, Optional ByRef GValue, Optional ByRef BValue)
    Rem 0<=radius<=1, 0<=theta<=360
    Dim baseR As Double, baseG As Double, baseB As Double
    Dim antiR As Double, antiG As Double, antiB As Double
    Dim temp As Double
     
    temp = RGBfromDegree(theta, baseR, baseG, baseB)
    temp = RGBfromDegree(180 + theta, antiR, antiG, antiB)
     
    antiR = (1 - Radius) * antiR
    antiG = (1 - Radius) * antiG
    antiB = (1 - Radius) * antiB
    
    RValue = 255 * (baseR + antiR)
    GValue = 255 * (baseG + antiG)
    BValue = 255 * (baseB + antiB)
     
    RGBfromRTheta = RGB(RValue, GValue, BValue)
End Function
 
Function RGBfromDegree(Angle As Double, ByRef Rval As Double, ByRef Gval As Double, ByRef Bval As Double) As Double
    Do Until Angle > 0
        Angle = Angle + 360
    Loop
    Angle = Angle Mod 360
    Select Case Angle
    Case Is <= 60
        Rval = 1
        Gval = Angle / 60
    Case Is <= 120
        Gval = 1
        Rval = (120 - Angle) / 60
    Case Is < 180
        Gval = 1
        Bval = (Angle - 120) / 60
    Case Is <= 240
        Bval = 1
        Gval = (240 - Angle) / 60
    Case Is <= 300
        Bval = 1
        Rval = (Angle - 240) / 60
    Case Else
        Rval = 1
        Bval = (360 - Angle) / 60
    End Select
    RGBfromDegree = RGB(255 * Rval, 255 * Gval, 255 * Bval)
End Function

 

[adamsm]

Thanks for the help. I do really appreciate your help.