/*
 * CalendarMod.prg
 * Control TCalendar moderno
 *
 * Copyright 2020 Ignacio Ortiz de Zúñiga
 * Copyright 2020 https://Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"

CLASS XCalendarMod FROM TWinControl

PUBLISHED:
   PROPERTY oFontHeader       WRITE METHOD SetFontHeader EDITOR PE_Font
   PROPERTY oFontDOW          WRITE METHOD SetFontDOW    EDITOR PE_Font
   PROPERTY dValue            INIT Date() WRITE SelectDate
   PROPERTY nWidth            INIT 294
   PROPERTY nHeight           INIT 337

   PROPERTY lHighLiteToday    INIT .T. ;
                              WRITE INLINE ::FlHighLiteToday := Value, ::Refresh()
   PROPERTY lShowDOW          INIT .T. ;
                              WRITE INLINE ::FlSHowDOW := Value, ::Refresh()
   PROPERTY lShowLines        INIT .T. ;
                              WRITE INLINE ::FlSHowLines := Value, ::Refresh()
   PROPERTY lShowFirstOfGroup INIT .F. ;
                              WRITE INLINE ::FlSHowFirstOfGroup := Value, ::Refresh()
   PROPERTY nClrBorder        INIT clActiveBorder  EDITOR PE_Color
   PROPERTY nClrToday         INIT clSystem        EDITOR PE_Color
   PROPERTY nClrSelection     INIT clSystem        EDITOR PE_Color
   PROPERTY nClrHot           INIT clGray          EDITOR PE_Color
   PROPERTY nClrDaysDisabled  INIT cl3DLight       EDITOR PE_Color
   PROPERTY nClrTextHeader    INIT clWindowText    EDITOR PE_Color ;
                              WRITE METHOD SetClrTextHeader
   PROPERTY lTransparent      INIT .F.
   PROPERTY nDisplayMode      INIT dmMonth VALUES dmMonth, dmYear, dmDecade ;
                              WRITE METHOD SetDisplayMode
   PROPERTY nNumberOfWeeks    INIT 6 ;
                              WRITE INLINE ::FnNumberOfWeeks := Value, ::Refresh()
   PROPERTY nSelectionMode    INIT smSingle VALUES smSingle, smMultiple, smNone ;
                              WRITE METHOD SetSelectionMode

   PROPERTY lParentFont
   PROPERTY lTabStop          INIT .t.

   EVENT OnSelect( oSender, dValue ) // --> Nil
   EVENT OnChange( oSender )  // --> Nil
   EVENT OnChangeView( oSender, nOldMode, nNewMode )
   EVENT OnClick( oSender )
   EVENT OnCheckDate( oSender, dDate ) // -> Nil | lValid
   EVENT OnDrawItem( oSender, dDay, nClrText, nClrPane, hDC, aRect ) // --> NIL | lPaint

PUBLIC:
   PROPERTY oHeader         AS TButtonMod
   PROPERTY oPrev           AS TButtonMod
   PROPERTY oNext           AS TButtonMod
   DATA aDaysSelected       INIT {}
   DATA aMonths, aDays, aSmonths, aSdays

   METHOD New( oParent )    CONSTRUCTOR
   METHOD Create( oParent ) CONSTRUCTOR

PROTECTED:
   PROPERTY oBkgnd
   PROPERTY nBkgndMode
   PROPERTY nBkgndMarginX
   PROPERTY nBkgndMarginY
   PROPERTY nGradient
   PROPERTY nClrPaneEnd
   PROPERTY nBorderStyle   INIT bvnone //bvWIN10
   PROPERTY cText
   PROPERTY lBorder        INIT .F.
   PROPERTY l3D
   PROPERTY oBrush
   DATA oFontGroup
   DATA nCtlStyle          INIT nOr( WS_CHILD, WS_CLIPCHILDREN, WS_CLIPSIBLINGS )
   DATA dWork
   DATA nCellW, nCellH     INIT 0
   DATA nDOWRow            INIT 0
   DATA nCellRow           INIT 0
   DATA nCellFocus         INIT 0
   DATA lPushed            INIT .F.

RESERVED:
   DATA aHotPos

   METHOD Free()
   METHOD Adjust()
   METHOD ClickOnHeader()
   METHOD ClickOnButton( nDirection )
   METHOD Paint( hDC )
   METHOD PaintDays( hDC )
   METHOD PaintMonths( hDC )
   METHOD PaintYears( hDC )
   METHOD SetFontHeader( oFont )
   METHOD SetClrTextHeader( nColor )
   METHOD SetDisplayMode( nValue )
   METHOD SetSelectionMode( nValue )
   METHOD SetFontDOW( oFont )
   METHOD HitTest( aPos )
   METHOD SelectDate( dValue )
   METHOD SelectDay( xPos )
   METHOD SelectMonth( XPos )
   METHOD SelectYear( xPos )
   METHOD GoUp()
   METHOD GoDown()
   METHOD GoLeft()
   METHOD GoRight()
   METHOD PaintBtnArrows( hDC, aRect, lUp )

   METHOD WMPaint()
   METHOD WMPrintClient() EXTERN XCalendarMod_WMPaint()
   METHOD WMEraseBkgnd() INLINE 1
   METHOD WMMouseMove( nWParam, nLParam, hWnd )
   METHOD WMMouseLeave()
   METHOD WMLButtonDown( nWParam, nLParam )
   METHOD WMLButtonUp( nWParam, nLParam )
   METHOD WMKeyDown( nFlags, nLParam, hWnd )
   METHOD WMMouseWheel( nWParam, nLParam )
   METHOD WMSize( nWParam, nLParam )
   METHOD WMKillFocus( hCtl ) INLINE ( ::Super:WMKillFocus( hCtl ), ::Refresh( .F. ) )
   METHOD WMSetFocus( hCtl )  INLINE ( ::Super:WMSetFocus( hCtl ),  ::Refresh( .F. ) )

   METHOD XAClick() VIRTUAL

ENDCLASS

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

METHOD New( oParent ) CLASS XCalendarMod

   UPDATE ::oParent TO oParent

   ::Super:New()

   ::aMonths  := XA_MonthNames()
   ::aDays    := XA_DaysOfTheWeek()
   ::aSmonths := XA_MonthNames( .t. )
   ::aSdays   := XA_DaysOfTheWeek( .t. )

   ::oFontHeader := TFont():Create( "Segoe UI", 15, 0, 400 )
   ::oFontDOW    := TFont():Create( "Segoe UI", 10, 0, 400 )
   ::oFontGroup  := TFont():Create( "Segoe UI", 8, 0, 400 )

//   ::dWork := ::dValue

RETURN Self

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

METHOD Create( oParent ) CLASS XCalendarMod

   UPDATE ::oParent TO oParent

   ::Super:Create()

   DEFAULT ::aMonths  TO XA_MonthNames()
   DEFAULT ::aDays    TO XA_DaysOfTheWeek()
   DEFAULT ::aSmonths TO XA_MonthNames( .t. )
   DEFAULT ::aSdays   TO XA_DaysOfTheWeek( .t. )

   DEFAULT ::oFontHeader TO TFont():Create( "Segoe UI", 15, 0, 400 )
   DEFAULT ::oFontDOW    TO TFont():Create( "Segoe UI", 10, 0, 400 )
   DEFAULT ::oFontGroup  TO TFont():Create( "Segoe UI", 8, 0, 400 )

   ::oHeader := TButtonMod():Create( Self )
   ::oPrev   := TButtonMod():Create( Self )
   ::oNext   := TButtonMod():Create( Self )

   WITH OBJECT ::oHeader
      :OnClick := {|| ::ClickOnHeader() }
      :nAlignment := taLEFT
      :nValignment := vaTOP
      :lTransparent := .t.
      :oFont := ::oFontHeader
   END WITH

   WITH OBJECT ::oPrev
      :cText := ""
      :OnCustomDraw := {|o,h,a| ::PaintBtnArrows( h, a, .T. ) }
      :lTransparent := .t.
      :nValignment := vaTOP
      :oFont := ::oFontHeader
      :OnClick := {|| ::ClickOnButton(-1) }
   END WITH

   WITH OBJECT ::oNext
      :cText := ""
      :OnCustomDraw := {|o,h,a| ::PaintBtnArrows( h, a, .F. ) }
      :lTransparent := .t.
      :nValignment := vaTOP
      :oFont := ::oFontHeader
      :OnClick := {|| ::ClickOnButton(+1) }
   END WITH

   ::dWork := ::dValue

   ::SetClrTextHeader()
   ::Adjust()

RETURN Self

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

METHOD Free() CLASS XCalendarMod

   IF ::FoFontHeader != Nil
      ::FoFontHeader:Destroy()
   ENDIF

   IF ::FoFontDOW != Nil
      ::FoFontDOW:Destroy()
   ENDIF

   IF ::oFontGroup != Nil
      ::oFontGroup:Destroy()
   ENDIF

RETURN ::Super:Free()

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

METHOD SetFontHeader( oFont ) CLASS XCalendarMod

   IF ::FoFontHeader != Nil
      ::FoFontHeader:Destroy()
      ::FoFontHeader := Nil
   ENDIF

   IF oFont != Nil
      IF ValType( oFont ) != "O"
         oFont := TFont():Create( oFont )
      ENDIF
      ::FoFontHeader := oFont
   ENDIF

   IF ::oHeader != NIL
      ::oHeader:oFont := oFont
   ENDIF
   IF ::oPrev != NIL
      ::oPrev:oFont := oFont
   ENDIF
   IF ::oNext != NIL
      ::oNext:oFont := oFont
   ENDIF

RETURN Nil

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

METHOD SetClrTextHeader( nColor ) CLASS XCalendarMod

   IF nColor != NIL
      ::FnClrTextHeader := nColor
   ELSE
      nColor := ::FnClrTextHeader
   ENDIF

   IF ::oHeader != NIL
      ::oHeader:nClrText := nColor
   ENDIF
   IF ::oPrev != NIL
      ::oPrev:nClrText := nColor
   ENDIF
   IF ::oNext != NIL
      ::oNext:nClrText := nColor
   ENDIF

RETURN nColor

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

METHOD SetDisplayMode( nValue ) CLASS XCalendarMod

   ::FnDisplayMode := nValue
   ::nCellFocus   := 0

   IF !Empty( ::dWork )
      ::Adjust()
   ENDIF

RETURN nValue

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

METHOD SetSelectionMode( nValue ) CLASS XCalendarMod

   ::FnSelectionMode := nValue
   ::aDaysSelected   := {}

   IF !Empty( ::dWork )
      ::Adjust()
   ENDIF

RETURN nValue

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

METHOD SetFontDow( oFont ) CLASS XCalendarMod

   IF ::FoFontDOW != Nil
      ::FoFontDOW:Destroy()
      ::FoFontDOW := Nil
   ENDIF

   IF oFont != Nil
      IF ValType( oFont ) != "O"
         oFont := TFont():Create( oFont )
      ENDIF
      ::FoFontDOW := oFont
   ENDIF

RETURN Nil

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

METHOD WMMouseMove( nWParam, nLParam, hWnd ) CLASS XCalendarMod

   IF Empty( ::aHotPos )
      TrackMouseEvent( ::Handle, TME_LEAVE )
   ENDIF

   ::aHotPos := { LoWord( nLParam ), HiWord( nLParam ) }
   ::lPushed := lGetKeyState( VK_LBUTTON )

   ::Refresh( .F. )

RETURN ::Super:WMMouseMove( nWParam, nLParam, hWnd )

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

METHOD WMMouseLeave()  CLASS XCalendarMod

   ::aHotPos := NIL
   ::lPushed := .F.
   ::Refresh()

RETURN nil

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

METHOD WMLButtonDown( nWParam, nLParam )  CLASS XCalendarMod

   ::lPushed := .T.
   ::Refresh()

RETURN nil

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

METHOD WMLButtonUp( nWParam, nLParam ) CLASS XCalendarMod

   LOCAL lRet

   IF !Empty( ::aHotPos ) .and. ::lPushed
      lRet := ::OnClick()
      IF (lRet == NIL .OR. lRet)
         SWITCH ::nDisplayMode
            CASE dmMonth
               IF ::SelectDay( { LoWord( nLParam ), HiWord( nLParam ) } )
                  ::OnSelect( ::dValue )
               ENDIF
               EXIT
            CASE dmYear
               ::SelectMonth( { LoWord( nLParam ), HiWord( nLParam ) } )
               EXIT
            CASE dmDecade
               ::SelectYear( { LoWord( nLParam ), HiWord( nLParam ) } )
               EXIT
         END swith
      ENDIF
   ENDIF

   ::lPushed := .F.

RETURN nil

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

METHOD WMKeyDown( nFlags, nLParam, hWnd ) CLASS XCalendarMod

   SWITCH nFlags
   CASE VK_LEFT
      ::GoLeft()
      RETURN 0
      EXIT
   CASE VK_RIGHT
      ::GoRight()
      RETURN 0
      EXIT
   CASE VK_DOWN
      ::GoDown()
      RETURN 0
      EXIT
   CASE VK_UP
      ::GoUp()
      RETURN 0
      EXIT
   CASE VK_HOME
      ::nCellFocus := 1
      ::Refresh()
      RETURN 0
      EXIT
   CASE VK_END
      ::nCellFocus := IIF( ::nDisplayMode = dmMonth, ::nNumberOfWeeks * 7, 16 )
      ::Refresh()
      RETURN 0
      EXIT
   CASE VK_SPACE
   CASE VK_RETURN
      SWITCH ::nDisplayMode
      CASE dmMonth
         ::SelectDay( ::nCellFocus )
         ::OnSelect( ::dValue )
         EXIT
      CASE dmYear
         ::SelectMonth( ::nCellFocus )
         EXIT
      CASE dmDecade
         ::SelectYear( ::nCellFocus )
         EXIT
      END SWITCH
      RETURN 0
      EXIT
   END SWITCH

RETURN ::Super:WMKeyDown( nFlags, nLParam, hWnd )

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

METHOD WMMouseWheel( nWParam, nLParam ) CLASS XCalendarMod

   LOCAL nDelta

   nDelta := HiWord( nWParam )

   IF nDelta > 0
      ::ClickOnButton( -1 )
   ELSE
      ::ClickOnButton( 1 )
   ENDIF

RETURN Nil

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

METHOD WMSize( nWParam, nLParam ) CLASS XCalendarMod

   ::Super:WMSize( nWParam, nLParam )
   ::Adjust()

RETURN 0

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

METHOD GoUp() CLASS XCalendarMod

   ::nCellFocus -= IIF( ::nDisplayMode = dmMonth, 7, 4 )
   IF ::nCellFocus < 1
      ::ClickOnButton( -1 )
      ::nCellFocus := Mod( ::nCellFocus, IIF( ::nDisplayMode = dmMonth, 7, 4 ) )
   ENDIF
   ::Refresh()

RETURN NIL

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

METHOD GoDown() CLASS XCalendarMod

   ::nCellFocus += IIF( ::nDisplayMode = dmMonth, 7, 4 )
   IF ::nCellFocus > IIF( ::nDisplayMode = dmMonth, ::nNumberOfWeeks * 7, 16 )
      ::ClickOnButton( 1 )
      ::nCellFocus := Mod( ::nCellFocus, IIF( ::nDisplayMode = dmMonth, 7, 4 ) )
   ENDIF
   ::Refresh()

RETURN NIL

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

METHOD GoLeft() CLASS XCalendarMod

   LOCAL nTmp

   IF Mod( ::nCellFocus - 1, IIF( ::nDisplayMode = dmMonth, 7, 4 ) ) == 0
      ::ClickOnButton( -1 )
      nTmp := IIF( ::nDisplayMode = dmMonth, 7 , 4 )
      ::nCellFocus := Max( nTmp, ::nCellFocus + nTmp - 1 )
   ELSE
      ::nCellFocus --
   ENDIF
   ::Refresh()

RETURN NIL

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

METHOD GoRight() CLASS XCalendarMod

   IF Mod( ::nCellFocus, IIF( ::nDisplayMode = dmMonth, 7, 4 ) ) == 0
      ::ClickOnButton( 1 )
      ::nCellFocus := ::nCellFocus - IIF( ::nDisplayMode = dmMonth, 6, 3 )
   ELSE
      ::nCellFocus ++
   ENDIF
   ::Refresh()

RETURN NIL

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