Diseño Ribon

[jgabri]

Hola

Se podría realizar un diseño de la ribon, como la imagen ?



Existe algún estilo de la ribon parecido a la imagen !!!

Un saludo y mil gracias

fwh 19.05

[leandro]

ribbon.prg

Code: Select all  Expand view

#include "fivewin.ch"
#include "ribbon.ch"
#include "xbrowse.ch"

static nIndex := 1
static nAvance := 1

static  aBmp := {}
static aResources := {}

function main()

   local oRBar
   local oWnd, oMenu
   local oGr, oGr1, oGr2, oGr3, oGr4
   local oBtn,   oBtn1,  oBtn2,  oBtn3,  oBtn4, oBtn5
   local oBtn6,  oBtn7,  oBtn8,  oBtn9,  oBtn10
   local oBtn11, oBtn12, oBtn13, oBtn14, oBtn15
   local oBtn16, oBtn17, oBtn18, oBtn19, oBtn20
   local oBtn21, oBtn22, oBtn23, oBtn24, oBtn25
   local oBtn26, oBtn27, oBtn28, oBtn29, oBtn30
   local oBtn31, oBtn32, oBtn33, oBtn34, oBtn35
   local oSay1, oChk1, lVal1 := .T.
   local oTBtn0, oTBtn1, oTBtn2, oTBtn3
   local aClrMenu1 := { { 0.5, RGB( 69, 124, 188 ), RGB( 41, 93, 171 ) }, ;
                       { 0.5, RGB( 26, 64, 136 ), RGB( 56, 135, 191 ) } }
   local aClrMenu2 := { { 0.5, RGB( 123, 178, 236 ), RGB( 71, 126, 205 ) }, ;
                       { 0.5, RGB( 17, 78, 175 ), RGB( 128, 225, 255 ) } }

   MENU oMenu POPUP 2007
      MENUITEM "Style Set" FILE "..\bitmaps\styleset161.BMP"
      MENUITEM "Colors"
      MENUITEM "Font"
   ENDMENU

   DEFINE WINDOW oWnd TITLE "RibbonBar Test " + FWVERSION from 1,1 to 600,600 pixel //brush oBrush1
   
   DEFINE RIBBONBAR oRBar WINDOW oWnd PROMPT "Configuración", "Ficheros", "Informes", "Ayudas" HEIGHT 133 TOPMARGIN 25
   
   BackStage( oRBar )
   
   oRBar:nLeftMargin = 75
   oRBar:CalcPos()

   oTBtn0 = TRBtn():New( 4, 0, 70, 20, "..\bitmaps\rbnmenu.bmp", { || oRBar:BackStage() /* oRBar:KeybMode() */ }, oRBar,;
                         ,,,,,, .T., .T.,,,,,, "POPUP", oMenu,,,,,,,,,,,,, aClrMenu1, nRGB( 125, 172, 215 ),;
                         nRGB( 65, 106, 189 ) )
   oTBtn0:aClrGradOver = { || aClrMenu2 }
   oTBtn0:aClrGradBack = aClrMenu2
   oTBtn0:bClrGradSubOver = { || aClrMenu2 }
                         
   oTBtn1 = TRBtn():New( 4, 410,,, "..\bitmaps\16x16\new2.bmp", {|| TestRes() }, oRBar )

   oTBtn2 = TRBtn():New( 4, 435,,, "..\bitmaps\16x16\open2.bmp", {|| MsgInfo( "open" ) }, oRBar )

   oTBtn3 = TRBtn():New( 4, 460,,, "..\bitmaps\16x16\exit2.bmp", {|| oWnd:End() }, oRBar )

   ADD GROUP oGr RIBBON oRBar TO OPTION 1 PROMPT "Clipboard" width 130 //BITMAP "..\bitmap\fivetech.BMP"
   
   ADD GROUP oGr1 RIBBON oRBar TO OPTION 1 PROMPT "Font" WIDTH 205 GRADIANT { { 0.23, RGB( 218, 229, 243 ), RGB( 174, 150, 169 ) }, { 0.77, RGB( 174, 150, 169 ), RGB( 218, 229, 243 ) } }
   
   ADD GROUP oGr2 RIBBON oRBar TO OPTION 1 PROMPT "Paragraph" WIDTH 215
   
   ADD GROUP oGr3 RIBBON oRBar TO OPTION 1 PROMPT "Styles" WIDTH 75 BITMAP "..\bitmaps\style16.BMP"
   
   ADD GROUP oGr4 RIBBON oRBar TO OPTION 1 PROMPT "Editing"
   
   @ 2,5 ADD BUTTON oBtn1 PROMPT "Paste" BITMAP "..\bitmaps\PASTE32.BMP" GROUP oGr ACTION ( RIBBON() ) ;
   SPLITPOPUP ROUND SIZE 50,65

   @ 2, 55 ADD BUTTON oBtn2 GROUP oGr BITMAP "..\bitmaps\cut16.BMP" ;
     SIZE 60, 20 PROMPT "Cut"  MOSTLEFT round ;
     action ( msginfo( "Cut" ) )
   
   @ 24, 55 ADD BUTTON oBtn3 GROUP oGr BITMAP "..\bitmaps\copy16.BMP" ;
     SIZE 65, 20 PROMPT "Copy"  MOSTLEFT round ;
     action( msginfo( "Copy" ) )

   @ 46, 55 ADD BUTTON oBtn4 GROUP oGr BITMAP "..\bitmaps\paste16.BMP" ;
     SIZE 70, 20 PROMPT "Paste"  MOSTLEFT round ;
     action( msginfo( "Paste" ) )
     
   @ 68, 30 ADD BUTTON oSay1 GROUP oGr SIZE 65, 15 PROMPT "A Say" SAYBUTTON
     
   @ 10, 05 ADD BUTTON oBtn5 GROUP oGr1 BITMAP "..\bitmaps\bold16.bmp" GROUPBUTTON FIRST SIZE 25, 20 ROUND ;
   ACTION( oBtn5:lSelected := !oBtn5:lSelected )
   
   @ 10, 30 ADD BUTTON oBtn6 GROUP oGr1 BITMAP "..\bitmaps\italic16.bmp" GROUPBUTTON SIZE 25, 20 ROUND ;
      ACTION( oBtn6:lSelected := !oBtn6:lSelected )
   
   @ 10, 55 ADD BUTTON oBtn7 GROUP oGr1 BITMAP "..\bitmaps\underline16.bmp" GROUPBUTTON SIZE 35, 20 ROUND Popup
   
   @ 10, 90 ADD BUTTON oBtn8 GROUP oGr1 BITMAP "..\bitmaps\strikethru16.bmp" GROUPBUTTON SIZE 25, 20 ROUND;
      ACTION( oBtn8:lSelected := !oBtn8:lSelected )
   
   
   @ 10, 115 ADD BUTTON oBtn9 GROUP oGr1 BITMAP "..\bitmaps\subindex16.bmp" GROUPBUTTON SIZE 25, 20 ROUND;
      ACTION( oBtn9:lSelected := !oBtn9:lSelected, oBtn10:lSelected := .f., oBtn10:Refresh() )
   
   @ 10, 140 ADD BUTTON oBtn10 GROUP oGr1 BITMAP "..\bitmaps\superindex16.bmp" GROUPBUTTON SIZE 25, 20 ROUND ;
      ACTION( oBtn10:lSelected := !oBtn10:lSelected, oBtn9:lSelected := .f., oBtn9:Refresh() )
   
   @ 10, 165 ADD BUTTON oBtn11 GROUP oGr1 BITMAP "..\bitmaps\casing16.bmp" GROUPBUTTON END SIZE 35, 20 ROUND POPUP


   @ 40, 05 ADD BUTTON oBtn11 GROUP oGr1 BITMAP "..\bitmaps\hilight16.bmp" GROUPBUTTON FIRST SIZE 35, 20 ROUND POPUP
   
   @ 40, 40 ADD BUTTON oBtn12 GROUP oGr1 BITMAP "..\bitmaps\fontcolor16.bmp" GROUPBUTTON END SIZE 35, 20 ROUND POPUP
   
   @ 40, 100 ADD BUTTON oBtn13 GROUP oGr1 BITMAP "..\bitmaps\fontsizeincrease16.bmp" GROUPBUTTON FIRST SIZE 25, 20 ROUND

   
   @ 40, 125 ADD BUTTON oBtn14 GROUP oGr1 BITMAP "..\bitmaps\fontsizedecrease16.bmp" GROUPBUTTON END SIZE 25, 20 ROUND
   
   
   @ 40, 175 ADD BUTTON oBtn16 GROUP oGr1 BITMAP "..\bitmaps\style16.bmp" SIZE 25, 20 ROUND BORDER

   @ 64, 70 ADD BUTTON oChk1 GROUP oGr1 BITMAP "..\bitmaps\checkon.bmp" MOSTLEFT SIZE 85, 18 PROMPT "Checkbox" ;
      ACTION ( lVal1 := ! lVal1, oChk1:SetFile( If( lVal1, "..\bitmaps\checkon.bmp", "..\bitmaps\checkoff.bmp" ) ) )


   @ 10, 05 ADD BUTTON oBtn17 GROUP oGr2 BITMAP "..\bitmaps\unorderedlist16.bmp" GROUPBUTTON FIRST SIZE 35, 20 ROUND POPUP
   
   @ 10, 40 ADD BUTTON oBtn18 GROUP oGr2 BITMAP "..\bitmaps\orderedlist16.bmp" GROUPBUTTON SIZE 35, 20 ROUND POPUP
   
   @ 10, 75 ADD BUTTON oBtn19 GROUP oGr2 BITMAP "..\bitmaps\multilevellist16.bmp" GROUPBUTTON END SIZE 35, 20 ROUND ;
     POPUP MENU oMenu

   @ 10, 110 ADD BUTTON oBtn20 GROUP oGr2 BITMAP "..\bitmaps\textalignleft16.bmp" GROUPBUTTON FIRST SIZE 25, 20 ROUND ;
   ACTION( ChangeSelect( { oBtn20, oBtn21, oBtn22, oBtn23 } ) )
   
   @ 10, 135 ADD BUTTON oBtn21 GROUP oGr2 BITMAP "..\bitmaps\textaligncenter16.bmp" GROUPBUTTON SIZE 25, 20 ROUND ;
      ACTION( ChangeSelect( { oBtn21, oBtn20, oBtn22, oBtn23 } ) )
   
   @ 10, 160 ADD BUTTON oBtn22 GROUP oGr2 BITMAP "..\bitmaps\textalignright16.bmp" GROUPBUTTON SIZE 25, 20 ROUND;
      ACTION( ChangeSelect( { oBtn22, oBtn21, oBtn20, oBtn23 } ) )
   
   @ 10, 185 ADD BUTTON oBtn23 GROUP oGr2 BITMAP "..\bitmaps\textalignjustify16.bmp" GROUPBUTTON END SIZE 25, 20 ROUND;
      ACTION( ChangeSelect( { oBtn23, oBtn21, oBtn22, oBtn20 } ) )


   @ 40, 05 ADD BUTTON oBtn24 GROUP oGr2 BITMAP "..\bitmaps\fill16.bmp" GROUPBUTTON FIRST SIZE 35, 20 ROUND POPUP
   
   @ 40, 40 ADD BUTTON oBtn25 GROUP oGr2 BITMAP "..\bitmaps\borderbottom16.bmp" GROUPBUTTON END SIZE 35, 20 ROUND
   
   @ 40, 80 ADD BUTTON oBtn26 GROUP oGr2 BITMAP "..\bitmaps\indentdecrease16.bmp" GROUPBUTTON FIRST SIZE 25, 20 ROUND

   @ 40, 105 ADD BUTTON oBtn27 GROUP oGr2 BITMAP "..\bitmaps\indentincrease16.bmp" GROUPBUTTON END SIZE 25, 20 ROUND

   @ 40, 135 ADD BUTTON oBtn28 GROUP oGr2 BITMAP "..\bitmaps\sort16.bmp" SIZE 25, 20 ROUND BORDER
   
   @ 40, 160 ADD BUTTON oBtn29 GROUP oGr2 BITMAP "..\bitmaps\paragraphspacing16.bmp" SIZE 25, 20 ROUND BORDER
     
   @ 40, 185 ADD BUTTON oBtn30 GROUP oGr2 BITMAP "..\bitmaps\invisiblechars16.bmp" SIZE 25, 20 ROUND BORDER

   @ 3,5 ADD BUTTON oBtn31 PROMPT "Change"+CRLF+"Styles" BITMAP "..\bitmaps\stylechange32.BMP" GROUP oGr3 MENU oMenu ;
     SPLITPOPUP ROUND SIZE 65,75 TOP

   @ 2,5 ADD BUTTON oBtn32 PROMPT "Find" BITMAP "..\bitmaps\find32.BMP" GROUP oGr4 ;
     SPLITPOPUP ROUND SIZE 50,65

   @ 2, 55 ADD BUTTON oBtn33 GROUP oGr4 BITMAP "..\bitmaps\replace16.BMP" ;
     SIZE 80, 20 PROMPT "Replace"  MOSTLEFT round ;
     ACTION msginfo( "Replace" )
   
   @ 24, 55 ADD BUTTON oBtn34 GROUP oGr4 BITMAP "..\bitmaps\goto16.BMP" ;
     SIZE 65, 20 PROMPT "Go To"  MOSTLEFT round ;
     ACTION msginfo( "Go To" )

   @ 46, 55 ADD BUTTON oBtn35 GROUP oGr4 BITMAP "..\bitmaps\select16.BMP" ;
     SIZE 70, 20 PROMPT "Select"  MOSTLEFT round POPUP

   SET MESSAGE OF oWnd TO "Testing FWH own Class RibbonBar" ;
      CENTERED CLOCK KEYBOARD 2007
   
   oWnd:Center()
   
   ACTIVATE WINDOW oWnd MAXIMIZED
   
   oRBar:End()
   
