Conversão de cores (RGB para Hexadecimal e vice-versa)

[wmanesco]

Boa tarde pessoal,

Preciso converter cores de RGB para Hexadecimal e vice versa.

Pesquisei e não encontrei nada no harbour relacionado, será que tem?

Alguém já precisou de algo assim?

Agradeço a compreensão

[Kapiaba]

http://erikasarti.net/html/tabela-cores/

Só pra brincar com as cores:

Código: Selecionar todos

*************************************************************************
#Include "Fivewin.ch"
 
//-----------------------------------------------------------------------
Function Main()
 
Private oSay1, oSay2, oSay3, oSay4, oSay5, oSay6
 
 
DEFINE FONT oFONT1 NAME "MS Sans Serif" SIZE   0, -24
 
Define DIALOG oDlg TITLE "Cores - CLIQUE COM O BOTÃO DIREITO DO MOUSE" ;
       FROM 0, 0 to 400, 700 PIXEL COLOR 0, 16777215
 
ACTIVATE DIALOG oDlg ON INIT Inicio() Center
 
Return NIL
 
//----------------------------------------------------------------------------
Function Inicio()
 
   @  20,  22 SAY oSay1 VAR "Cor do Texto:" SIZE 152,  24 PIXEL;
              OF oDlg COLOR 0, 16777215 FONT oFont1
 
 
   @  20, 209 SAY oSay2 VAR "0" SIZE 142,  28 PIXEL;
              OF oDlg COLOR 0, 16777215 FONT oFont1
 
 			  
   @  20, 371 SAY oSay3 VAR RRGB(0) SIZE 200,  28 PIXEL;
              OF oDlg COLOR 0, 16777215 FONT oFont1
 			  
 
   @  80,  20 SAY oSay4 VAR "Cor da Janela:" SIZE 175,  33 PIXEL;
              OF oDlg COLOR 0, 16777215 FONT oFont1
 
 
   @  80, 209 SAY oSay5 VAR "0" SIZE 141,  39 PIXEL;
              OF oDlg COLOR 0, 16777215 FONT oFont1
 
 			  
   @  80, 371 SAY oSay6 VAR RRGB(0) SIZE 200,  39 PIXEL;
              OF oDlg COLOR 0, 16777215 FONT oFont1
 
 
	oDlg:bRClicked := {|nRow, nCol| RPopup( nRow, nCol, oDlg, {oSay1, oSAy2, oSay3, oSay4, oSay5, oSay6} ) }
 			  
Return NIL
//---------------------------------------------------------------------------
function RPopup( nRow, nCol, oDlg, aSays )
Local oMenu
      
   oMenu := MenuPopUp( oDlg, aSays )
   ACTIVATE POPUP oMenu WINDOW oDlg AT nRow, nCol
 
return nil
 
 
//---------------------------------------------------------------------------
Function MenuPopUp( oDlg, aSays )
Local oMenu
Local nClrTxt := oSay1:nClrText
Local nClrDlg := oDlg:nClrPane
 
     Menu oMenu PopUp
             MenuItem "Cor do Texto" Action ( nClrTxt := ChooseColor( nClrTxt ), AplicaCores(oDlg, aSays, nClrTxt, nClrDlg) )
			 MenuItem "Cor da Janela" Action( nClrDlg := ChooseColor( nClrDlg ), AplicaCores(oDlg, aSays, nClrTxt, nClrDlg) )
     endmenu
 
Return oMenu
 
//-------------------------------------------------------------------------------
Function AplicaCores( oDlg, aSays, nClrTxt, nClrDlg )
Local i, cRgbTxt, cRgbDlg
 	 
	oDlg:SetColor( nClrTxt, nClrDlg )
	oDlg:Refresh()
	for i := 1 to 6
        aSays[i]:SetColor( nClrTxt, nClrDlg )
		aSays[i]:Refresh()
    next
 
	cRgbTxt := RRGB( nClrTxt )
    cRgbDlg := RRGB( nClrDlg )
 
    aSays[2]:SetText( nClrTxt )
	aSays[3]:SetText( cRgbTxt )	
	aSays[5]:SetText( nClrDlg )
	aSays[6]:SetText( cRgbDlg )
Return NIL
 
//----------------------------------------------------------------------------
Function RRGB( nCor )
Local cRGB := "{ "+StrZero( nRGBRed( nCor ), 3 )+", "+;
                   StrZero( nRGBGreen( nCor ), 3 )+", "+;
                   StrZero( nRGBBlue( nCor ), 3 )+" }"
 
Return cRGB

*************************************************************************

[Kapiaba]

Brincanco com degrade.

Código: Selecionar todos

