Modernizar Outlook2003

[acuellar]

Hola amigos
Se puede cambiar colores y estilo del Outlook2003, para que quede como el Outlook 2010

Code: Select all

// FWH Class TOutLook2003

#include "FiveWin.ch"
#include "Splitter.ch"

static lExit := .F.

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

function Main()

   local oWnd, oOutLook2003, oStatusBar, oSplit, cCombo, oRad, nValue := 1
   local oFont, oExBar, oPanel1, oPanel2, bClick := { | o | MsgInfo( o:GetText() ) } 

   DEFINE WINDOW oWnd TITLE "FWH new Class TOutLook2003" MDI // ;
      // MENU BuildMenu()

   DEFINE OUTLOOK2003 oOutLook2003 OF oWnd ;
      PROMPTS "Mail", "Calendar", "Contacts", "" ;
      BITMAPS "..\bitmaps\mail.bmp", "..\bitmaps\calendar.bmp", "..\bitmaps\notes.bmp"
      
   oWnd:oLeft = nil // Because the splitter is going to control the resize   

   @ 0, 0 EXPLORERBAR oExBar OF oOutLook2003:aDialogs[ 1 ] ;
      SIZE oOutLook2003:aDialogs[ 1 ]:nWidth, oOutLook2003:aDialogs[ 1 ]:nHeight 

   oPanel1 = oExBar:AddPanel( "One", "..\bitmaps\32x32\people.bmp" )
   oPanel1:lSpecial = .T.
   oPanel1:AddLink( "First item", bClick, "..\bitmaps\16x16\additem.bmp" )
   oPanel1:AddLink( "Second item", bClick, "..\bitmaps\16x16\copy.bmp" )
      
   oPanel2 = oExBar:AddPanel( "Two", "..\bitmaps\32x32\case.bmp" )
   oPanel2:AddLink( "First item", bClick, "..\bitmaps\16x16\adddbf.bmp" )
   oPanel2:AddLink( "Second item", bClick, "..\bitmaps\16x16\delete0.bmp" )
   oPanel2:AddLink( "Third item", bClick, "..\bitmaps\16x16\envelope.bmp" )
   oPanel2:AddLink( "Fourth item", bClick, "..\bitmaps\16x16\copy.bmp" )      
      
   @ 1, 1 COMBOBOX cCombo ITEMS { "January", "February", "March", "April", "May" } ;
      OF oOutLook2003:aDialogs[ 2 ] SIZE 170, 100 
   
   DEFINE FONT oFont NAME "Arial" SIZE 0, -10
   
   @ 12, 10 SAY Date() OF oOutLook2003:aDialogs[ 2 ] SIZE 80, 20 FONT oFont
   
   @ 3, 1 RADIO oRad VAR nValue OF oOutLook2003:aDialogs[ 2 ] ;
      ITEMS "&Day", "&Week", "&Month" SIZE 100, 20
      
   oRad:SetFont( oFont )   

   @ 1, 2 BUTTON "New" OF oOutLook2003:aDialogs[ 3 ] SIZE 80, 22 ACTION BuildDlg()

   @ 3, 2 BUTTON "Edit" OF oOutLook2003:aDialogs[ 3 ] SIZE 80, 22 ACTION MsgInfo( "Edit" )   

   @ 5, 2 BUTTON "Search" OF oOutLook2003:aDialogs[ 3 ] SIZE 80, 22 ACTION MsgInfo( "Search" )   

   DEFINE STATUSBAR oStatusBar PROMPT "  FWH Class TOutLook2003" OF oWnd

   SetParent( oOutLook2003:hWnd, oWnd:hWnd )
   
   oWnd:oClient = nil
   
   @ 0, 191 SPLITTER oSplit ;
      VERTICAL _3DLOOK ;
      PREVIOUS CONTROLS oOutLook2003 ; 
      HINDS CONTROLS oWnd:oWndClient ;
      SIZE 4, oWnd:nHeight - 70 PIXEL ;
      OF oWnd

   SetParent( oSplit:hWnd, oWnd:hWnd )

   ACTIVATE WINDOW oWnd ;
      ON RESIZE ( oSplit:Adjust(),;
                  WndLeft( oWnd:oWndClient:hWnd, oSplit:nRight + 1 ),;
                  WndWidth( oWnd:oWndClient:hWnd, oWnd:nWidth - oOutLook2003:nWidth - 23 ) ) ; // + 80
      VALID lExit := .T.

return nil

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

function BuildMenu()

   local oMenu
   
   MENU oMenu
      MENUITEM "&One"
      MENUITEM "&Two"
      MENUITEM "&Three"
   ENDMENU
   
return oMenu   

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

function BuildDlg()

   local oDlg, oOutL2003
   
   DEFINE DIALOG oDlg RESOURCE "Test"
   
   REDEFINE OUTLOOK2003 oOutL2003 ID 110 OF oDlg ;
      PROMPTS "One", "Two", "Three" ;
      BITMAPS "..\bitmaps\mail.bmp", "..\bitmaps\calendar.bmp", "..\bitmaps\notes.bmp" ;
      DIALOGS "Page1", "Page2", "Page3"

   REDEFINE BUTTON ID 110 OF oOutL2003:aDialogs[ 1 ] ACTION MsgInfo( "Click" )
      
   ACTIVATE DIALOG oDlg CENTERED
   
