29 de mayo de 2003

Conocer el Codigo RGB y Hexagecimal de un color de algún punto de la pantalla

Este Ejemplo muestra la forma como podemos obtener el codigo Rgb de ese color que nos gusta de X Aplicacion.

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

No hay comentarios. :

Publicar un comentario