return nil


Function Ribbon( )

   local oDlg
   local aBtn := Array( 20 )
   local aGrp := Array( 5 )
   local oBrush
   local oMenu

   MENU oMenu POPUP 2007
      MENUITEM "Style Set" FILE "..\bitmaps\styleset161.BMP"
      MENUITEM "Colors"
      MENUITEM "Font"
   ENDMENU

   DEFINE BRUSH oBrush FILE "..\bitmaps\backgrnd\boards.bmp"  

   DEFINE DIALOG oDlg title "Test RibbonBar Own Control " + FWVERSION SIZE 600,600 PIXEL BRUSH oBrush

   @ 010, 010 RBGROUP aGrp[ 1 ] PROMPT "Test" of oDlg SIZE 90, 40
   
   @ 010, 060 RBGROUP aGrp[ 2 ] PROMPT "Transparent" of oDlg SIZE 90, 40 TRANSPARENT
   
   @ 010, 110 RBGROUP aGrp[ 3 ] PROMPT "Own Color" of oDlg SIZE 90, 40 ;
              GRADIANT { { 0.1, RGB( 254, 154, 128 ), RGB( 254, 154, 128 ) }, ;
                         { 0.9, RGB( 252, 85, 40 ), RGB( 181, 61, 29 ) } };
              LINECOLORS RGB( 249, 194, 179 ), RGB( 181, 61, 29 );
              CAPTIONGRAD { { 1, RGB( 239, 56, 6 ), RGB( 239, 56, 6 ) } };
              TEXTCOLOR CLR_WHITE
             
   @ 100, 05 RBBTN  aBtn[ 1 ] PROMPT "Say Button" SAYBUTTON OF oDlg SIZE 50, 15 CENTER ROUND BORDER;
             ACTION( MsgInfo( "Say Button" ) )
   
   @ 100, 60 RBBTN  aBtn[ 2 ] PROMPT "Button"     OF oDlg SIZE 50, 15 CENTER ROUND BORDER;
             GRADIANT { { 1/3, nRGB( 254, 154, 128 ), nRGB( 254, 154, 128 ) } , ;
                         { 2/3, nRGB( 252, 85, 40 ), nRGB(181, 61, 29 ) } } ;
             LINECOLORS RGB( 249, 194, 179 ), RGB( 181, 61, 29 )
             
   @ 120, 005 RBBTN aBtn[ 4 ] PROMPT "Most Left"  OF oDlg SIZE 70, 15 MOSTLEFT ROUND BORDER ;
              BITMAP "..\bitmaps\textalignleft16.bmp"

   @ 120, 080 RBBTN aBtn[ 5 ] PROMPT "Left"  OF oDlg SIZE 70, 15 LEFT ROUND BORDER ;
              BITMAP "..\bitmaps\textalignleft16.bmp"

   @ 140, 005 RBBTN aBtn[ 6 ] PROMPT "Center"  OF oDlg SIZE 70, 20 CENTER ROUND BORDER ;
              BITMAP "..\bitmaps\textaligncenter16.bmp"

   @ 165, 005 RBBTN aBtn[ 7 ] PROMPT "Most Right"  OF oDlg SIZE 70, 15 MOSTRIGHT ROUND BORDER ;
              BITMAP "..\bitmaps\textalignright16.bmp"

   @ 165, 080 RBBTN aBtn[ 8 ] PROMPT "Right"  OF oDlg SIZE 70, 15 RIGHT ROUND BORDER ;
              BITMAP "..\bitmaps\textalignright16.bmp"


   @ 100, 165 RBBTN  aBtn[ 9 ] PROMPT "Rect Corner" OF oDlg SIZE 50, 15 CENTER BORDER

   @ 100, 220 RBBTN aBtn[ 10 ] OF oDlg BITMAP "..\bitmaps\select16.BMP" ;
              SIZE 35, 10 PROMPT "Popup"  MOSTLEFT ROUND POPUP BORDER
   
   @ 130, 165 RBBTN aBtn[ 11 ] PROMPT "SplitPopup"  OF oDlg SIZE 35, 50;
              SPLITPOPUP ROUND BORDER MENU oMenu BITMAP "..\bitmaps\textaligncenter16.bmp"


   @ 110, 220 RBBTN aBtn[ 12 ] OF oDlg BITMAP "..\bitmaps\select16.BMP" MENU oMenu;
              SIZE 70, 10 PROMPT "Action"  MOSTLEFT ROUND POPUP BORDER ;
              ACTION( MsgInfo( "Action" ) )
   
   @ 130, 220 RBBTN aBtn[ 13 ] PROMPT "Popup"  OF oDlg SIZE 35, 50;
              SPLITPOPUP ROUND BORDER MENU oMenu BITMAP "..\bitmaps\textaligncenter16.bmp";
              ACTION( MsgInfo( "Action" ) ) CENTER

   @ 200, 005 RBBTN aBtn[ 14 ] PROMPT "Transparent" OF oDlg SIZE 50, 15 CENTER BORDER TRANSPARENT

   @ 200, 080 RBBTN aBtn[ 15 ] OF oDlg BITMAP "..\bitmaps\AlphaBmp\TEXT.BMP" ;
              SIZE 40, 60 PROMPT "ALPHA"  TOP TRANSPARENT

   @ 200, 150 RBBTN aBtn[ 16 ] OF oDlg BITMAP "..\bitmaps\textalignleft16.bmp" GROUPBUTTON FIRST SIZE 12, 10 ROUND ;
      ACTION( ChangeSelect( { aBtn[ 16 ], aBtn[ 17 ], aBtn[ 18 ], aBtn[ 19 ] } ) )
   
   @ 200, 162 RBBTN aBtn[ 17 ] OF oDlg BITMAP "..\bitmaps\textaligncenter16.bmp" GROUPBUTTON SIZE 12, 10 ROUND ;
      ACTION( ChangeSelect( { aBtn[ 17 ], aBtn[ 16 ], aBtn[ 18 ], aBtn[ 19 ] } ) )
   
   @ 200, 174 RBBTN aBtn[ 18 ] OF oDlg BITMAP "..\bitmaps\textalignright16.bmp" GROUPBUTTON SIZE 12, 10 ROUND;
      ACTION( ChangeSelect( { aBtn[ 18 ], aBtn[ 17 ], aBtn[ 16 ], aBtn[ 19 ] } ) )
   
   @ 200, 186 RBBTN aBtn[ 19 ] OF oDlg BITMAP "..\bitmaps\textalignjustify16.bmp" GROUPBUTTON END SIZE 12, 10 ROUND;
      ACTION( ChangeSelect( { aBtn[ 19 ], aBtn[ 18 ], aBtn[ 17 ], aBtn[ 16 ] } ) )


   ACTIVATE DIALOG oDlg CENTERED
   
   AEval( aGrp, { | o | if( o != NIL,  o:End(), ) } )
   oBrush:End()

