Teste de Degrade: Código de Colores.

Teste de Degrade: Código de Colores.

Postby karinha » Thu Dec 02, 2021 2:01 pm

Teste de Degrade: Código de Colores. Excelente!!

Code: Select all  Expand view

#Include "FiveWin.ch"

STATIC nCor1 := 16777215
STATIC nCor2 := 16777215
STATIC oDlg

FUNCTION Main()

   LOCAL cTitle

   SkinButtons()

   cTitle := OemToAnsi( "Teste Degrade: Click con el Botton Derecho del Mouse" )

   DEFINE DIALOG oDlg TITLE cTitle FROM 0, 0 TO 400, 600 PIXEL

   oDlg:lHelpIcon := .F.

   ACTIVATE DIALOG oDlg CENTERED   ;
      ON INIT( Inicio() )          ;
      ON PAINT( PCS_Pinta_Tela() )

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 de Colores" SIZE 150, 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 2007

      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 )

// FIN / END
 


Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7446
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 151 guests