**-----------------------------------------------------------------------------------------------------------**
**    Pintar o fundo de uma tela( Dlg,Folder,Wnd)                                                            **
**-----------------------------------------------------------------------------------------------------------**
**    Parametros  : oDlg : Onde vai pintar                                                                   **
**                : Cor1 : Cor incial na parte de cima da tela                                               **
**                : Cor2 : Cor Final  na parte de baixo da tela                                              **
**    Exemplo     : oDlg[1]:bPainted:={|| PCS_Pinta_Tela(oDlg[1],GetSysColor(15),GetSysColor(16) )}               **
**-----------------------------------------------------------------------------------------------------------**
    FUNCTION PCS_Pinta_Tela(oDlgTxt,aCor1,aCor2)
    LOCAL hWnd:=oDlgTxt:hWnd
    LOCAL aRec:=GetClientRect(hWnd)
    LOCAL oBrush,nX,nStp:=(aRec[3]-aRec[1])/2
    LOCAL nColor1:=IF(Empty(aCor1),GetSysColor(15),aCor1)
    LOCAL nColor2:=IF(Empty(aCor2),GetSysColor(15),aCor2)
    LOCAL nColorR1:=nRgbRed(nColor1),nColorG1:=nRgbGreen(nColor1),nColorB1:=nRgbBlue(nColor1)
    LOCAL nColorR2:=nRgbRed(nColor2),nColorG2:=nRgbGreen(nColor2),nColorB2:=nRgbBlue(nColor2)
    LOCAL nSomaR:=ABS(nColorR2-nColorR1),nSomaG:=ABS(nColorG2-nColorG1),nSomaB:=ABS(nColorB2-nColorB1)
    nSomaR:=IIF(nSomaR<0,0,(nSomaR/((aRec[3])/2)))
    nSomaG:=IIF(nSomaG<0,0,(nSomaG/((aRec[3])/2)))
    nSomaB:=IIF(nSomaB<0,0,(nSomaB/((aRec[3])/2)))
    oDlgTxt:GetDC()
    aRec[3]:=0
    FOR nX:=1 TO nStp
        aRec[3]+=2
        DEFINE BRUSH oBrush COLOR nRgb(nColorR1,nColorG1,nColorB1)
        FillRect(oDlgTxt:hDC,aRec,oBrush:hBrush)
        RELEASE BRUSH oBrush
        aRec[1]+=2
        nColorR1:=IIF(nColorR2>=nColorR1,nColorR1+nSomaR,nColorR1-nSomaR)
        nColorG1:=IIF(nColorG2>=nColorG1,nColorG1+nSomaG,nColorG1-nSomaG)
        nColorB1:=IIF(nColorB2>=nColorB1,nColorB1+nSomaB,nColorB1-nSomaB)
    NEXT
    oDlgTxt:ReleaseDC()
    RETURN(NIL)
**-----------------------------------------------------------------------------------------------------------**

[Kapiaba]

Agora, com sua permição, vou misturar os dois:

Código: Selecionar todos

***********************************************************
#include "fivewin.ch"
 
Static nCor1 := 16777215
Static nCor2 := 16777215
 
//----------------------------------------------------------------------------------------------------------
Function Main()
Private oBt1
 
Define dialog oDlg Title "Teste Degrade - CLIQUE COM O BOTÃO DIREITO DO MOUSE" From 0,0 to 400,600 Pixel
 
Activate Dialog oDlg On Init Inicio() ON PAINT PCS_Pinta_Tela() CENTER
 
Return NIL
 
**-----------------------------------------------------------------------------------------------------------**
**    Pintar o fundo de uma tela( Dlg,Folder,Wnd)                                                            **
**-----------------------------------------------------------------------------------------------------------**
**    Parametros  : oDlg : Onde vai pintar                                                                   **
**                : Cor1 : Cor incial na parte de cima da tela                                               **
**                : Cor2 : Cor Final  na parte de baixo da tela                                              **
**    Exemplo     : oDlg[1]:bPainted:={|| PCS_Pinta_Tela(oDlg[1],GetSysColor(15),GetSysColor(16) )}               **
**-----------------------------------------------------------------------------------------------------------**    
FUNCTION PCS_Pinta_Tela()
LOCAL hWnd:=oDlg:hWnd    
LOCAL aRec:=GetClientRect(hWnd)    
LOCAL oBrush,nX,nStp:=(aRec[3]-aRec[1])/2    
LOCAL nColorR1:=nRgbRed(nCor1),nColorG1:=nRgbGreen(nCor1),nColorB1:=nRgbBlue(nCor1)    
LOCAL nColorR2:=nRgbRed(nCor2),nColorG2:=nRgbGreen(nCor2),nColorB2:=nRgbBlue(nCor2)    
LOCAL nSomaR:=ABS(nColorR2-nColorR1),nSomaG:=ABS(nColorG2-nColorG1),nSomaB:=ABS(nColorB2-nColorB1)    
 
