'****************************************************************
'* QCalendar object                                             *
'*        Needs a Qpanel as parent                              *
'* properties:                                                  *
'*       Top: Top position in pixels                            *
'*       left: left position in pixels                          *
'*       Width: Width in pixels                                 *
'*       height: height in pixels                               *
'*                                                              *
'*       Year: Contains the year you've selected                *
'*       Month: Contains the month you've selected              *
'*       Day: Contains the day you've selected                  *
'*                                                              *
'*       Styles: Set additional properties (see CONST DTS_ ...) *
'*       SetDate(day, month, year): sets the cal pointer to the *
'*                                  selected date               *
'*                                                              *
'* Methods:                                                     *
'*       Getdate: retrieves the selected date                   *
'* ------------------------------------------------------------ *
'* Adapted from previous code by DGNoyon                        *
'* Version 1.0               January 2013                       *
'* Version 1.1 global clean-up  'Nov 2015 (JohnK)               *                   
'****************************************************************

CONST DTS_SHORTDATEFORMAT = 0
CONST DTS_UPDOWN = 1
CONST DTS_SHOWNONE = 2
CONST DTS_LONGDATEFORMAT = 4
CONST DTS_APPCANPARSE = 6
CONST DTS_TIMEFORMAT = 9
CONST DTS_SHORTDATECENTURYFORMAT = 12
CONST DTS_RIGHTALIGN = 32

' MonthCal Message codes for sendMessage
Const MCM_FIRST = &H1000
Const MCM_GETCURSEL = (MCM_FIRST + 1)
Const MCM_SETCURSEL = (MCM_FIRST + 2)
Const MCM_SETCOLOR = (MCM_FIRST + 10)
Const MCM_GETCOLOR = (MCM_FIRST + 11)
Const MCM_SETFIRSTDAYOFWEEK = (MCM_FIRST + 15)
Const MCM_GETFIRSTDAYOFWEEK = (MCM_FIRST + 16) 
Const MCM_SETTODAY = &h100c
Const MCM_GETTODAY As Long = (MCM_FIRST + 13)
Const MCM_SETDAYSTATE = &h1008
Const MCM_GETMAXSELCOUNT = &h1003
Const MCM_SETMAXSELCOUNT = &h1004
Const MCM_GETSELRANGE    = &h1005
Const MCM_SETSELRANGE    = &h1006
Const MCM_GETMONTHRANGE = &h1007
Const MCM_GETMINREQRECT = &h1009
Const MCM_HITTEST = &h100e
Const MCM_GETRANGE = &h1011
Const MCM_SETRANGE = &h1012
Const MCM_GETMONTHDELTA = &h1013
Const MCM_SETMONTHDELTA = &h1014
Const MCM_GETMAXTODAYWIDTH = &h1015
Const MCM_SETCURRENTVIEW = (MCM_FIRST + 32)

' MonthCal Styles
Const MCS_DAYSTATE = 1
Const MCS_MULTISELECT = &H2
Const MCS_WEEKNUMBERS = &H4
Const MCS_NOTODAYCIRCLE = &H8
Const MCS_NOTODAY = &H10
'Const MCS_DAYSTATE =

' MonthCal Color
Const MCSC_BACKGROUND = 0 ' the background color (between months)
Const MCSC_TEXT = 1 ' color used to display text within a month.
Const MCSC_TITLEBK = 2 ' background of the title
Const MCSC_TITLETEXT = 3  'olor used to display text within the calendar's title
Const MCSC_MONTHBK = 4 ' background color displayed in the calendar's title.
Const MCSC_TRAILINGTEXT = 5 ' the text color of header & trailing days 