return nil      

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

function WinRun()

   while NoGPF()
      if lExit
         PostQuitMessage( 0 )
      endif   
   end
   
return nil         
                
//----------------------------------------------------------------------------//

#pragma BEGINDUMP

#include <windows.h>
#include <hbapi.h>

BOOL SysRefresh( void );

HB_FUNC( NOGPF )
{
   __try
   {
      hb_retl( SysRefresh() );
   }
   __except ( ( hb_retl( TRUE ), TRUE ) )
   {} 
}

#pragma ENDDUMP 
 
 

Para que asi:


Gracias por la ayuda.

Saludos,

Adhemar

[Antonio Linares]

Adhemar,

No está terminado pero puedes ir probándolo. No tengo instalado OutLook 2010 aqui, por lo que te agradezco si pones unas capturas de la parte superior del control, gracias

outl2010.prg

Code: Select all

#include "FiveWin.ch"

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

#define COLOR_WINDOW         5
#define COLOR_BTNFACE       15
#define TME_LEAVE            2
#define WM_MOUSELEAVE      675

#define LIGHTBLUE    nRGB(  89, 135, 214 )
#define DARKBLUE     nRGB(   3,  56, 147 )
#define LIGHTORANGE1 nRGB( 250, 227, 143 )
#define DARKORANGE1  nRGB( 238, 152, 25 )
#define LIGHTCYAN    nRGB( 203, 225, 252 )
#define DARKCYAN     nRGB( 125, 165, 224 )
#define LIGHTORANGE2 nRGB( 255, 255, 220 )
#define DARKORANGE2  nRGB( 247, 192, 91 )

CLASS TOutLook2010 FROM TControl

   DATA  oHeader
   DATA  aGroups, aDialogs
   DATA  oFontHeader
   DATA  oFontGroup
   DATA  nOver
   DATA  bChange
   DATA  nOption
   DATA  hBmpDots
   DATA  oPopup

   CLASSDATA lRegistered AS LOGICAL

   METHOD New( oWnd, aPrompts, aBmpNames, bChange )
   METHOD Redefine( nId, oWnd, aPrompts, aBmpNames, bChange, aDialogs )
   METHOD Paint()
   METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD EraseBkGnd( hDC ) INLINE 1
   METHOD AddGroup( cPrompt, cBitmap )
   METHOD AtGroup( nRow, nCol )
   METHOD BuildPopup()
   METHOD Default()
   METHOD Initiate( hDlg )
   METHOD MouseMove( nRow, nCol, nFlags )
   METHOD LButtonDown( nRow, nCol, nFlags )
   METHOD Destroy()
   METHOD HandleEvent( nMsg, nWParam, nLParam )
   METHOD MouseLeave( nRow, nCol, nFlags )
   METHOD SetOption( nOption )
   METHOD AdjustDialogs( nWidth, nHeight )
   METHOD SetPopup( oPopup ) INLINE ::oPopup:End(), ::oPopup := oPopup

ENDCLASS

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

METHOD New( oWnd, aPrompts, aBmpNames, bChange )

   local n, oDlg

   DEFAULT oWnd := GetWndDefault()

   ::nTop    = 0
   ::nLeft   = 0
   ::nBottom = oWnd:nBottom
   ::nRight  = 190
   ::oWnd    = oWnd
   ::nStyle  = nOr( WS_CHILD, WS_VISIBLE, WS_BORDER )
   ::lDrag   = .f.
   ::nClrPane = nRGB( 220, 223, 228 )
   ::aGroups = {}
   ::bChange = bChange
   ::aDialogs = {}
   ::bResized = { | nType, nWidth, nHeight | ::AdjustDialogs( nWidth, nHeight ) }
   ::nOption  = 1
   ::hBmpDots = BmpOLDots()
   ::oPopup   = ::BuildPopup()

   ::Register()

   if ! Empty( ::oWnd:hWnd )
      ::Create()
      ::oWnd:AddControl( Self )
   else
      ::oWnd:DefControl( Self )
   endif

   ::oWnd:oLeft = Self

   DEFINE FONT ::oFontHeader NAME "Verdana" SIZE 0, -16 BOLD
   DEFINE FONT ::oFontGroup  NAME "Verdana" SIZE 0, -12 BOLD

   ::oHeader = TOutLook2010Group():New( "", Self )

   if ! Empty( aPrompts )
      for n = 1 to Len( aPrompts )
         if ! Empty( aBmpNames ) .and. n <= Len( aBmpNames )
            ::AddGroup( aPrompts[ n ], aBmpNames[ n ] )
         else
            ::AddGroup( aPrompts[ n ] )
         endif
      next
   endif

   for n = 1 to Len( ::aGroups )
      DEFINE DIALOG oDlg OF Self STYLE WS_CHILD  ;
         FROM 33, 0 TO ::nHeight - ( Len( ::aGroups ) * 32 ), ::nWidth() - 1 PIXEL ;
         FONT Self:oFont
      AAdd( ::aDialogs, oDlg )
   next

   if ! Empty( oWnd:hWnd )
      ::Default()
   endif