return nil

Procedure ChangeSelect( aObj )

   local n
     
   aObj[ 1 ]:lSelected := .t.
   for n = 2 to len( aObj )
      aObj[ n ]:lSelected := .f.
      aObj[ n ]:Refresh()
   next
return

Function ChangeBmp( oBmp )
                  
   static lWork
   
   if lWork == nil
      lWork := .f.
   endif

   if !lWork
      lWork := .t.
      nIndex+=nAvance
     
      if nIndex > LEN( aBmp )
         nAvance := -1
         nIndex := LEN( aBmp ) + nAvance
      elseif nIndex == 0
         nAvance := 1
         nIndex := 1 + nAvance
      endif
      oBmp:hBitmap = aBmp[ nIndex ]
      oBmp:Refresh()
      lWork := .f.
   
   endif

   
return nil

//----------------------------------------------------------------------------//

Function BackStage( oRBar )

   local  oBackStage
   
   DEFINE BACKSTAGE oBackStage
   
   DEFINE BSBUTTON OF oBackStage PROMPT "Save" ;
          BITMAP "..\bitmaps\alphabmp\bs_save.bmp" ACTION Msginfo( oOpt:cPrompt );
          GRADIENT { { 1, nRGB(  255, 255, 0 ), nRGB( 255, 255, 255 ) } }
         
   DEFINE BSBUTTON OF oBackStage PROMPT "Save As" ;
          BITMAP "..\bitmaps\alphabmp\bs_saveas.bmp" ACTION Msginfo( oOpt:cPrompt );
          GRADIENT { { 1,  nRGB( 242, 96, 96 ), nRGB( 195, 37, 37 ) } };
          COLORTEXT CLR_BLACK, CLR_WHITE
   
   DEFINE BSBUTTON OF oBackStage PROMPT "Open" ;
          BITMAP "..\bitmaps\alphabmp\bs_open.bmp" ACTION Msginfo( oOpt:cPrompt )
   
   DEFINE BSBUTTON OF oBackStage PROMPT "Close";
          BITMAP "..\bitmaps\alphabmp\bs_close.bmp" ACTION Msginfo( oOpt:cPrompt )
   

   DEFINE BSSELECT OF oBackStage PROMPT "Information";
          COLORTEXT NIL, CLR_HRED ACTION Msginfo( oOpt:cPrompt )

   DEFINE BSSELECT OF oBackStage PROMPT "New" ACTION Msginfo( oOpt:cPrompt )

   DEFINE BSSELECT OF oBackStage PROMPT "Print" ACTION Msginfo( oOpt:cPrompt )

   DEFINE BSSELECT OF oBackStage PROMPT "Save / Send" ACTION Msginfo( oOpt:cPrompt );
      GRADIENT { { 1, nRGB(  255, 255, 0 ), nRGB( 255, 255, 255 ) } }

   DEFINE BSSELECT OF oBackStage PROMPT "Help" ACTION Msginfo( oOpt:cPrompt );
          COLORS nRGB( 242, 96, 96 ), nRGB( 195, 37, 37 )

   DEFINE BSBUTTON OF oBackStage PROMPT "Option" ;
          BITMAP "..\bitmaps\alphabmp\bs_options.bmp" ACTION Msginfo( oOpt:cPrompt )
         
   DEFINE BSBUTTON OF oBackStage PROMPT "Exit" ;
          BITMAP "..\bitmaps\alphabmp\bs_exit.bmp" ACTION Msginfo( oRBar:oWnd:End() )

   
   
   
   SET BACKSTAGE oBackStage TO oRBar

   
