Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function OleTranslateColor Lib "olepro32.dll" _
(ByVal OLE_COLOR As Long, _
ByVal HPALETTE As Long, _
pccolorref As Long) As Long
Private Sub Form_Load()
With Command1
.Caption = "Select Colour"
End With
With Label1
.AutoSize = True
.Caption = ""
.WordWrap = True
.Move 200, 200, Form1.ScaleWidth - 400
.Caption = "Select any colour from the common " & _
"colour dialog. This label background " & _
"and left picturebox will take on the " & _
"selected colour, while the label's text " & _
"and right picturebox will display " & _
"the inverse of the selection."
.AutoSize = True
End With
End Sub
Private Sub Command1_Click()
With CommonDialog1
.ShowColor
Label1.BackColor = .Color
Label1.ForeColor = InverseRGB(.Color)
Picture1.BackColor = .Color
Picture2.BackColor = InverseRGB(.Color)
End With
End Sub
Public Function InverseRGB(ByVal col As Long) As Long
Const Inverse As Long = &HFFFFFF
InverseRGB = GetClrrefFromOLEColour(col) Xor Inverse
End Function
Private Function GetClrrefFromOLEColour(ByVal dwOleColour As Long) As Long
'pass a colour, and return the colour
'with the system bit stripped if present
OleTranslateColor dwOleColour, 0, GetClrrefFromOLEColour
End Function |