topic-46220

Board index FiveWin para Harbour/xHarbour Calendario echo con Xbrowse

Posts: 537

Joined: Mon Jan 16, 2006 03:42 PM

Calendario echo con Xbrowse
Posted: Sat Dec 27, 2025 02:31 AM

Hola colega, quería tener un calendario con xbrowse asi que aca esta para quienes quieren ocuparlo o mejorarlo.
aca una Imagen

y aca el codigo:

STATIC oDlg,oFecha,oCal,oBtn ,cPrompt
STATIC cMeses := { "Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio", ;
"Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre" }

function Main()

SET EPOCH TO 2005
SET DATE FORMAT "dd-mm-yyyy"

CalendarView( Date() )
return nil

// ----------------------------------------------
// Ventana Calendario
// ----------------------------------------------
function CalendarView( dFecha )

local oDlg, oBrw,oFntCal,oBtnPrev ,oBtnNext ,i,oBtnText,n
local aDatos := CalendarArray( dFecha )
LOCAL nFondo := RGB(200, 200, 255) // Color gris claro
LOCAL nTexto := RGB(0, 0, 0) // Negro

Code: Select all Collapse

cPrompt:= cMeses[MONTH(dFecha )]+"  "+ Str(YEAR(dFecha),4)

DEFINE FONT oFntCal NAME "Segoe UI" SIZE 0, -16

DEFINE DIALOG oDlg FROM 370,890 TO 680,1160 PIXEL STYLE DS_MODALFRAME FONT oFntCal //| WS_BORDER | WS_POPUP

@ 15,1 XBROWSE oBrw OF oDlg ARRAY aDatos ;
COLUMNS 1,2,3,4,5,6,7 ;
HEADERS "Lun","Mar","Mié","Jue","Vie","Sáb","Dom" ;
SIZE 142, 110 PIXEL;
JUSTIFY AL_CENTER,AL_CENTER,AL_CENTER,AL_CENTER,AL_CENTER,AL_CENTER,AL_CENTER;
COLSIZES 35,35,35,35,35,35,35

oBrw:nStretchCol := STRETCHCOL_WIDEST
oBrw:CreateFromCode()
obrw:nColDividerStyle := LINESTYLE_RAISED
oBrw:nRowDividerStyle := LINESTYLE_RAISED
oBrw:lRecordSelector := .F.
oBrw:nHeaderHeight := 30
oBrw:lHScroll := .T.
oBrw:lVScroll := .T.
oBrw:l2007 := (.F.)
oBrw:bClrHeader := { || {CLR_WHITE,RGB(134, 219, 9)} }

FOR n = 1 TO Len( oBrw:aCols )
oBrw:aCols[n]:nHeadStrAlign:= AL_CENTER

Code: Select all Collapse

*  oBrw:aCols[n]:bClrStd := { || ChangeColor( oBrw, n,dFecha ) }

oBrw:aCols[1]:bClrStd := { ColorCelda( oBrw, 1,dFecha ) }
oBrw:aCols[2]:bClrStd := { ColorCelda( oBrw, 2,dFecha ) }
oBrw:aCols[3]:bClrStd := { ColorCelda( oBrw, 3,dFecha ) }
oBrw:aCols[4]:bClrStd := { ColorCelda( oBrw, 4,dFecha ) }
oBrw:aCols[5]:bClrStd := { ColorCelda( oBrw, 5,dFecha ) }
oBrw:aCols[6]:bClrStd := { ColorCelda( oBrw, 6,dFecha ) }
oBrw:aCols[7]:bClrStd := { || ColorCelda( oBrw, 7,dFecha ) }
*/

@ 00,05 BTNBMP oBtnPrev PROMPT "<" OF oDlg SIZE 20, 14 PIXEL ;
ACTION ( dFecha := AddMonth( dFecha, -1 ), ;
aDatos := CalendarArray( dFecha ), ;
oBrw:SetArray( aDatos ), ;
oBrw:Refresh(), ;
ActualizarBotones( oBtnPrev, dFecha, oDlg,oBtnText ) )
oBtnPrev:lTransparent = .F.
oBtnPrev:SETCOLOR(CLR_WHITE,RGB(134,219,9 ))