return nil
     
     

//----------------------------------------------------------------------------//

Function TestRes( oWnd )

   local oDlg
   local oBtn5, oBtn6, obtn7, oBtn8, oBtn9, oBtn10, oBtn11

   DEFINE DIALOG oDlg RESOURCE "TEST"
   
   REDEFINE RBBTN ID 100 OF oDlg  BITMAP "..\bitmaps\PASTE32.BMP" ;
            ACTION ( RIBBON() ) ;
            SPLITPOPUP ROUND
   
   REDEFINE RBBTN ID 101 OF oDlg  BITMAP "..\bitmaps\cut16.BMP" ;
            MOSTLEFT ROUND ;
            ACTION ( msginfo( "Cut" ) )
     
   REDEFINE RBBTN ID 102 OF oDlg BITMAP "..\bitmaps\copy16.BMP" ;
            PROMPT "Copy"  MOSTLEFT ROUND ;
            ACTION( msginfo( "Copy" ) )
   
   
   REDEFINE RBBTN ID 103 OF oDlg BITMAP "..\bitmaps\paste16.BMP" ;
            PROMPT "Paste"  MOSTLEFT ROUND ;
            ACTION( msginfo( "Paste" ) )
     
     
   REDEFINE RBBTN ID 104 OF oDlg SAYBUTTON
   
   REDEFINE RBBTN oBtn5 ID 105 OF oDlg BITMAP "..\bitmaps\bold16.bmp" GROUPBUTTON FIRST ROUND ;
            ACTION( oBtn5:lSelected := !oBtn5:lSelected )
   
   REDEFINE RBBTN oBtn6 ID 106 OF oDlg BITMAP "..\bitmaps\italic16.bmp" GROUPBUTTON ROUND ;
      ACTION( oBtn6:lSelected := !oBtn6:lSelected )
   
   REDEFINE RBBTN oBtn7 ID 107 OF oDlg BITMAP "..\bitmaps\underline16.bmp" GROUPBUTTON ROUND Popup
   
   REDEFINE RBBTN oBtn8 ID 108 OF oDlg BITMAP "..\bitmaps\strikethru16.bmp" GROUPBUTTON ROUND;
      ACTION( oBtn8:lSelected := !oBtn8:lSelected )
   
   REDEFINE RBBTN oBtn9 ID 109 OF oDlg BITMAP "..\bitmaps\subindex16.bmp" GROUPBUTTON  ROUND;
      ACTION( oBtn9:lSelected := !oBtn9:lSelected, oBtn10:lSelected := .f., oBtn10:Refresh() )
     
   REDEFINE RBBTN oBtn10 ID 110 OF oDlg BITMAP "..\bitmaps\superindex16.bmp" GROUPBUTTON ROUND ;
      ACTION( oBtn10:lSelected := !oBtn10:lSelected, oBtn9:lSelected := .f., oBtn9:Refresh() )
   
   REDEFINE RBBTN oBtn11 ID 111 OF oDlg BITMAP "..\bitmaps\casing16.bmp" GROUPBUTTON END ROUND POPUP
   
   ACTIVATE DIALOG oDlg