return Self

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

METHOD Redefine( nId, oWnd, aPrompts, aBmpNames, bChange, aDialogs ) CLASS TOutLook2010

   local n, oDlg, oFont

   DEFAULT aDialogs := Array( Len( aPrompts ) ), oWnd := GetWndDefault(), aBmpNames := {}

   ::nId      = nId
   ::oWnd     = oWnd
   ::aGroups  = {}
   ::aDialogs = {}
   ::bChange  = bChange
   ::nClrPane = nRGB( 0, 45, 150 )
   ::hBmpDots = BmpOLDots()
   ::oPopup   = ::BuildPopup()

   ::Register()

   DEFINE FONT ::oFontHeader NAME "Verdana" SIZE 0, -16 BOLD
   DEFINE FONT ::oFontGroup  NAME "Verdana" SIZE 0, -12 BOLD

   ::oHeader = TOutLook2010Group():New( "", Self )

   if ! Empty( aPrompts )
      for n = 1 to Len( aPrompts )
         if ! Empty( aBmpNames ) .and. n <= Len( aBmpNames )
            ::AddGroup( aPrompts[ n ], aBmpNames[ n ] )
         else
            ::AddGroup( aPrompts[ n ] )
         endif
      next
   endif

   oFont = TFont():New( GetSysFont(), 0, -9 )

   for n = 1 to Len( aPrompts )
      DEFINE DIALOG oDlg OF Self RESOURCE aDialogs[ n ] FONT oFont
      AAdd( ::aDialogs, oDlg )
   next

   oWnd:DefControl( Self )

return Self

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

METHOD Default() CLASS TOutLook2010

   local oDlg, n

   ::SetColor( ::nClrText, ::nClrPane )

   for n = 1 to Len( ::aDialogs )
      oDlg = ::aDialogs[ n ]

      ACTIVATE DIALOG oDlg NOWAIT ;
         ON INIT oDlg:Move( 33, 0 ) ;
         VALID .F.                // to avoid exiting pressing Esc !!!

      if IsAppThemed()
         if Empty( oDlg:oBrush:hBitmap )
            // oDlg:bEraseBkGnd = { | hDC | DrawPBack( oDlg:hWnd, hDC ), 1 }
         endif
      endif

      oDlg:Hide()
   next

   if Len( ::aDialogs ) > 0
      ::aDialogs[ 1 ]:Show()
   endif

return nil

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

METHOD Initiate( hDlg ) CLASS TOutLook2010

   Super:Initiate( hDlg )

   ::Default()
   ::AdjustDialogs()

return nil

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

METHOD AddGroup( cPrompt, cBitmap ) CLASS TOutLook2010

  AAdd( ::aGroups, TOutLook2010Group():New( cPrompt, Self, cBitmap ) )

  if Empty( ::oHeader:cPrompt )
     ::oHeader:cPrompt = cPrompt
  endif

return nil

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

METHOD BuildPopup() CLASS TOutLook2010

   local oPopup

   MENU oPopup POPUP 2007
      MENUITEM "Show &More Buttons"
      MENUITEM "Show &Fewer Buttons"
      MENUITEM "Na&vigation Pane Options..."
      SEPARATOR
      MENUITEM "&Add or Remove Buttons"
   ENDMENU

return oPopup

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

METHOD Paint() CLASS TOutLook2010

   local n, nTop
   local aInfo := ::DispBegin()

   FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   ::oHeader:Paint()

   // Grab bar
   nTop = ::nHeight - ( Len( ::aGroups ) * 32 ) - 7
   Gradient( ::hDC, { nTop, 0, nTop + 7, ::nWidth() }, DARKBLUE, LIGHTBLUE, .T. )
   DrawTransparent( ::hDC, ::hBmpDots, nTop + 2, ( ::nWidth() / 2 ) - ( nBmpWidth( ::hBmpDots ) / 2 ) )

   if Len( ::aGroups ) > 0
      for n = 1 to Len( ::aGroups )
         ::aGroups[ n ]:Paint()
      next
   endif

   ::DispEnd( aInfo )

return nil

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

METHOD AtGroup( nRow, nCol ) CLASS TOutLook2010

   local nGroupsArea := ::nHeight - ( Len( ::aGroups ) * 32 )

   if nRow > nGroupsArea
      return Len( ::aGroups ) - Int( ( ::nHeight - nRow ) / 32 )
   endif

return nil

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

METHOD MouseMove( nRow, nCol, nFlags ) CLASS TOutLook2010

   local nGroup := ::AtGroup( nRow, nCol )

   if nGroup == nil
      CursorArrow()
      if ::nOver != nil
         ::aGroups[ ::nOver ]:Paint()
         ::nOver = nil
      endif
   endif

   if nGroup != nil .and. nGroup != ::nOver
      if ::nOver != nil
         ::aGroups[ ::nOver ]:Paint()
      endif
      ::aGroups[ nGroup ]:Paint( .T. )
      ::nOver = nGroup
      CursorHand()
   endif

   TrackMouseEvent( ::hWnd, TME_LEAVE )