@ 00,113 BTNBMP oBtnNext PROMPT ">" OF oDlg SIZE 20, 14 PIXEL ;
ACTION ( dFecha := AddMonth( dFecha, 1 ), ;
aDatos := CalendarArray( dFecha ), ;
oBrw:SetArray( aDatos ), ;
oBrw:Refresh(), ;
ActualizarBotones( oBtnPrev, dFecha, oDlg,oBtnText ) )
oBtnNext:lTransparent = .F.
oBtnNext:SETCOLOR(CLR_WHITE,RGB(134,219,9 ))

Code: Select all Collapse

 @  00,24 BTNBMP oBtnText PROMPT cPrompt OF oDlg SIZE 90, 14 PIXEL ;

oBtnText:lTransparent = .F.
oBtnText:SETCOLOR(CLR_WHITE,RGB(134,219,9 ))

ACTIVATE DIALOG oDlg CENTER on init (oBtnPrev:Hide())
return nil

// Función para controlar el estado del botón
static function ActualizarBotones( oBtnPrev, dFecha, oDlg,oBtnText )
local dHoy := Date()

Code: Select all Collapse

cPrompt:= cMeses[MONTH(dFecha )]+"  "+ Str(YEAR(dFecha),4)

if Month(dFecha) == Month(dHoy) .and. Year(dFecha) == Year(dHoy)
*oBtnPrev:Disable()
oBtnPrev:Hide()
else
oBtnPrev:Enable()
oBtnPrev:Show()
endif

oBtnText:Setcolor(CLR_WHITE,RGB(134, 219, 9 ))
oBtnText:setText(cPrompt )
oBtnText:Refresh()
return nil

// ----------------------------------------------------
// Genera un calendario mensual (6x7)
// ----------------------------------------------------
function CalendarArray( dFecha )

local aCal := {}
local dPrimDia, nDiaSemana, nDiasMes
local i, j, nDia := 1

// Primer día del mes (sin CTOD)
dPrimDia := dFecha - ( Day( dFecha ) - 1 )

// DOW: Domingo=1 ? cambiamos a Lunes=1
nDiaSemana := DOW( dPrimDia )
if nDiaSemana == 1
nDiaSemana := 7
else
nDiaSemana--
endif

// días del mes
nDiasMes := Day( EOM( dFecha ) )

// crear matriz 6x7
for i := 1 to 6
aAdd( aCal, Array(7) )
next

// llenar calendario
for i := 1 to 6
for j := 1 to 7
if (i == 1 .and. j < nDiaSemana) .or. nDia > nDiasMes
aCal[j] := ""
else
aCal[j] := LTrim( Str( nDia ) )
nDia++
endif
next
next

return aCal

STATIC FUNCTION ColorCelda( oBrw, nCol, dFecha )
LOCAL aColor := { CLR_BLACK, CLR_WHITE }
LOCAL nFila := oBrw:nArrayAt
LOCAL nDia
local dHoy := Date()
local nColorBkg := CLR_WHITE
local cValue := oBrw:SelectedCol():Value

IF nFila > 0 .AND. nFila <= 7

TRY
nDia:= oBrw:aArrayData[ nFila ][ nCol ]

If Year(dFecha) == Year(dHoy) .and. Month(dFecha) == Month(dHoy)

If ValType( nDia ) == "N"
if val(nDia) < Day(dHoy)
aColor := { RGB( 180, 180, 180 ),CLR_WHITE } // GRIS para días pasados

elseif Val(nDia) == Day(dHoy)
aColor := { CLR_WHITE,RGB(134, 219, 9) }

endif
Endif

Endif

CATCH
// Si el XBrowse intenta inventar una fila, devolvemos color neutro
aColor := { CLR_BLACK, CLR_WHITE }
END

