(* OCaml-Win32
 * win32_updown.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: Up-Down Controls *)

let updown_class = "msctls_updown32"

let ud_maxval = 0x7FFF
let ud_minval = -ud_maxval

type udaccel = {
    uda_sec : int;
    uda_inc : int }

external create_up_down_control :
    style:style ->
    position:point ->
    size:size ->
    parent:hwnd ->
    id:int ->
    inst:hinstance ->
    buddy:hwnd ->
    upper:int ->
    lower:int ->
    pos:int ->
    hwnd = "create_up_down_control_bytecode" "create_up_down_control_native"

(* Styles *)

type updown_style_option =
    UDS_ALIGNLEFT
  | UDS_ALIGNRIGHT
  | UDS_ARROWKEYS
  | UDS_AUTOBUDDY
  | UDS_HORZ
  | UDS_HOTTRACK
  | UDS_NOTHOUSANDS
  | UDS_SETBUDDYINT
  | UDS_WRAP

external updown_style_of_option : updown_style_option -> style = "updown_style_of_option"

let updown_style_of_options = special_style_of_options ~special_func:updown_style_of_option

(* Messages *)

let udm_getaccel = wm_user + 108
let pack_udm_getaccel_count = pack_simple_message ~id:udm_getaccel
external unpack_udm_getaccel_count : message_result -> int = "unpack_udm_getaccel_count"
let issue_udm_getaccel_count ~sender = unpack_udm_getaccel_count (sender ~msg:pack_udm_getaccel_count)
external issue_udm_getaccel : sender:message_sender -> max_count:int -> udaccel list = "issue_udm_getaccel"

let udm_getbase = wm_user + 110
let pack_udm_getbase = pack_simple_message ~id:udm_getbase
external unpack_udm_getbase : message_result -> int = "unpack_udm_getbase"
let issue_udm_getbase ~sender = unpack_udm_getbase (sender ~msg:pack_udm_getbase)

let udm_getbuddy = wm_user + 106
let pack_udm_getbuddy = pack_simple_message ~id:udm_getbuddy
external unpack_udm_getbuddy : message_result -> hwnd = "unpack_udm_getbuddy"
let issue_udm_getbuddy ~sender = unpack_udm_getbuddy (sender ~msg:pack_udm_getbuddy)

let udm_getpos = wm_user + 104
let pack_udm_getpos = pack_simple_message ~id:udm_getpos
external unpack_udm_getpos : message_result -> (int * bool) = "unpack_udm_getpos"
let issue_udm_getpos ~sender = unpack_udm_getpos (sender ~msg:pack_udm_getpos)

let udm_getrange = wm_user + 102
let pack_udm_getrange = pack_simple_message ~id:udm_getrange
external unpack_udm_getrange : message_result -> (int * int) = "unpack_udm_getrange"
let issue_udm_getrange ~sender = unpack_udm_getrange (sender ~msg:pack_udm_getrange)

let udm_getrange32 = wm_user + 112
external issue_udm_getrange32 : sender:message_sender -> (int * int) = "issue_udm_getrange32"

(* udm_getunicodeformat: use ccm_getunicodeformat *)

let udm_setaccel = wm_user + 107
external issue_udm_setaccel : sender:message_sender -> accels:udaccel list -> unit = "issue_udm_setaccel"

let udm_setbase = wm_user + 109
external pack_udm_setbase : base:int -> message_contents = "pack_udm_setbase"
external unpack_udm_setbase : message_result -> int = "unpack_udm_setbase"
let issue_udm_setbase ~sender ~base = unpack_udm_setbase (sender ~msg:(pack_udm_setbase ~base))

let udm_setbuddy = wm_user + 105
external pack_udm_setbuddy : buddy:hwnd -> message_contents = "pack_udm_setbuddy"
external unpack_udm_setbuddy : message_result -> hwnd = "unpack_udm_setbuddy"
let issue_udm_setbuddy ~sender ~buddy = unpack_udm_setbuddy (sender ~msg:(pack_udm_setbuddy ~buddy))

let udm_setpos = wm_user + 103
external pack_udm_setpos : pos:int -> message_contents = "pack_udm_setpos"
external unpack_udm_setpos : message_result -> int = "unpack_udm_setpos"
let issue_udm_setpos ~sender ~pos = unpack_udm_setpos (sender ~msg:(pack_udm_setpos ~pos))

let udm_setrange = wm_user + 101
external pack_udm_setrange : min:int -> max:int -> message_contents = "pack_udm_setrange"
let unpack_udm_setrange = ignore
let issue_udm_setrange ~sender ~min ~max = unpack_udm_setrange (sender ~msg:(pack_udm_setrange ~min ~max))

let udm_setrange32 = wm_user + 111
external pack_udm_setrange32 : min:int -> max:int -> message_contents = "pack_udm_setrange32"
let unpack_udm_setrange32 = ignore
let issue_udm_setrange32 ~sender ~min ~max = unpack_udm_setrange32 (sender ~msg:(pack_udm_setrange32 ~min ~max))

(* udm_setunicodeformat: use ccm_setunicodeformat *)

(* Notifications *)

type nmupdown = {
    nmud_pos : int;
    nmud_delta : int }
external unpack_nmupdown : msg:message_contents -> nmupdown = "unpack_nmupdown"

let udn_first = -721
let udn_last = -740

let udn_deltapos = udn_first - 1
let on_udn_deltapos = on_notify_message ~code:udn_deltapos ~unpack:unpack_nmupdown ~return:return_common_notify