return nil

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

METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TOutLook2010

   local nGroup := ::AtGroup( nRow, nCol )

   if nGroup != nil
      ::SetOption( nGroup )
      if nCol > ::nWidth - 30 .and. nCol < ::nWidth
         if nGroup == Len( ::aGroups )
            ::oPopup:Activate( ::nHeight, ::nWidth + 1, Self, .F., 32 )
         endif
      endif
   endif

return nil

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

METHOD Destroy() CLASS TOutLook2010

   local n

   ::oFontHeader:End()
   ::oFontGroup:End()

   for n = 1 to Len( ::aDialogs )
      ::aDialogs[ n ]:bValid = nil
      ::aDialogs[ n ]:End()
   next

   DeleteObject( ::hBmpDots )

   for n = 1 to Len( ::aGroups )
      ::aGroups[ n ]:Destroy()
   next
   ::oHeader:Destroy()
   ::oPopup:End()

return Super:Destroy()

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

METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TOutLook2010

   if nMsg == WM_MOUSELEAVE
      return ::MouseLeave( nHiWord( nLParam ), nLoWord( nLParam ), nWParam )
   endif

return Super:HandleEvent( nMsg, nWParam, nLParam )

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

METHOD MouseLeave( nRow, nCol, nFlags ) CLASS TOutLook2010

   if ::nOver != nil
      ::aGroups[ ::nOver ]:Paint()
      ::nOver = nil
   endif

return nil

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

METHOD SetOption( nOption ) CLASS TOutLook2010

   local nOldOption := AScan( ::aGroups, { | o | o:lSelected } )

   if nOption > 0 .and. nOption != nOldOption
      ::aGroups[ nOldOption ]:lSelected = .F.
      ::aGroups[ nOldOption ]:nClrStart = LIGHTCYAN
      ::aGroups[ nOldOption ]:nClrEnd   = DARKCYAN
      ::aGroups[ nOldOption ]:Paint()
      ::aGroups[ nOption ]:lSelected = .T.
      ::aGroups[ nOption ]:nClrStart = LIGHTORANGE1
      ::aGroups[ nOption ]:nClrEnd   = DARKORANGE1
      ::aGroups[ nOption ]:Paint( .T. )
      ::oHeader:cPrompt = ::aGroups[ nOption ]:cPrompt
      ::oHeader:Paint()

      if nOldOption <= Len( ::aDialogs ) .and. ::aDialogs[ nOldOption ] != nil
         ::aDialogs[ nOldOption ]:Hide()
      endif

      if nOption <= Len( ::aDialogs ) .and. ::aDialogs[ nOption ] != nil
         ::nOption = nOption
         if ::bChange != nil
            Eval( ::bChange, nOption, nOldOption )
         endif
         ::aDialogs[ nOption ]:AEvalWhen()
         ::aDialogs[ nOption ]:Show()
         ::aDialogs[ nOption ]:SetFocus()
      endif
   endif

return nil

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

METHOD AdjustDialogs( nWidth, nHeight ) CLASS TOutLook2010

   local n

   DEFAULT nWidth := ::nWidth, nHeight := ::nHeight;

   nHeight := Max( 0, nHeight - 6 - ( ( Len( ::aGroups ) + 1 ) * 32 ) )

   for n = 1 to Len( ::aDialogs )
      ::aDialogs[ n ]:SetSize( nWidth, nHeight )
   next

return nil

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

CLASS TOutLook2010Group

   DATA   cPrompt
   DATA   hBmp, hBmpArrow
   DATA   lSelected, lHeader
   DATA   nClrStart, nClrEnd, nClrText
   DATA   oContainer

   METHOD New( cPrompt, oContainer, cBitmap )
   METHOD Paint( lOver )
   METHOD Destroy()

ENDCLASS

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

METHOD New( cPrompt, oContainer, cBitmap ) CLASS TOutLook2010Group

   ::cPrompt    = cPrompt
   ::oContainer = oContainer
   ::lHeader    = ( ::oContainer:oHeader == nil )
   ::lSelected  = ! ::lHeader .and. Len( ::oContainer:aGroups ) == 0
   ::nClrStart  = If( ::lHeader, LIGHTBLUE, If( ::lSelected, LIGHTORANGE1, LIGHTCYAN ) )
   ::nClrEnd    = If( ::lHeader, DARKBLUE, If( ::lSelected, DARKORANGE1, DARKCYAN ) )
   ::nClrText   = If( ::lHeader, CLR_WHITE, CLR_BLACK )
   ::hBmpArrow  = BmpOLArrow()

   if File( cBitmap )
      ::hBmp = ReadBitmap( 0, cBitmap )
   else
      ::hBmp = LoadBitmap( GetResources(), cBitmap )
   endif