Endif

RETURN aColor

Saludos

sysctrl2

Posts: 1144

Joined: Mon Feb 05, 2007 07:15 PM

Re: Calendario echo con Xbrowse
Posted: Sat Dec 27, 2025 06:14 PM

No sabía que era con xBrowse

Cesar Cortes Cruz

SysCtrl Software

Mexico

' Sin +- FWH es mejor "

karinha

Posts: 8515

Joined: Tue Dec 20, 2005 07:36 PM

Re: Calendario echo con Xbrowse
Posted: Sat Dec 27, 2025 08:26 PM

Excelente, gracias jBrita.

Code: Select all Collapse

// C:\FWH\SAMPLES\JBRITCAL.PRG

#include "FiveWin.ch"

REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850

STATIC oDlg, oFecha, oCal, oBtn, cPrompt
STATIC nLanguage
STATIC cMeses

FUNCTION Main()

   HB_GCALL( .F. )
   HB_LANGSELECT( 'PT' ) // Default language is now Portuguese
   HB_SETCODEPAGE( "PT850" )
   HB_CDPSELECT( "PTISO" )

   // 1 English, 2 Spanish, 3 French, 4 Portugese, 5 German, 6 Italian
   DEFAULT nLanguage := FWSetLanguage()
   nLanguage := 4
   FWSetLanguage( nLanguage )

   // SET EPOCH TO 2005
   SET CENTURY ON
   SET DATE BRITISH
   SET TIME FORMAT TO "HH:MM:SS"
   SET EPOCH TO YEAR( DATE() ) - 30
   SET SOFTSEEK OFF
   SET WRAP ON
   SETCANCEL( .F. )
   SET CONFIRM OFF
   SET DELETED ON
   SET _3DLOOK ON
   SET UNIQUE OFF
   SET ESCAPE OFF
   SET EXACT ON
   SET EXCLUSIVE OFF
   SET MULTIPLE OFF
   SET OPTIMIZE ON 
   SET DATE FORMAT "dd-mm-yyyy"

   IF nLanguage == 4

  cMeses := { "janeiro", "Fevereiro", "Março", "Abril", "Maio", "Junho", ;
              "Julho", "Agosto", "Setembro", "Otubro", "Novembro",       ;
              "Dezembro" }


   ELSEIF nLanguage == 2 // Spanish.

  cMeses := { "Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio",   ;
              "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", ;
              "Diciembre" }

   ENDIF

   CalendarView( Date() )