nSomaR:=IIF(nSomaR<0,0,(nSomaR/((aRec[3])/2)))    
nSomaG:=IIF(nSomaG<0,0,(nSomaG/((aRec[3])/2)))    
nSomaB:=IIF(nSomaB<0,0,(nSomaB/((aRec[3])/2)))    
oDlg:GetDC()    
aRec[3]:=0    
 
FOR nX:=1 TO nStp        
	aRec[3]+=2        
	DEFINE BRUSH oBrush COLOR nRgb(nColorR1,nColorG1,nColorB1)        
	FillRect(oDlg:hDC,aRec,oBrush:hBrush)        
	RELEASE BRUSH oBrush        
	aRec[1]+=2        
	nColorR1:=IIF(nColorR2>=nColorR1,nColorR1+nSomaR,nColorR1-nSomaR)        
	nColorG1:=IIF(nColorG2>=nColorG1,nColorG1+nSomaG,nColorG1-nSomaG)        
	nColorB1:=IIF(nColorB2>=nColorB1,nColorB1+nSomaB,nColorB1-nSomaB)    
NEXT    
 
oDlg:ReleaseDC()    
RETURN(NIL)
**-----------------------------------------------------------------------------------------------------------**
//----------------------------------------------------------------------------
Function Inicio()
 
	@ 340, 250 Button "Código da Cores" Size 100,20 Pixel;
	Action MsgInfo( "1ª COR = "+Str(nCor1)+" - "+RRgb(nCor1)+CRLF+;
	                "2ª COR = "+Str(nCor2)+" - "+RRgb(nCor2) )
	
	oDlg:bRClicked := {|nRow, nCol| RPopup( nRow, nCol) }
			  
Return NIL
//---------------------------------------------------------------------------
function RPopup( nRow, nCol )
Local oMenu
      
   oMenu := MenuPopUp( oDlg )
   ACTIVATE POPUP oMenu WINDOW oDlg AT nRow, nCol

return nil


//---------------------------------------------------------------------------
Function MenuPopUp()
Local oMenu

     Menu oMenu PopUp
             MenuItem "Primeira Cor" Action ( nCor1 := ChooseColor( nCor1 ), oDlg:Refresh() )
			 MenuItem "Segunda Cor" Action( nCor2 := ChooseColor( nCor2 ), oDlg:Refresh() )
     endmenu

Return oMenu

//----------------------------------------------------------------------------
Function RRGB( nCor )

Local cRGB := "{ "+StrZero( nRGBRed( nCor ), 3 )+", "+;
                   StrZero( nRGBGreen( nCor ), 3 )+", "+;
                   StrZero( nRGBBlue( nCor ), 3 )+" }"

Return cRGB
***********************************************************

[Kapiaba]

Código: Selecionar todos

#include "fivewin.ch"
static oWnd
static nZoom := 2
static oColor
function main()
local oTimer
DEFINE WINDOW oWnd TITLE "Prueba de ventana" MENU mimenu()
DEFINE TIMER oTimer OF oWnd ;
INTERVAL 70 ACTION GetColor()
oTimer:Activate()
ACTIVATE WINDOW oWnd
oTimer:DeActivate()
return nil
function mimenu()
local oMenu
MENU oMenu
MENUITEM "Zoom"
MENU
MENUITEM "1" ACTION ( nZoom := 1 )
MENUITEM "2" ACTION ( nZoom := 2 )
MENUITEM "3" ACTION ( nZoom := 3 )
MENUITEM "4" ACTION ( nZoom := 4 )
MENUITEM "5" ACTION ( nZoom := 5 )
ENDMENU
ENDMENU
return oMenu