return Self

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

METHOD Paint( lOver ) CLASS TOutLook2010Group

   local nTop, hDC, oBmp, oCon := ::oContainer
   local hGrayPen, hOldPen

   DEFAULT lOver := .F.

   if ::lHeader
      nTop = 0
   else
      nTop = oCon:nHeight - ;
             ( ( Len( oCon:aGroups ) + 1 - AScan( oCon:aGroups, { | o | o == Self } ) ) * 32 )
   endif

   if ::lSelected
      GradientFill( hDC := oCon:GetDC(), nTop + 2, 2, nTop + 28, oCon:nWidth() - 2,;
                    { { 0.5, RGB( 222, 227, 233 ), RGB( 209, 213, 222 ) },;
                      { 0.5, RGB( 209, 213, 222 ), RGB( 222, 227, 233 ) } } )  
   else
      FillRect( hDC := oCon:GetDC(), { nTop, 0, nTop + 32, oCon:nWidth() }, oCon:oBrush:hBrush )
   endif
                
   if ! Empty( ::hBmp )
      DrawTransparent( hDC, ::hBmp, nTop + 5, 8 )
   endif
   oCon:Say( nTop + 8 - If( ::lHeader, 2, 0 ), 40 - If( ::lHeader, 30, 0 ),;
             ::cPrompt, If( ::lSelected, ::nClrText, RGB( 57, 75, 97 ) ),,;
             If( ::lHeader, oCon:oFontHeader, oCon:oFontGroup ), .T., ::lSelected )
   if Self == ATail( oCon:aGroups )
      DrawTransparent( hDC, ::hBmpArrow, nTop + 10, oCon:nWidth() - nBmpWidth( ::hBmpArrow ) * 2 )
   endif

   if ::lSelected
      hGrayPen = CreatePen( PS_SOLID, 1, nRGB( 165, 168, 173 ) )
      WndBoxClr( hDC, nTop + 1, 3, nTop + 30, oCon:nWidth - 6, hGrayPen )
      DeleteObject( hGrayPen )
   endif   

   oCon:ReleaseDC()

return nil

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

METHOD Destroy CLASS TOutLook2010Group

   if ! Empty( ::hBmp )
      DeleteObject( ::hBmp )
   endif

   if ! Empty( ::hBmpArrow )
      DeleteObject( ::hBmpArrow )
   endif

return nil

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

test2010.prg

Code: Select all

// FWH Class TOutLook2010

#include "FiveWin.ch"
#include "Splitter.ch"
#include "OutLook.ch"

static lExit := .F.

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

function Main()

   local oWnd, oOutLook2010, oStatusBar, oSplit, cCombo, oRad, nValue := 1
   local oFont, oExBar, oPanel1, oPanel2, bClick := { | o | MsgInfo( o:GetText() ) } 

   DEFINE WINDOW oWnd TITLE "FWH new Class TOutLook2010" MDI // ;
      // MENU BuildMenu()

   DEFINE OUTLOOK2010 oOutLook2010 OF oWnd ;
      PROMPTS "Mail", "Calendar", "Contacts", "" ;
      BITMAPS "..\bitmaps\mail.bmp", "..\bitmaps\calendar.bmp", "..\bitmaps\notes.bmp"
      
   oWnd:oLeft = nil // Because the splitter is going to control the resize   

   @ 0, 0 EXPLORERBAR oExBar OF oOutLook2010:aDialogs[ 1 ] ;
      SIZE oOutLook2010:aDialogs[ 1 ]:nWidth, oOutLook2010:aDialogs[ 1 ]:nHeight 

   oPanel1 = oExBar:AddPanel( "One", "..\bitmaps\32x32\people.bmp" )
   oPanel1:lSpecial = .T.
   oPanel1:AddLink( "First item", bClick, "..\bitmaps\16x16\additem.bmp" )
   oPanel1:AddLink( "Second item", bClick, "..\bitmaps\16x16\copy.bmp" )
      
   oPanel2 = oExBar:AddPanel( "Two", "..\bitmaps\32x32\case.bmp" )
   oPanel2:AddLink( "First item", bClick, "..\bitmaps\16x16\adddbf.bmp" )
   oPanel2:AddLink( "Second item", bClick, "..\bitmaps\16x16\delete0.bmp" )
   oPanel2:AddLink( "Third item", bClick, "..\bitmaps\16x16\envelope.bmp" )
   oPanel2:AddLink( "Fourth item", bClick, "..\bitmaps\16x16\copy.bmp" )      
      
   @ 1, 1 COMBOBOX cCombo ITEMS { "January", "February", "March", "April", "May" } ;
      OF oOutLook2010:aDialogs[ 2 ] SIZE 170, 100 
   
   DEFINE FONT oFont NAME "Arial" SIZE 0, -10
   
   @ 12, 10 SAY Date() OF oOutLook2010:aDialogs[ 2 ] SIZE 80, 20 FONT oFont
   
   @ 3, 1 RADIO oRad VAR nValue OF oOutLook2010:aDialogs[ 2 ] ;
      ITEMS "&Day", "&Week", "&Month" SIZE 100, 20
      
   oRad:SetFont( oFont )   

   @ 1, 2 BUTTON "New" OF oOutLook2010:aDialogs[ 3 ] SIZE 80, 22 ACTION BuildDlg()

   @ 3, 2 BUTTON "Edit" OF oOutLook2010:aDialogs[ 3 ] SIZE 80, 22 ACTION MsgInfo( "Edit" )   

   @ 5, 2 BUTTON "Search" OF oOutLook2010:aDialogs[ 3 ] SIZE 80, 22 ACTION MsgInfo( "Search" )   

   DEFINE STATUSBAR oStatusBar PROMPT "  FWH Class TOutLook2010" OF oWnd

   SetParent( oOutLook2010:hWnd, oWnd:hWnd )
   
   oWnd:oClient = nil
   
   @ 0, 191 SPLITTER oSplit ;
      VERTICAL _3DLOOK ;
      PREVIOUS CONTROLS oOutLook2010 ; 
      HINDS CONTROLS oWnd:oWndClient ;
      SIZE 4, oWnd:nHeight - 70 PIXEL ;
      OF oWnd

   SetParent( oSplit:hWnd, oWnd:hWnd )

   ACTIVATE WINDOW oWnd ;
      ON RESIZE ( oSplit:Adjust(),;
                  WndLeft( oWnd:oWndClient:hWnd, oSplit:nRight + 1 ),;
                  WndWidth( oWnd:oWndClient:hWnd, oWnd:nWidth - oOutLook2010:nWidth - 23 ) ) ; // + 80
      VALID lExit := .T.