Const MCHT_TITLE = &h10000
Const MCHT_CALENDAR = &h20000
Const MCHT_TODAYLINK = &h30000
Const MCHT_NEXT = &h1000000
Const MCHT_PREV = &h2000000
Const MCHT_NOWHERE = &h00
Const MCHT_TITLEBK = (MCHT_TITLE)
Const MCHT_TITLEMONTH = (MCHT_TITLE  or  &h0001)
Const MCHT_TITLEYEAR = (MCHT_TITLE  or  &h0002)
Const MCHT_TITLEBTNNEXT = (MCHT_TITLE  or  MCHT_NEXT  or  &h0003)
Const MCHT_TITLEBTNPREV = (MCHT_TITLE  or  MCHT_PREV  or  &h0003)
Const MCHT_CALENDARBK = (MCHT_CALENDAR)
Const MCHT_CALENDARDATE = (MCHT_CALENDAR  or  &h0001)
Const MCHT_CALENDARDATENEXT = (MCHT_CALENDARDATE  or  MCHT_NEXT)
Const MCHT_CALENDARDATEPREV = (MCHT_CALENDARDATE  or  MCHT_PREV)
Const MCHT_CALENDARDAY = (MCHT_CALENDAR  or  &h0002)
Const MCHT_CALENDARWEEKNUM = (MCHT_CALENDAR  or  &h0003)

$DEFINE MCMV_MONTH   0
$DEFINE MCMV_YEAR    1
$DEFINE MCMV_DECADE  2
$DEFINE MCMV_CENTURY 3

Const MCN_SELCHANGE     = (-749)
Const MCN_GETDAYSTATE =    (-747)
Const MCN_SELECT    =    (-746)

Const MC_SEL_LBUTUP      = 1   '/* Left button released */
Const MC_SEL_LBUTDOWN    = 2   '/* Left button pressed in calendar */
Const MC_PREVPRESSED     = 4   '/* Prev month button pressed */
Const MC_NEXTPRESSED     = 8   '/* Next month button pressed */
Const MC_PREVNEXTMONTHDELAY =  350 '/* when continuously pressing `next/prev month', wait 350 ms before going to the next/prev month */
Const MC_TODAYUPDATEDELAY = 120000 '/* time between today check for update (2 min) */
 
Const MC_PREVNEXTMONTHTIMER =  1   '/* Timer IDs */
Const MC_TODAYUPDATETIMER    =  2
Const MC_CALENDAR_PADDING    =  6


$IFNDEF __WIN32API        'for windows.inc 32-bit API calls/constants

    TYPE NMHDR
        hwndFrom AS LONG
        idFrom AS LONG
        code AS LONG
    END TYPE

    TYPE SYSTEMTIME
        wYear AS SHORT
        wMonth AS SHORT
        wDayOfWeek AS SHORT
        wDay AS SHORT
        wHour AS SHORT
        wMinute AS SHORT
        wSecond AS SHORT
        wMilliseconds AS SHORT
    END TYPE

    Const WM_NOTIFY As Long = &H4E
    DECLARE FUNCTION UpdateWindow LIB "USER32" ALIAS "UpdateWindow" (hWnd AS LONG) AS LONG 

    $IFNDEF __RQINC2        ' & rapidQ2
        DECLARE FUNCTION CreateWindowEx LIB "USER32" ALIAS "CreateWindowExA" _
            (ExStyle& , ClassName$ , WindowName$ , Style& , X& , Y& , _
            Width& , Height& , WndParent& , hMenu& , hInstance& , Param&) AS LONG

        DECLARE FUNCTION SetWindowPos LIB "user32" ALIAS "SetWindowPos"(hwnd AS LONG , hWndInsertAfter AS LONG , _
            x AS LONG , y AS LONG , cx AS LONG , cy AS LONG , wFlags AS LONG) AS LONG
                
        DECLARE FUNCTION SetWindowLong LIB "user32" ALIAS "SetWindowLongA" _
            (hwnd AS LONG , nIndex AS LONG , dwNewLong AS LONG) AS LONG

        DECLARE FUNCTION SetProp LIB "User32" ALIAS "SetPropA" (hwnd AS LONG,lpString AS STRING,hData AS LONG) AS LONG
        DECLARE FUNCTION GetProp LIB "User32"  ALIAS "GetPropA" (hwnd AS LONG,lpString AS STRING) AS LONG

    $ENDIF
$ENDIF

TYPE INITCINC
    dwSize AS INTEGER
    dwICC AS INTEGER
END TYPE


DECLARE FUNCTION InitCommonControlsEx LIB "COMCTL32" ALIAS "InitCommonControlsEx" (icexINC AS INITCINC) AS WORD


Declare Sub QCalendarOnChange_eventTemplate(Month AS STRING, Day AS STRING, Year AS STRING)

