(* OCaml-Win32
 * win32_monthcalendar.ml
 * Copyright (c) 2002-2004 by Harry Chomsky
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Library General Public
 * License as published by the Free Software Foundation; either
 * version 2 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Library General Public License for more details.
 *
 * You should have received a copy of the GNU Library General Public
 * License along with this library; if not, write to the Free
 * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 *)

open Win32_core

(********************************************************************)
(* User Interface: Windows User Experience: Windows Shell: SDK: Windows Controls: Individual Control Information: Month Calendar Controls *)

let monthcal_class = "SysMonthCal32"

(* Styles *)

type monthcal_style_option =
    MCS_DAYSTATE
  | MCS_MULTISELECT
  | MCS_NOTODAY
  | MCS_NOTODAYCIRCLE
  | MCS_WEEKNUMBERS

external monthcal_style_of_option : monthcal_style_option -> style = "monthcal_style_of_option"

let monthcal_style_of_options = special_style_of_options ~special_func:monthcal_style_of_option

(* Messages *)

let mcm_first = 0x1000

let mcm_getcolor = mcm_first + 11
external pack_mcm_getcolor : which:calendar_color -> message_contents = "pack_mcm_getcolor"
external unpack_mcm_getcolor : message_result -> color = "unpack_mcm_getcolor"
let issue_mcm_getcolor ~sender ~which = unpack_mcm_getcolor (sender ~msg:(pack_mcm_getcolor ~which))

let mcm_getcursel = mcm_first + 1
external issue_mcm_getcursel : sender:message_sender -> systemtime = "issue_mcm_getcursel"

let mcm_getfirstdayofweek = mcm_first + 16
let pack_mcm_getfirstdayofweek = pack_simple_message ~id:mcm_getfirstdayofweek
external unpack_mcm_getfirstdayofweek : message_result -> (int * bool) = "unpack_mcm_getfirstdayofweek"
let issue_mcm_getfirstdayofweek ~sender = unpack_mcm_getfirstdayofweek (sender ~msg:pack_mcm_getfirstdayofweek)

let mcm_getmaxselcount = mcm_first + 3
let pack_mcm_getmaxselcount = pack_simple_message ~id:mcm_getmaxselcount
external unpack_mcm_getmaxselcount : message_result -> int = "unpack_mcm_getmaxselcount"
let issue_mcm_getmaxselcount ~sender = unpack_mcm_getmaxselcount (sender ~msg:pack_mcm_getmaxselcount)

let mcm_getmaxtodaywidth = mcm_first + 21
let pack_mcm_getmaxtodaywidth = pack_simple_message ~id:mcm_getmaxtodaywidth
external unpack_mcm_getmaxtodaywidth : message_result -> int = "unpack_mcm_getmaxtodaywidth"
let issue_mcm_getmaxtodaywidth ~sender = unpack_mcm_getmaxtodaywidth (sender ~msg:pack_mcm_getmaxtodaywidth)

let mcm_getminreqrect = mcm_first + 9
external issue_mcm_getminreqrect : sender:message_sender -> rect = "issue_mcm_getminreqrect"

let mcm_getmonthdelta = mcm_first + 19
let pack_mcm_getmonthdelta = pack_simple_message ~id:mcm_getmonthdelta
external unpack_mcm_getmonthdelta : message_result -> int = "unpack_mcm_getmonthdelta"
let issue_mcm_getmonthdelta ~sender = unpack_mcm_getmonthdelta (sender ~msg:pack_mcm_getmonthdelta)

let mcm_getmonthrange = mcm_first + 7
type monthcal_range_type =
    GMR_DAYSTATE
  | GMR_VISIBLE
external issue_mcm_getmonthrange : sender:message_sender -> typ:monthcal_range_type -> (systemtime * systemtime * int) = "issue_mcm_getmonthrange"

let mcm_getrange = mcm_first + 17
external issue_mcm_getrange : sender:message_sender -> (systemtime option * systemtime option) = "issue_mcm_getrange"

let mcm_getselrange = mcm_first + 5
external issue_mcm_getselrange : sender:message_sender -> (systemtime * systemtime) = "issue_mcm_getselrange"

let mcm_gettoday = mcm_first + 13
external issue_mcm_gettoday : sender:message_sender -> systemtime = "issue_mcm_gettoday"

(* mcm_getunicodeformat: use ccm_getunicodeformat *)

let mcm_hittest = mcm_first + 14
type monthcal_hit_test_title =
    MCHT_TITLEBK
  | MCHT_TITLEBTNNEXT
  | MCHT_TITLEBTNPREV
  | MCHT_TITLEMONTH
  | MCHT_TITLEYEAR