return nil

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

function BuildMenu()

   local oMenu
   
   MENU oMenu
      MENUITEM "&One"
      MENUITEM "&Two"
      MENUITEM "&Three"
   ENDMENU
   
return oMenu   

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

function BuildDlg()

   local oDlg, oOutL2010
   
   DEFINE DIALOG oDlg RESOURCE "Test"
   
   REDEFINE OUTLOOK2010 oOutL2010 ID 110 OF oDlg ;
      PROMPTS "One", "Two", "Three" ;
      BITMAPS "..\bitmaps\mail.bmp", "..\bitmaps\calendar.bmp", "..\bitmaps\notes.bmp" ;
      DIALOGS "Page1", "Page2", "Page3"

   REDEFINE BUTTON ID 110 OF oOutL2010:aDialogs[ 1 ] ACTION MsgInfo( "Click" )
      
   ACTIVATE DIALOG oDlg CENTERED
   
return nil      

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

function WinRun()

   while NoGPF()
      if lExit
         PostQuitMessage( 0 )
      endif   
   end
   
return nil         
                
//----------------------------------------------------------------------------//

#pragma BEGINDUMP

#include <windows.h>
#include <hbapi.h>

BOOL SysRefresh( void );

HB_FUNC( NOGPF )
{
   __try
   {
      hb_retl( SysRefresh() );
   }
   __except ( ( hb_retl( TRUE ), TRUE ) )
   {} 
}

#pragma ENDDUMP 

En wndboxes.c

Code: Select all

HB_FUNC( WNDBOXCLR ) // ( hDC, nTop, nLeft, nBottom, nRight, hPen )
{
   RECT rct;

   rct.top    = hb_parni( 2 );
   rct.left   = hb_parni( 3 );
   rct.bottom = hb_parni( 4 );
   rct.right  = hb_parni( 5 );

   WndDrawBox( ( HDC ) hb_parnl( 1 ), &rct,
               ( HPEN ) hb_parnl( 6 ),
               ( HPEN ) hb_parnl( 6 ) );
}

outlook.ch

Code: Select all

#ifndef _OUTLOOK_CH
#define _OUTLOOK_CH

/*----------------------------------------------------------------------------//
!short: OUTLOOK  */

#xcommand @ <nRow>, <nCol> OUTLOOK [<oOut>] ;
            [ SIZE <nWidth>, <nHeight> ] ;
            [ <color: COLOR, COLORS> <nClrFore> [,<nClrBack>] ] ;
            [ STYLE <nStyle> ] ;
            [ FONT <oFont> ] ;
            [ <lPixel: PIXEL> ] ;
            [ <of: OF, WINDOW, DIALOG> <oWnd> ] ;
            [ <help: HELP, HELPID> <nHelpId> ] ;
            [ ON RIGHT CLICK <uRClicked> ] ;
         => ;
            [<oOut> := ] TOutLook():New( <nRow>, <nCol>, ;
               <nWidth>, <nHeight>, ;
               <nClrFore>, <nClrBack>, <nStyle>, <oFont>, ;
               <.lPixel.>, <oWnd>, <nHelpId>, ;
               [{|nRow,nCol,nFlags|<uRClicked>}] )

#xcommand DEFINE GROUP OF OUTLOOK <oOut> ;
            [ PROMPT <cPrompt> ] ;
            [ WHEN <bWhen> ] ;
            [ MESSAGE <cMsg> ] ;
            [ FONT <oFont> ] ;
         => ;
            <oOut>:AddGroup( <cPrompt>, ;
               [{|Self|<bWhen>}], <cMsg>, <oFont> )

