(* OCaml-Win32
 * win32_datetimepicker.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: Date and Time Picker Controls *)

let datetimepick_class = "SysDateTimePick32"

(* Styles *)

type datetimepick_style_option =
    DTS_APPCANPARSE
  | DTS_LONGDATEFORMAT
  | DTS_RIGHTALIGN
  | DTS_SHOWNONE
  | DTS_SHORTDATEFORMAT
  | DTS_TIMEFORMAT
  | DTS_UPDOWN

external datetimepick_style_of_option : datetimepick_style_option -> style = "datetimepick_style_of_option"

let datetimepick_style_of_options = special_style_of_options ~special_func:datetimepick_style_of_option

(* Messages *)

let dtm_first = 0x1000

let dtm_getmccolor = dtm_first + 7
external pack_dtm_getmccolor : which:calendar_color -> message_contents = "pack_dtm_getmccolor"
external unpack_dtm_getmccolor : message_result -> color = "unpack_dtm_getmccolor"
let issue_dtm_getmccolor ~sender ~which = unpack_dtm_getmccolor (sender ~msg:(pack_dtm_getmccolor ~which))

let dtm_getmcfont = dtm_first + 10
let pack_dtm_getmcfont = pack_simple_message ~id:dtm_getmcfont
external unpack_dtm_getmcfont : message_result -> hfont = "unpack_dtm_getmcfont"
let issue_dtm_getmcfont ~sender = unpack_dtm_getmcfont (sender ~msg:pack_dtm_getmcfont)

let dtm_getmonthcal = dtm_first + 8
let pack_dtm_getmonthcal = pack_simple_message ~id:dtm_getmonthcal
external unpack_dtm_getmonthcal : message_result -> hwnd = "unpack_dtm_getmonthcal"
let issue_dtm_getmonthcal ~sender = unpack_dtm_getmonthcal (sender ~msg:pack_dtm_getmonthcal)

let dtm_getrange = dtm_first + 3
external issue_dtm_getrange : sender:message_sender -> (systemtime option * systemtime option) = "issue_dtm_getrange"

let dtm_getsystemtime = dtm_first + 1
external issue_dtm_getsystemtime : sender:message_sender -> systemtime option = "issue_dtm_getsystemtime"

let dtm_setformat = dtm_first + 5
external issue_dtm_setformat : sender:message_sender -> format:string option -> unit = "issue_dtm_setformat"

let dtm_setmccolor = dtm_first + 6
external pack_dtm_setmccolor : which:calendar_color -> color:color -> message_contents = "pack_dtm_setmccolor"
external unpack_dtm_setmccolor : message_result -> color = "unpack_dtm_setmccolor"
let issue_dtm_setmccolor ~sender ~which ~color = unpack_dtm_setmccolor (sender ~msg:(pack_dtm_setmccolor ~which ~color))

let dtm_setmcfont = dtm_first + 9
external pack_dtm_setmcfont : font:hfont -> redraw:bool -> message_contents = "pack_dtm_setmcfont"
let unpack_dtm_setmcfont = ignore
let issue_dtm_setmcfont ~sender ~font ~redraw = unpack_dtm_setmcfont (sender ~msg:(pack_dtm_setmcfont ~font ~redraw))

let dtm_setrange = dtm_first + 4
external issue_dtm_setrange :
    sender:message_sender ->
    min:systemtime option ->
    max:systemtime option ->
    unit = "issue_dtm_setrange"

let dtm_setsystemtime = dtm_first + 2
external issue_dtm_setsystemtime : sender:message_sender -> time:systemtime option -> unit = "issue_dtm_setsystemtime"

(* Notifications *)

type nmdatetimechange = {
    nmdtc_time : systemtime option }
external unpack_nmdatetimechange : msg:message_contents -> nmdatetimechange = "unpack_nmdatetimechange"

let dtn_first = -760
let dtn_last = -799

let dtn_closeup = dtn_first + 7
let on_dtn_closeup = on_notify_message ~code:dtn_closeup ~unpack:unpack_simple_notify ~return:return_simple_message

let dtn_datetimechange = dtn_first + 1
let on_dtn_datetimechange = on_notify_message ~code:dtn_datetimechange ~unpack:unpack_nmdatetimechange ~return:return_simple_message

let dtn_dropdown = dtn_first + 6
let on_dtn_dropdown = on_notify_message ~code:dtn_dropdown ~unpack:unpack_simple_notify ~return:return_simple_message

let dtn_format = dtn_first + 4
type dtn_format_handler =
    wnd:hwnd ->
    msg:message_contents ->
    id:int ->
    hdr:nmhdr ->
    format:string ->
    time:systemtime ->
    string message_handler_result
external on_dtn_format :
    dtn_format_handler ->
    wnd:hwnd ->
    msg:message_contents ->
    message_result option = "on_dtn_format"

let dtn_formatquery = dtn_first + 5
type dtn_formatquery_handler =
    wnd:hwnd ->
    msg:message_contents ->
    id:int ->
    hdr:nmhdr ->
    format:string ->
    size message_handler_result
external on_dtn_formatquery :
    dtn_formatquery_handler ->
    wnd:hwnd ->
    msg:message_contents ->
    message_result option = "on_dtn_formatquery"

let dtn_userstring = dtn_first + 2
type dtn_userstring_handler =
    wnd:hwnd ->
    msg:message_contents ->
    id:int ->
    hdr:nmhdr ->
    user_string:string ->
    systemtime option message_handler_result
external on_dtn_userstring :
    dtn_userstring_handler ->
    wnd:hwnd ->
    msg:message_contents ->
    message_result option = "on_dtn_userstring"

let dtn_wmkeydown = dtn_first + 3
type dtn_wmkeydown_handler =
    wnd:hwnd ->
    msg:message_contents ->
    id:int ->
    hdr:nmhdr ->
    key:virtual_key_code ->
    format:string ->
    time:systemtime ->
    systemtime message_handler_result
external on_dtn_wmkeydown :
    dtn_wmkeydown_handler ->
    wnd:hwnd ->
    msg:message_contents ->
    message_result option = "on_dtn_wmkeydown"