function GetColor()
local hDeskTop := GetDC(0)
local a := GetCursorPos()
local nColor := GetPixel( hDeskTop, a[2], a[1] )
local hDC := oWnd:GetDC()
local hPen := CreatePen( PS_SOLID,1,CLR_HRED )
local hOldPen
local nTop, nLeft
local nWidth, nHeight
nTop := 10
nLeft := 100
nWidth := 300
nHeight := 200
SetBkColor( hDC, nColor )
TextOut( hDC, 10, 10, " " )
TextOut( hDC, 25, 10, " " )
TextOut( hDC, 40, 10, " " )
TextOut( hDC, 60, 10, " " + corTOrgb( nColor ) + " " )
Moveto( hDC, nLeft-1, nTop-1)
Lineto( hDC, nLeft + nWidth+1, nTop-1 )
Lineto( hDC, nLeft + nWidth+1, nTop+nHeight+1 )
Lineto( hDC, nLeft -1, nTop+nHeight+1 )
Lineto( hDC, nLeft-1, nTop-1)
StretchBlt( hDC, nLeft, nTop, nWidth, nHeight, hDeskTop, a[2]-(nWidth/(nZoom*2)), a[1]-(nHeight/(2*nZoom)), nWidth/nZoom, nHeight/nZoom, 13369376 )
hOldPen := SelectObject( hDC, hPen )
Moveto( hDC, nLeft+nWidth/2+1, nTop-1 )
Lineto( hDC, nLeft+nWidth/2+1, nTop+nHeight+1 )
Moveto( hDC, nLeft+1, nTop+nHeight/2+1 )
Lineto( hDC, nLeft+nWidth+1, nTop+nHeight/2+1 )
SelectObject( hDC, hOldPen )
DeleteObject( hPen )
oWnd:ReleaseDC()
ReleaseDC( 0, hDeskTop )
return nil
*****************
function corTOrgb( Cor1 )
*****************
local Cor2, Cor3
Cor3 := int(Cor1 / 65536)
Cor2 := int( ( Cor1 - ( Cor3 * 65536 ) ) / 256 )
Cor1 := Cor1 - ( Cor3 * 65536 ) - ( Cor2 * 256 )
return strzero(Cor1,3) + "," + strzero(Cor2,3) + "," + strzero(Cor3,3)
#pragma BEGINDUMP
#include "windows.h"
#include "hbapi.h"
HB_FUNC( STRETCHBLT )
{
hb_retl( StretchBlt( (HDC) hb_parnl( 1 ) ,
hb_parni( 2 ) ,
hb_parni( 3 ) ,
hb_parni( 4 ) ,
hb_parni( 5 ) ,
(HDC) hb_parnl( 6 ) ,
hb_parni( 7 ) ,
hb_parni( 8 ) ,
hb_parni( 9 ) ,
hb_parni( 10 ) ,
(DWORD) hb_parnl( 11 )
) ) ;
}

#pragma ENDDUMP

[wmanesco]

Vou dar uma estudada nestes exemplos, obrigado!!

[JoséQuintas]

Não sei se responde sua pergunta:

Código: Selecionar todos

hbmk2 -find rgb
hbwin.hbc (installed):
   wapi_RGB()

hbmk2 -find hex
Harbour core (installed):
   hb_HexToNum()
   hb_HexToStr()
   hb_NumToHex()
   hb_StrToHex()

[wmanesco]

Perfeito, obrigado!

[Adalberto]

Maestro JoseQuintas, buenas tardes

Se que este es un tema de 2016 pero estoy con el mismo problema, al compilar me dice que NO encuentra la funcion WAPI_RGB y no se como resolverlo, estoy usando Harbour 3.2 nightly

Por favor ayúdeme con este tema, ya estoy varios días con este problema y no encuentro solución, desde ya le agradezco de corazón la ayuda que me pueda proporcionar

Con atención,

Adalberto

[Itamar M. Lins Jr.]

Olá!
Adicione a lib hbwin.hbc ao seu projeto.

O hbmk2.exe avisa inclusive se está faltando.

Saudações,
Itamar M. Lins Jr.

[Adalberto]

Itamar, buenas tardes.
Muy agradecido por tu pronta respuesta, el script que utilizo es el siguiente:

Código: Selecionar todos

-oEnin
-inc
-compr=max
-quiet
-lxhb
-lhbwin
-lhbct
-strip
-w0
*.prg
*.c
#
Icono.Rc
gtwvg.hbc
hbwin.hbc
hbtest.hbc
xhb.hbc

Y NO he tenido suerte, sigue dando el mismo error, no encuentra la funcion WAPI_RGB, que otra instrucción me falta?

Aguardo vuestra ayuda.

Adalberto

[alxsts]

Olá!

Se você está usando Harbour 3.2, troque wapi_RGB() por WIN_RGB.

A função wapi_RGB() pertence ao Harbour 3.4.

No arquivo hbwin.ch do Harbour 3.2, existe a definição da função:

Código: Selecionar todos

#define WIN_RGB( nR, nG, nB )              ( nR + ( nG * 256 ) + ( nB * 256 * 256 ) )

Verifique se você tem esta linha no teu arquivo hbwin.ch. Se a linha existir e você preferir usar wapi_RGB(), pode adicionar no teu hbwin.ch ou no teu programa fonte, a linha:

Código: Selecionar todos

#define WAPI_RGB( nR, nG, nB )              ( nR + ( nG * 256 ) + ( nB * 256 * 256 ) )

[alxsts]

Olá!

Em tempo:

outra opção é criar e utilizar a tua própria função:

Código: Selecionar todos

FUNCTION MyRGB( nR, nG, nB )

RETURN ( nR + ( nG * 256 ) + ( nB * 256 * 256 ) )

Desta forma, ficará independente da versão do Harbour e do arquivo hbwin.ch...

[Adalberto]

Alexander, Itamar

Buenas noches y muchas gracias por la ayuda, oportuna y eficaz; funcionó de maravilla

Un grande abrazo desde Bolivia y mi agradecimiento sincero.

Adalberto