#xcommand DEFINE BITMAP OF OUTLOOK <oOut> ;
            [ GROUP <nGroup> ] ;
            [ PROMPT <cPrompt> ] ;
            [ <action: ACTION, ON CLICK> <uAction> ] ;
            [ ON RIGHT CLICK <uRClicked> ] ;
            [ BITMAP <cBmp> ] ;
            [ RESOURCE <cResBmp> ] ;
            [ WHEN <bWhen> ] ;
            [ MESSAGE <cMsg> ] ;
            [ FONT <oFont> ] ;
            [ <lAdjust: ADJUST> ] ;
            [ <lBorder: BORDER> ] ;
            [ TOOLTIP <cToolTip> ] ;
         => ;
            <oOut>:AddItem( <cPrompt>, <cBmp>, <cResBmp>, ;
               [{|Self, oBmp, oSay|<uAction>}], <nGroup>, ;
               [{|Self|<bWhen>}], <cMsg>, ;
               [{|nRow,nCol,nFlags|<uRClicked>}], <oFont>, ;
               <.lAdjust.>, <.lBorder.>, <cToolTip>, .f. )

// OutLook 2003
               
#xcommand DEFINE OUTLOOK2003 <oOut> ;
             [ <of: OF, WINDOW, DIALOG> <oWnd> ] ;
             [ <prm: PROMPT, PROMPTS, ITEMS> <cPrompt,...> ] ;
             [ <bmp: BITMAPS, IMAGES> <cBmpName,...> ] ;
             [ ON CHANGE <uChange> ] ;
          => ;
          [ <oOut> := ] TOutLook2003():New( [<oWnd>], [\{<cPrompt>\}],;
             [\{<cBmpName>\}], [{|nOption,nOldOption| <uChange>}] )

#xcommand REDEFINE OUTLOOK2003 <oOut> ;
             [ ID <nId> ] ;
             [ <of: OF, WINDOW, DIALOG> <oWnd> ] ;
             [ <prm: PROMPT, PROMPTS, ITEMS> <cPrompt,...> ] ;
             [ <bmp: BITMAPS, IMAGES> <cBmpName,...> ] ;
             [ <dlg: DIALOG, DIALOGS, PAGE, PAGES> <cDlgName,...> ] ;
             [ ON CHANGE <uChange> ] ;
          => ;
          [ <oOut> := ] TOutLook2003():Redefine( [<nId>], [<oWnd>], [\{<cPrompt>\}],;
             [\{<cBmpName>\}], [{|nOption,nOldOption| <uChange>}], [\{<cDlgName>\}], )

// OutLook 2010
               
#xcommand DEFINE OUTLOOK2010 <oOut> ;
             [ <of: OF, WINDOW, DIALOG> <oWnd> ] ;
             [ <prm: PROMPT, PROMPTS, ITEMS> <cPrompt,...> ] ;
             [ <bmp: BITMAPS, IMAGES> <cBmpName,...> ] ;
             [ ON CHANGE <uChange> ] ;
          => ;
          [ <oOut> := ] TOutLook2010():New( [<oWnd>], [\{<cPrompt>\}],;
             [\{<cBmpName>\}], [{|nOption,nOldOption| <uChange>}] )

#xcommand REDEFINE OUTLOOK2010 <oOut> ;
             [ ID <nId> ] ;
             [ <of: OF, WINDOW, DIALOG> <oWnd> ] ;
             [ <prm: PROMPT, PROMPTS, ITEMS> <cPrompt,...> ] ;
             [ <bmp: BITMAPS, IMAGES> <cBmpName,...> ] ;
             [ <dlg: DIALOG, DIALOGS, PAGE, PAGES> <cDlgName,...> ] ;
             [ ON CHANGE <uChange> ] ;
          => ;
          [ <oOut> := ] TOutLook2010():Redefine( [<nId>], [<oWnd>], [\{<cPrompt>\}],;
             [\{<cBmpName>\}], [{|nOption,nOldOption| <uChange>}], [\{<cDlgName>\}], )

#endif   // _OUTLOOK_CH
//--------------------------------------------------------------------------//

De FiveWin.ch eliminamos OUTLOOK2003

[acuellar]

Gracias Antonio

No se como asociar el archivo C, lo coloco como un PRG mas y me da este error.

Code: Select all