RETURN NIL
// ----------------------------------------------
// Ventana Calendario
// ----------------------------------------------
FUNCTION CalendarView( dFecha )

   LOCAL oDlg, oBrw, oFont, oFntCal, oBtnPrev, oBtnNext, i, oBtnText, n
   LOCAL aDatos := CalendarArray( dFecha )
   LOCAL nFondo := RGB( 200, 200, 255 ) // Color gris claro
   LOCAL nTexto := RGB( 0, 0, 0 )       // Negro

   cPrompt := cMeses[ Month( dFecha ) ] + "  " + Str( Year( dFecha ), 4 )

   DEFINE FONT oFntCal NAME "Segoe UI" SIZE 0, -16
   DEFINE FONT oFont   NAME "Ms Sans Serif"  SIZE 00, -12 BOLD

   DEFINE DIALOG oDlg  FROM 370, 890 TO 680, 1160 PIXEL  STYLE DS_MODALFRAME ;
      FONT oFntCal // | WS_BORDER | WS_POPUP

   IF nLanguage == 4 // Portuguese

  @ 15, 1 XBROWSE oBrw OF oDlg ARRAY aDatos ;
     COLUMNS 1, 2, 3, 4, 5, 6, 7 ;
     HEADERS "Seg", "Ter", "Qua", "Qui", "Sex", "Sáb", "Dom"  ;
     SIZE 142, 110 PIXEL;
     JUSTIFY AL_CENTER, AL_CENTER, AL_CENTER, AL_CENTER, AL_CENTER, AL_CENTER, AL_CENTER ;
     COLSIZES 35, 35, 35, 35, 35, 35, 35

   ELSEIF nLanguage == 2 // Spanish.

  @ 15, 1 XBROWSE oBrw OF oDlg ARRAY aDatos ;
     COLUMNS 1, 2, 3, 4, 5, 6, 7 ;
     HEADERS "Lun", "Mar", "Mié", "Jue", "Vie", "Sáb", "Dom"  ;
     SIZE 142, 110 PIXEL;
     JUSTIFY AL_CENTER, AL_CENTER, AL_CENTER, AL_CENTER, AL_CENTER, AL_CENTER, AL_CENTER ;
     COLSIZES 35, 35, 35, 35, 35, 35, 35

   ENDIF

   oBrw:nStretchCol := STRETCHCOL_WIDEST
   oBrw:CreateFromCode()
   obrw:nColDividerStyle  := LINESTYLE_RAISED
   oBrw:nRowDividerStyle  := LINESTYLE_RAISED
   oBrw:lRecordSelector   := .F.
   oBrw:nHeaderHeight     := 30
   oBrw:lHScroll          := .T.
   oBrw:lVScroll          := .T.
   oBrw:l2007             := ( .F. )
   oBrw:bClrHeader   := {|| { CLR_WHITE, RGB( 134, 219, 9 ) } }

   FOR n = 1 TO Len( oBrw:aCols )

  oBrw:aCols[ n ]:nHeadStrAlign := AL_CENTER

  // oBrw:aCols[n]:bClrStd := { || ChangeColor( oBrw, n,dFecha ) }

   NEXT

   oBrw:aCols[ 1 ]:bClrStd := {|| ColorCelda( oBrw, 1, dFecha ) }
   oBrw:aCols[ 2 ]:bClrStd := {|| ColorCelda( oBrw, 2, dFecha ) }
   oBrw:aCols[ 3 ]:bClrStd := {|| ColorCelda( oBrw, 3, dFecha ) }
   oBrw:aCols[ 4 ]:bClrStd := {|| ColorCelda( oBrw, 4, dFecha ) }
   oBrw:aCols[ 5 ]:bClrStd := {|| ColorCelda( oBrw, 5, dFecha ) }
   oBrw:aCols[ 6 ]:bClrStd := {|| ColorCelda( oBrw, 6, dFecha ) }
   oBrw:aCols[ 7 ]:bClrStd := {|| ColorCelda( oBrw, 7, dFecha ) }

   @ 00, 05 BTNBMP oBtnPrev PROMPT "<" OF oDlg SIZE 20, 30 PIXEL CENTER ;
      FONT oFont ACTION ( dFecha := AddMonth( dFecha, - 1 ), ;
               aDatos := CalendarArray( dFecha ), ;
               oBrw:SetArray( aDatos ), ;
               oBrw:Refresh(), ;
      ActualizarBotones( oBtnPrev, dFecha, oDlg, oBtnText ) )

   oBtnPrev:lTransparent = .F.
   oBtnPrev:SetColor( CLR_WHITE, RGB( 134, 219, 9 ) )
   //    113
   @ 00, 130 BTNBMP oBtnNext PROMPT ">" OF oDlg SIZE 20, 30 PIXEL CENTER ;
      FONT oFont ACTION ( dFecha := AddMonth( dFecha, 1 ), ;
               aDatos := CalendarArray( dFecha ), ;
               oBrw:SetArray( aDatos ), ;
               oBrw:Refresh(), ;
      ActualizarBotones( oBtnPrev, dFecha, oDlg,oBtnText ) )
                         oBtnNext:lTransparent = .F.
                         oBtnNext:SETCOLOR(CLR_WHITE,RGB(134,219,9 ))

   oBtnNext:lTransparent = .F.
   oBtnNext:SetColor( CLR_WHITE, RGB( 134, 219, 9 ) )

   // NO ESTA BIEN CON XHARBOUR.                      // 90  14
   @ 00, 24 BTNBMP oBtnText PROMPT cPrompt OF oDlg SIZE 110, 30 PIXEL CENTER ;
      FONT oFont

   oBtnText:lTransparent = .F.
   oBtnText:SetColor( CLR_WHITE, RGB( 134, 219, 9 ) )

   ACTIVATE DIALOG oDlg CENTERED ;
      ON INIT( oBtnPrev:Hide() )

   oFntCal:End()
   oFont:End()