type monthcal_hit_test_calendar =
    MCHT_CALENDARBK
  | MCHT_CALENDARDATE
  | MCHT_CALENDARDATENEXT
  | MCHT_CALENDARDATEPREV
  | MCHT_CALENDARDAY
  | MCHT_CALENDARWEEKNUM
type monthcal_hit_test_result =
    Mcht_nowhere
  | Mcht_title of monthcal_hit_test_title
  | Mcht_calendar of monthcal_hit_test_calendar
  | Mcht_todaylink
external issue_mcm_hittest : sender:message_sender -> pt:point -> (monthcal_hit_test_result * systemtime) = "issue_mcm_hittest"

let mcm_setcolor = mcm_first + 10
external pack_mcm_setcolor : which:calendar_color -> color:color -> message_contents = "pack_mcm_setcolor"
external unpack_mcm_setcolor : message_result -> color = "unpack_mcm_setcolor"
let issue_mcm_setcolor ~sender ~which ~color = unpack_mcm_setcolor (sender ~msg:(pack_mcm_setcolor ~which ~color))

let mcm_setcursel = mcm_first + 2
external issue_mcm_setcursel : sender:message_sender -> time:systemtime -> unit = "issue_mcm_setcursel"

let mcm_setdaystate = mcm_first + 8
type monthdaystate = int32
external issue_mcm_setdaystate : sender:message_sender -> states:monthdaystate array -> unit = "issue_mcm_setdaystate"

let mcm_setfirstdayofweek = mcm_first + 15
external pack_mcm_setfirstdayofweek : day:int -> message_contents = "pack_mcm_setfirstdayofweek"
external unpack_mcm_setfirstdayofweek : message_result -> (int * bool) = "unpack_mcm_setfirstdayofweek"
let issue_mcm_setfirstdayofweek ~sender ~day = unpack_mcm_setfirstdayofweek (sender ~msg:(pack_mcm_setfirstdayofweek ~day))

let mcm_setmaxselcount = mcm_first + 4
external pack_mcm_setmaxselcount : count:int -> message_contents = "pack_mcm_setmaxselcount"
external unpack_mcm_setmaxselcount : message_result -> unit = "unpack_mcm_setmaxselcount"
let issue_mcm_setmaxselcount ~sender ~count = unpack_mcm_setmaxselcount (sender ~msg:(pack_mcm_setmaxselcount ~count))

let mcm_setmonthdelta = mcm_first + 20
external pack_mcm_setmonthdelta : delta:int -> message_contents = "pack_mcm_setmonthdelta"
external unpack_mcm_setmonthdelta : message_result -> int = "unpack_mcm_setmonthdelta"
let issue_mcm_setmonthdelta ~sender ~delta = unpack_mcm_setmonthdelta (sender ~msg:(pack_mcm_setmonthdelta ~delta))

let mcm_setrange = mcm_first + 18
external issue_mcm_setrange :
    sender:message_sender ->
    min:systemtime option ->
    max:systemtime option ->
    unit = "issue_mcm_setrange"

let mcm_setselrange = mcm_first + 6
external issue_mcm_setselrange : sender:message_sender -> min:systemtime -> max:systemtime -> unit = "issue_mcm_setselrange"

let mcm_settoday = mcm_first + 12
external issue_mcm_settoday : sender:message_sender -> time:systemtime option -> unit = "issue_mcm_settoday"

(* mcm_setunicodeformat: use ccm_setunicodeformat *)

(* Notifications *)

type nmselchange = {
    nmsc_sel_start : systemtime;
    nmsc_sel_end : systemtime }
external unpack_nmselchange : msg:message_contents -> nmselchange = "unpack_nmselchange"

let mcn_first = -750
let mcn_last = -759

let mcn_getdaystate = mcn_first + 3
type mcn_getdaystate_handler =
    wnd:hwnd ->
    msg:message_contents ->
    id:int ->
    hdr:nmhdr ->
    start:systemtime ->
    count:int ->
    monthdaystate array message_handler_result
external on_mcn_getdaystate :
    mcn_getdaystate_handler ->
    wnd:hwnd ->
    msg:message_contents ->
    message_result option = "on_mcn_getdaystate"

let mcn_selchange = mcn_first + 1
let on_mcn_selchange = on_notify_message ~code:mcn_selchange ~unpack:unpack_nmselchange ~return:return_simple_message

let mcn_select = mcn_first + 4
let on_mcn_select = on_notify_message ~code:mcn_select ~unpack:unpack_nmselchange ~return:return_simple_message