TYPE QCalendar EXTENDS QOBJECT

  private:
    SysTime AS SYSTEMTIME
    BindIndex AS LONG
    MyWndProc AS LONG           'hacks for capturing address of function points
    pOldProc AS LONG

  public:
    Width AS INTEGER PROPERTY set setwposition
    Top AS INTEGER PROPERTY set settposition
    Left AS INTEGER PROPERTY set setlposition
    Height AS INTEGER PROPERTY set sethposition
    Tag AS INTEGER

    Year AS SHORT
    Month AS SHORT
    Day AS SHORT

    TextColor AS INTEGER PROPERTY set SetTextColor
    Color AS INTEGER PROPERTY set SetColor
    TitleColor AS INTEGER PROPERTY set SetTitleColor
    TitleTextColor AS INTEGER PROPERTY set SetTitleTextColor
    PanelColor AS INTEGER PROPERTY set SetPanelColor
    'View AS INTEGER PROPERTY set SetView
    Styles AS INTEGER PROPERTY set SetStyles
    Parent AS LONG PROPERTY set CreateCalendar
    Handle AS LONG

    OnChange AS EVENT(QCalendarOnChange_eventTemplate)

    SUB SetTextColor(c AS INTEGER)
        QCalendar.TextColor = c
        SendMessage(QCalendar.Handle, MCM_SETCOLOR, MCSC_TEXT, QCalendar.TextColor)  'Text color
    END SUB

    SUB SetColor(c AS INTEGER)
        QCalendar.Color = c
        SendMessage(QCalendar.Handle, MCM_SETCOLOR, MCSC_MONTHBK, QCalendar.Color)  'background color
    END SUB

    SUB SetPanelColor(c AS INTEGER)
        QCalendar.PanelColor = c
        SendMessage(QCalendar.Handle, MCM_SETCOLOR, MCSC_BACKGROUND, QCalendar.PanelColor)  'panel color
    END SUB



    SUB SetTitleColor(c AS INTEGER)
        QCalendar.TitleColor = c
        SendMessage(QCalendar.Handle, MCM_SETCOLOR, MCSC_TITLEBK, QCalendar.TitleColor)  'background color
    END SUB

    SUB SetTitleTextColor(c AS INTEGER)
        QCalendar.TitleTextColor = c
        SendMessage(QCalendar.Handle, MCM_SETCOLOR, MCSC_TITLETEXT, QCalendar.TitleTextColor)  'background color
    END SUB

    SUB SetStyles(s as INTEGER)
        QCalendar.Styles = s
        SetWindowLong(QCalendar.Handle , -16 , &H40000000 + &H10000000 + &H10000 OR QCalendar.Styles)
    END SUB