return nil



//----------------------------------------------------------------------------//

function AddResource( nHResource, cType )

   AAdd( aResources, { cType, nHResource, ProcName( 3 ), ProcLine( 3 ) } )
   
return nil  

//----------------------------------------------------------------------------//

function DelResource( nHResource )

   local nAt

   if ( nAt := AScan( aResources, { | aRes | aRes[ 2 ] == nHResource } ) ) != 0
      ADel( aResources, nAt )
      ASize( aResources, Len( aResources ) - 1 )
   endif    

return nil

//----------------------------------------------------------------------------//
 

[leandro]

ribbon4.prg

Code: Select all  Expand view

/*
Purpose  : Fivewin Ribbonbar - MS Office 2019 style
Program  :
Author   : Frances Padilla (FAP)
Date     : 05/07/2019 04:52:26 PM
Company  :
Copyright:
Language : Fivewin/xHarbour
Updated  : 05/06/2019 By James Bott, jbott@compuserve.com
Notes    :
Source   : viewtopic.php?f=3&t=36145&p=221601#p221601
         : This is the dark theme
         : Somehow he got rid of the underline under the ribbonbar.

*/

#include "FiveWin.ch"
#include "Ribbon.ch"

//#define _ClrRed RGB(255,37,37)

#define _nClrPaneRB       RGB( 68, 68, 68 )
#define _nClrBoxOutRB     RGB( 178, 178, 178 )
#define _nClrBoxInRB      RGB( 178, 178, 178 )
#define _nClrBoxSelOut    RGB( 178, 178, 178 )  // doesn't show when changed to red
#define _nClrBoxSelIn  := RGB( 178, 178, 178 )
#define _aGradRB          { { 1, RGB( 178, 178, 178 ), RGB( 178, 178, 178 ) } }
#define _aGradFldRB       {|nOpt| iif( nOpt == oRibbon:nStart, { { 1, RGB( 178, 178, 178 ), RGB( 178, 178, 178 ) } },;
                                                                 { { 1, RGB( 178, 178, 178 ), RGB( 178, 178, 178 ) } } ) }
