Solo basta con ejecutar este código, situar el mouse sobre el color que nos interese para ver el codigo en RGB (nRojo,nVerde, nAzul) que deberemos usar, o también el Hexagecimal para usarlo en codigo HTML.
Public oForm
oForm=Newobject("Toma_Color")
oForm.Show(1)
Return
Define Class Toma_Color As Form
Height = 30
Width = 350
ShowWindow = 2
DoCreate = .T.
AutoCenter = .T.
BorderStyle = 2
Caption = "Toma-Color "
ControlBox = .T.
Closable = .T.
HalfHeightCaption = .T.
MaxButton = .F.
MinButton = .F.
ClipControls = .F.
TitleBar = 1
AlwaysOnTop = .T.
Name = "Frm_Toma_Color"
Add Object ColorHex As TextBox With ;
Height = 25, ;
Left = 33, ;
Top = 2, ;
Width = 108, ;
Name = "ColorHex"
Add Object timer1 As Timer With ;
Top = 3, ;
Left = 3, ;
Height = 23, ;
Width = 23, ;
Interval = 500, ;
Name = "Timer1"
Add Object shape1 As Shape With ;
Top = 2, ;
Left = 3, ;
Height = 24, ;
Width = 24, ;
Name = "Shape1"
Add Object lrojo As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
BackStyle = 0, ;
Caption = "R", ;
Height = 17, ;
Left = 158, ;
Top = 6, ;
Width = 10, ;
Name = "lRojo"
Add Object lverde As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
BackStyle = 0, ;
Caption = "G", ;
Height = 17, ;
Left = 226, ;
Top = 6, ;
Width = 10, ;
Name = "lVerde"
Add Object lazul As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
BackStyle = 0, ;
Caption = "B", ;
Height = 17, ;
Left = 294, ;
Top = 6, ;
Width = 10, ;
Name = "lAzul"
Add Object larojo As Label With ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "#", ;
Height = 17, ;
Left = 149, ;
Top = 6, ;
Width = 9, ;
ForeColor = Rgb(255,0,0), ;
Name = "larojo"
Add Object laverde As Label With ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "#", ;
Height = 17, ;
Left = 216, ;
Top = 6, ;
Width = 9, ;
ForeColor = Rgb(0,255,0), ;
Name = "laVerde"
Add Object laazul As Label With ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "#", ;
Height = 17, ;
Left = 284, ;
Top = 6, ;
Width = 9, ;
ForeColor = Rgb(0,0,255), ;
Name = "laAzul"
Add Object color_r As TextBox With ;
Format = "LK", ;
Height = 23, ;
InputMask = "999", ;
Left = 168, ;
Top = 3, ;
Width = 41, ;
Name = "Color_R"
Add Object color_g As TextBox With ;
Format = "LK", ;
Height = 23, ;
InputMask = "999", ;
Left = 238, ;
Top = 3, ;
Width = 41, ;
Name = "Color_G"
Add Object color_b As TextBox With ;
Format = "LK", ;
Height = 23, ;
InputMask = "999", ;
Left = 305, ;
Top = 3, ;
Width = 41, ;
Name = "Color_B"
Procedure buf2word
Lparameters cBuffer
Return Asc(Substr(cBuffer, 1,1)) +;
BitLShift(Asc(Substr(cBuffer, 2,1)), 8)+;
BitLShift(Asc(Substr(cBuffer, 3,1)), 16)+;
BitLShift(Asc(Substr(cBuffer, 4,1)), 24)
Endproc
Procedure convertir_color
* Funcion Tomada de http://www.portalfox.com/article.php?sid=534
* Enviada Por Luis Maria Guayan
* Adaptada Para Obtener el Color en Hexagecimal
* o la cantidad de Rojo, verde o Azul
Lparameters nColor, nNumero
Local cResult, nCiclo
cResult= "#"
For nCiclo= 1 To 3
cResult= cResult+ Right(Transform(nColor%256,alltrim(" @0")),2)
If nCiclo = nNumero
Return (nColor %256)
Endif
nColor = Int(nColor/256)
Endfor
Return cResult
Endproc
Procedure Load
Declare Long GetWindowDC In "user32" Long nHandle
Declare Long GetPixel In "gdi32" Long hdc, Long nX, Long nY
Declare Long GetCursorPos In "user32" String @cPuntero
Declare Long GetDesktopWindow In "user32"
Local cPos As String
cPos= Space(20)
GetCursorPos(@cPos)
With This
.AddProperty('hdc',GetWindowDC(GetDesktopWindow()))
.AddProperty('nX',0)
.AddProperty('nY',0)
.nX=This.buf2word(Substr(cPos,1,4))
.nY=This.buf2word(Substr(cPos,5,4))
Endwith
Endproc
Procedure timer1.Timer
Local cPos, nColor
cPos =Space(20)
GetCursorPos(@cPos)
With Thisform
.nX=.buf2word(Substr(cPos,1,4))
.nY=.buf2word(Substr(cPos,5,4))
nColor= GetPixel(.hdc,.nX,.nY)
.shape1.BackColor = nColor
.ColorHex.Value = .convertir_color(nColor,0)
.color_r.Value = .convertir_color(nColor,1)
.color_g.Value = .convertir_color(nColor,2)
.color_b.Value = .convertir_color(nColor,3)
Endwith
Endproc
Enddefine
Saludos.
Jorge Mota, Guatemala