'    SUB SetView(v AS INTEGER)
'        SELECT CASE v
'            CASE MCMV_MONTH
'                SendMessage(QCalendar.Handle, MCM_SETCURRENTVIEW, 0, MCMV_MONTH)
'            CASE MCMV_YEAR
'                SendMessage(QCalendar.Handle, MCM_SETCURRENTVIEW, 0, MCMV_YEAR)
'            CASE MCMV_DECADE
'                SendMessage(QCalendar.Handle, MCM_SETCURRENTVIEW, 0, MCMV_DECADE)
'        END SELECT
'    END SUB

    SUB setposition
        WITH QCalendar
            SetWindowPos(.Handle , 0 ,.Left ,.Top ,.Width ,.Height , 0)
        END WITH
    END SUB

    SUB setwposition(w AS INTEGER)
        QCalendar.Width = w
        QCalendar.setposition
    END SUB

    SUB sethposition(h AS INTEGER)
        QCalendar.Height = h
        QCalendar.setposition
    END SUB

    SUB settposition(t AS INTEGER)
        QCalendar.Top = t
        QCalendar.setposition
    END SUB

    SUB setlposition(l AS INTEGER)
        QCalendar.Left = l
        QCalendar.setposition
    END SUB

    SUB SetDate
        This.SysTime.wYear = QCalendar.year
        This.SysTime.wMonth = QCalendar.month
        This.SysTime.wDay = QCalendar.day
        SendMessage(QCalendar.Handle , MCM_SETCURSEL , 0 , This.SysTime)
    END SUB


    SUB getdate
        SendMessage(QCalendar.Handle , &H1001 , 0 , This.SysTime)
        QCalendar.day = This.SysTime.wDay
        QCalendar.month = This.SysTime.wMonth
        QCalendar.year = This.SysTime.wYear
    END SUB

    FUNCTION WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        DIM lRet AS LONG
        DIM lTmp AS LONG
        DIM m AS NMHDR

        IF GetProp(hwnd , "IsCalendar") = TRUE THEN
            SELECT CASE uMsg
                CASE WM_NOTIFY
                    'print "msg ", hex$(uMsg), "     ", hex$(wParam),  "     ", hex$(lParam)
                    MEMCPY(m, lparam, SIZEOF(m))
                    IF (m.code = MCN_SELECT) AND (QCalendar.OnChange <> 0) THEN
                        QCalendar.getDate
                        DEFSTR mnth = RIGHT$("00" + Str$(QCalendar.month),2)
                        DEFSTR dy = RIGHT$("00" + Str$(QCalendar.day),2)
                        DEFSTR yr = RIGHT$("00" & STR$(QCalendar.year),4)
                        CALLFUNC(QCalendar.OnChange, mnth, dy, yr)
                    END IF
                END SELECT
        END IF
         QCalendar.WindowProc = CallWindowProc(QCalendar.pOldProc, hwnd, uMsg, wParam, lParam)
    END FUNCTION


    SUB CreateCalendar(f AS QPanel)
        DIM icexINC AS INITCINC
            icexINC.dwSize = 8
            icexINC.dwICC = &H100        'ICC_DATE_CLASSES

        InitCommonControlsEx(icexINC)

        QCalendar.Handle = CreateWindowEx(0, "SysMonthCal32", 0, _
            WS_CHILD OR WS_VISIBLE OR WS_CLIPCHILDREN OR WS_CLIPSIBLINGS _
            OR MCS_WEEKNUMBERS OR MCS_DAYSTATE OR QCalendar.Styles, _
            2, 2, QCalendar.Width, QCalendar.Height, f.Handle, 0, 0, 0)

        'set wndproc to this objects window handler
        IF f.Handle THEN                  'we valid yet?
            BIND QCalendar.BindIndex TO QCalendar.WindowProc                                'get func pointer to Callback
            QCalendar.MyWndProc = SetNewCallBack_4(QCalendar.BindIndex)                     'get address of forwarder and set Bind address
            QCalendar.pOldProc=SetWindowLong(f.handle,GWL_WNDPROC, QCalendar.MyWndProc)     'set new callback and get old WndProc address (subclass)
            SetProp (f.Handle, "isCalendar", 1)
            This.SetPanelColor(16311512)  'background color
         End If
    END SUB

    CONSTRUCTOR
        Width = 110
        Height = 25
        Top = 100
        Left = 0
        Styles = 0
        BindIndex = 0
    END CONSTRUCTOR

END TYPE


'................................................
' test code
'................................................
'$INCLUDE <RAPIDQ2.INC>
'$INCLUDE <QCalendar.inc>
'DECLARE SUB ChangeEdit(Month$, Day$, Year$)
'CREATE Form AS QForm
'    width = 800
'    Height = 400
'    Center
'    CREATE Panel1 as QPanel
'        Align = alClient
'    CREATE DumpDate AS QEDIT
'        Top  = 20
'        Left = 380
'    END CREATE
'    End Create
'END CREATE
'
'DIM Calendar1 as QCalendar
'Calendar1.top = 20
'Calendar1.left = 20
'Calendar1.width = 350
'Calendar1.height = 175
'Calendar1.parent = Panel1
'Calendar1.TitleTextColor = clGreen
'Calendar1.TitleColor = clYellow
'Calendar1.Color =0
'Calendar1.TextColor = 255
'Calendar1.day = 8
'Calendar1.month = 11
'Calendar1.year = 2015
'Calendar1.SetDate
'
'Calendar1.OnChange = ChangeEdit
'
'SUB ChangeEdit(Month$, Day$, Year$)
'    DumpDate.Text = Month$ + "/" + Day$ + "/" + Year$
'END SUB
'
'Form.showmodal