#define _aGradHighRB      { { 1, RGB(178, 178, 178 ), RGB( 178, 178, 178 ) } }
#define _aGradOverRB      { { 1, RGB( 178, 178, 178 ), RGB( 178, 178, 178 ) } }
#define _nCtrlFrGround    RGB( 255, 255, 255 )
#define _nCtrlBkGround    RGB( 106, 106, 106 )
#define _nClrBoxOut       RGB( 160, 160, 160 )
#define _nClrBoxIn        RGB( 160, 160, 160 )
#define _nClrTxt          RGB( 220, 220, 220 ) //RGB( 0, 0, 0 )
#define _bClrGradNormal   {|lPressed| iif( lPressed, { { 1, _nClrBoxOut, _nClrBoxOut } },;
                                                     { { 1, _nClrBoxOut, _nClrBoxOut } } ) }
#define _aClrGradUnder    {|| { { 1, _nClrBoxOut, _nClrBoxOut } } }
#define _aClrGradBack     { { 1, _nClrBoxOut, _nClrBoxOut } }


Function Main()

   local oFont
   local n, oWnd, oRibbon, oGroup
   local aDlgs, oDlg

   DEFINE FONT oFont NAME getSysFont() SIZE 0,-12

   DEFINE WINDOW oWnd title "Fivewin Ribbonbar - Office 2109 style"
   
        aDlgs := { ' File ', ' Home ', ' Insert ', ' Design ', ' Layout ', ' References ', ' Mailings ', ' Review ', ' View ' }

        oRibbon := TRibbonBar():New( oWnd, aDlgs,,,, 135, 40, _nClrPaneRB, _nClrBoxOutRB, _nClrBoxInRB,,;
        _nClrBoxSelOut, _aGradRB, _aGradFldRB, _aGradHighRB, _aGradOverRB,,,.t.,,)
                                    // _nClrBoxSelOut, _aGradRB, _aGradFldRB, _aGradHighRB, _aGradOverRB,,,,,.T.)
       
        // Change the colors of the tabs                            
        AFill( oRibbon:aClrTabTxt, { | oSelf, nPrompt | If( nPrompt == oSelf:nOption, CLR_BLACK,;
       If( oRibbon:nOverPrompt( ScreenToClient( oRibbon:hWnd, GetCursorPos() )[ 1 ], ScreenToClient( oRibbon:hWnd, GetCursorPos() )[ 2 ] ) == nPrompt, CLR_BLACK, _nClrTxt ) ) } )
       
        WITH OBJECT oRibbon
            :nHeightFld := 24
            :hSeparation := 4
            :SetFont( oFont )
            :nLeftMargin = 10   // left margin of tabs
            :nClrBoxSelOut = _nClrBoxSelOut   // New ! Removes white outline of tab when cursor is over them.
            :l2010 = .T.   // New ! Turns off highlighting of groups when cursor is over them.
            :CalcPos()
        END
       
         oGroup = oRibbon:AddGroup( 70, "Clipboard", 1 )
         oGroup = oRibbon:AddGroup( 260, "Font", 1 )
         oGroup = oRibbon:AddGroup( 221, "Paragraph", 1 )
         oGroup = oRibbon:addGroup( 320, "Styles", 1)
         
         for each oDlg in oRibbon:aDialogs
           
            oDlg:hBack = oRibbon:hBrushEx
            oDlg:Refresh()
           
            for each oGroup in oDlg:aControls
               if oGroup:IsKindOf( "TRBGROUP" )
                  //oGroup:oFont:End()
                  //oGroup:SetFont( oRibbon:oFont )
                 
                 // oGroup:nHeight      = 100
                  oGroup:nClrBoxIn    = CLR_LIGHTGRAY
                  oGroup:aGradCaption = { { 1, CLR_LIGHTGRAY, CLR_LIGHTGRAY } }
                  //oGroup:bClrText     = { | lEnable | If( lEnable, CLR_LIGHTGRAY, CLR_DARKGRAY ) } //CLR_DARKGRAY ) }
                  oGroup:nClrTxt      = RGB(0,0,0)
                  oGroup:nClrBoxIn    = _nClrPaneRB //CLR_LIGHTGRAY
                  oGroup:nClrBoxOut   = _nClrPaneRB //CLR_LIGHTGRAY
                 
                  //oGroup:SetColor( _nClrTxt, _nClrPaneRB )
                 
                  DeleteObject( oGroup:hBrushSel )
                  DeleteObject( oGroup:hBrushUnSel )
                  DeleteObject( oGroup:hBack )
                  oGroup:hBrushUnSel  = oDlg:hBack
                  oGroup:hBack        = oDlg:hBack
                 
                  oGroup:refresh()
               endif
            next
          next        

        oWnd:SetSize( 930, 400 )
        oWnd:setColor(, _nCtrlBkGround)
       
        SET MESSAGE TO " Page 1 of 1 0 words English (United Kingdom)" OF oWnd color _nClrTxt, _nClrPaneRB noinset noborder

   ACTIVATE WINDOW oWnd CENTER
 