RETURN NIL
// Función para controlar el estado del botón
STATIC FUNCTION ActualizarBotones( oBtnPrev, dFecha, oDlg, oBtnText )

   LOCAL dHoy := Date()

   cPrompt := cMeses[ Month( dFecha ) ] + "  " + Str( Year( dFecha ), 4 )

   IF Month( dFecha ) == Month( dHoy ) .AND. Year( dFecha ) == Year( dHoy )

  // oBtnPrev:Disable()
  oBtnPrev:Hide()

   ELSE

  oBtnPrev:Enable()
  oBtnPrev:Show()

   ENDIF

   oBtnText:SetColor( CLR_WHITE, RGB( 134, 219, 9 ) )
   oBtnText:setText( cPrompt )
   oBtnText:Refresh()

RETURN NIL
// ----------------------------------------------------
// Genera un calendario mensual (6x7)
// ----------------------------------------------------
FUNCTION CalendarArray( dFecha )

   LOCAL aCal := {}
   LOCAL dPrimDia, nDiaSemana, nDiasMes
   LOCAL i, j, nDia := 1

   // Primer día del mes (sin CTOD)
   dPrimDia := dFecha - ( Day( dFecha ) - 1 )

   // DOW: Domingo=1 ? cambiamos a Lunes=1
   nDiaSemana := DoW( dPrimDia )

   IF nDiaSemana == 1

  nDiaSemana := 7

   ELSE

  nDiaSemana--

   ENDIF

   // días del mes
   nDiasMes := Day( EoM( dFecha ) )

   // crear matriz 6x7
   FOR i := 1 TO 6

  AAdd( aCal, Array( 7 ) )

   NEXT

   // llenar calendario
   FOR i := 1 TO 6

  FOR j := 1 TO 7

     IF ( i == 1 .AND. j < nDiaSemana ) .OR. nDia > nDiasMes

        aCal[ i ][ j ] := ""

     ELSE

        aCal[ i ][ j ] := LTrim( Str( nDia ) )

        nDia++

     ENDIF

  NEXT

   NEXT

 RETURN aCal

STATIC FUNCTION ColorCelda( oBrw, nCol, dFecha )

   LOCAL aColor := { CLR_BLACK, CLR_WHITE }
   LOCAL nFila  := oBrw:nArrayAt
   LOCAL nDia
   LOCAL dHoy      := Date()
   LOCAL nColorBkg := CLR_WHITE
   LOCAL cValue    := oBrw:SelectedCol():Value

   IF nFila > 0 .AND. nFila <= 7

  TRY

     nDia := oBrw:aArrayData[ nFila ][ nCol ]

     IF Year( dFecha ) == Year( dHoy ) .AND. Month( dFecha ) == Month( dHoy )

        // If ValType( nDia ) == "N"

        IF Val( nDia ) < Day( dHoy )

           aColor := { RGB( 180, 180, 180 ), CLR_WHITE } // GRIS para días pasados

        ELSEIF Val( nDia ) == Day( dHoy )

           aColor := { CLR_WHITE, RGB( 134, 219, 9 ) }

        ENDIF

        // Endif

     ENDIF

  CATCH

     // Si el XBrowse intenta inventar una fila, devolvemos color neutro
     aColor := { CLR_BLACK, CLR_WHITE }

  END

   ENDIF

RETURN aColor

// FIN / END

Regards, saludos.

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341

FiveTech Support Forums

Continue the discussion