--------------------Configuración: ACR - Release--------------------
Embarcadero C++ 6.30 for Win32 Copyright (c) 1993-2010 Embarcadero Technologies, Inc.
D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c:
Error E2451 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 3: Undefined symbol 'RECT' in function HB_FUNC
Error E2379 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 3: Statement missing ; in function HB_FUNC
Error E2451 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 5: Undefined symbol 'rct' in function HB_FUNC
Warning W8065 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 5: Call to function 'hb_parni' with no prototype in function HB_FUNC
Warning W8065 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 6: Call to function 'hb_parni' with no prototype in function HB_FUNC
Warning W8065 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 7: Call to function 'hb_parni' with no prototype in function HB_FUNC
Warning W8065 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 8: Call to function 'hb_parni' with no prototype in function HB_FUNC
Error E2451 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 10: Undefined symbol 'HDC' in function HB_FUNC
Error E2121 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 10: Function call missing ) in function HB_FUNC
Warning W8070 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 13: Function should return a value in function HB_FUNC
Warning W8057 D:\Sistemas\AcrSoft\OK\PRG\wndboxes.c 13: Parameter 'WNDBOXCLR' is never used in function HB_FUNC
*** 5 errors in Compile ***
Turbo Incremental Link 6.10 Copyright (c) 1997-2010 Embarcadero Technologies, Inc.
Fatal: Unable to open file 'WNDBOXES.OBJ'
"D:\Sistemas\AcrSoft\OK\\ACR.EXE" no se reconoce como un comando interno o externo,
programa o archivo por lotes ejecutable.
ACR.EXE - 6 error(es), 6 advertencia(s)
 

Uso UEstudio para enlazar

Aqui otra imagen con la parte superior.


Gracias por su tiempo y ayuda

Saludos,

Adhemar

[Antonio Linares]

Adhemar,

El código en C lo puedes incluir en cualquiera de los dos PRGs de esta forma:

Code: Select all

#pragma BEGINDUMP

#include <windows.h>
#include <hbapi.h>

HB_FUNC( WNDBOXCLR ) // ( hDC, nTop, nLeft, nBottom, nRight, hPen )
{
   RECT rct;

   rct.top    = hb_parni( 2 );
   rct.left   = hb_parni( 3 );
   rct.bottom = hb_parni( 4 );
   rct.right  = hb_parni( 5 );

   WndDrawBox( ( HDC ) hb_parnl( 1 ), &rct,
               ( HPEN ) hb_parnl( 6 ),
               ( HPEN ) hb_parnl( 6 ) );
}

#pragma ENDDUMP
 

[acuellar]

Gracias Antonio

Funcionó perfecto

Cómo se hace para que cuando se pulse sobre un boton se mantenga como pulsado, o el texto cambie de color
Estoy haciendo asi:

Code: Select all

  @ 4, 75 BTNBMP oBMP OF oOutlook2010:aDialogs[ 1 ] SIZE 37,37 RESOURCE "BOTON1","BOTON2" ACTION MuestraDatos(1) NOBORDER 2007 
   @ 2.7,7 SAY oSay PROMPT " Muestra datos" OF oOutlook2010:aDialogs[ 1 ] SIZE 100, 22 FONT oFont CENTER
 

Agradecido por su tiempo

Saludos,

Adhemar

[Antonio Linares]

Adhemar,

Prueba con:

oBtnBmp:lPressed := .T.
oBtnBmp:Refresh()

[acuellar]

Gracias Antonio

He intentado de varias formas y no mantiene el boton como pulsado.

Porqué me salen estas advertencias

Code: Select all

Warning W8019 D:\COMPILER\BCC63\include\windows\winnt.h 14966: Code has no effect in function TpDestroyCallbackEnviron
Warning W8065 D:\\Sistemas\\AcrSoft\\MOVIES\\PRG\\MOVIES.PRG 456: Call to function 'WndDrawBox' with no prototype in function HB_FUN_WNDBOXCLR
SISTEMA.EXE - 0 error(es), 2 advertencia(s)
 

Agradezco su tiempo.

Saludos,

Adhemar

[fgondi]

También se podría dotar de acción a la posibilidad de ocultar botones inferiores

Osea que al pulsar los puntos (en la versión 2003) o la barra (en la versión 2010) que hay antes de los botones inferiores, se fueran ocultando dichos botones. Tal y como hace outlook.

[Antonio Linares]

Adhemar,

Te refieres a que la opción seleccionada del control OutLook, su botón se muestre "pulsado" (hundido) ?

[acuellar]

Exacto Antonio, que se muestre pulsado, que mantenga el color del focus o cambiando el color del texto.

Normal


Pulsado


Gracias

Saludos,

Adhemar

[acuellar]

Distinguidos,

Cuando pulso sobre un botton del Outlook para cambiar de grupo muestro un Browse pero no logro que el Focus pase al Browse si no doy Click sobre el ó pulsando Enter

Lo hago asi:

Code: Select all

oOut:bChange:={ |nOption| (Muestra(nOption),oBrw:Setfocus() )  }
 

Gracias por la ayuda

Saludos,

Adhemar

[AIDA]

Muy interesante


Saluditos

[RuFerSo]

Adhemar puedes probar asi:
(oOut:oJump:=oBrw,oBrw:SetFocus() )

Saludos

Ruben Fernandez

[acuellar]

Gracias Ruben

Lo intente y no funciona, el focus se mantiene en oOut

Saldudos,

Adhemar

[pcordonet]

Hola, a partir de que versión es compatible esta classe tOutlook2010 ?

Tengo la versión 10.2 y no puedo compilar ya que no encuentra EXPLORERBAR.

Muchas gracias.