return nil
 

[jgabri]

Gracias Leandro, estoy jugando con los colores, para diseñar algo parecido.

Un saludo,
Gabriel

[José Luis Sánchez]

Hola,
Me gustaróa hacer una ribbon de este estilo, pero poniendo el fondo que queda son pestaña del mismo color de la barra de título. ¿ Sabeis como puedo recuperar el color de la barra de título de una ventana ?

Saludos,
José Luis

[Enrico Maria Giordano]

Try

Code: Select all  Expand view

nClr = GESYSCOLOR( COLOR_ACTIVECAPTION )

EMG

[karinha]

Code: Select all  Expand view

#include "FiveWin.ch"

#define COLOR_ACTIVECAPTION     2

STATIC oDlg

FUNCTION Main()

   DEFINE DIALOG oDlg FROM 6, 6 TO 20, 60 ;
          TITLE "Hide and Show Taskbar and Color"

   @ 2, 2 BUTTON "&Hide" OF oDlg                                             ;
      ACTION task_bar_on( .F. )

   @ 4, 2 BUTTON "&Show" OF oDlg                                             ;
      ACTION task_bar_on( .T. )

   @ 4, 12 BUTTON "Show Color" OF oDlg                                       ;
      ACTION MsgInfo( GetSysColor( COLOR_ACTIVECAPTION ) )

   ACTIVATE DIALOG oDlg ;
      VALID MsgYesNo( "Want to end ?" )

RETURN( NIL )

FUNCTION task_bar_on( ison )

   LOCAL hwnd

   hwnd = FindWndByClass( "Shell_TrayWnd", "" )
 
   SetSysColors( 1, COLOR_ACTIVECAPTION, 13743257 )
   
   IF ison
      ShowWindow( hwnd, 5 )
   ELSE
      ShowWindow( hwnd, 0 )
   End IF

RETURN( NIL )

DLL32 FUNCTION ShowWindow( hwnd as LONG, nCmdShow as LONG ) AS LONG          ;
      PASCAL FROM "ShowWindow" Lib "user32.dll"

DLL32 FUNCTION FindWndByClass( wndClass AS LPSTR, WndName as LPSTR ) AS LONG ;
      PASCAL FROM "FindWindowA" LIB "user32.dll"

DLL32 Function SetSysColors ( nChanges As LONG, lpSysColor As LONG,          ;
      lpColorValues As LONG) As LONG PASCAL FROM "SetSysColors" Lib "user32"