(* OCaml-Win32
 * win32_tabcontrol.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: Tab Controls *)

let wc_tabcontrol = "SysTabControl32"

type tabcontrol_extended_style =
    TCS_EX_FLATSEPARATORS
  | TCS_EX_REGISTERDROP

type tcitem_state = {
    tcis_buttonpressed : bool option;
    tcis_highlighted : bool option }
let default_tcitem_state = {
    tcis_buttonpressed = None;
    tcis_highlighted = None }

type tcitem_param =
    Tcip_lparam of int32
  | Tcip_custom of buffer

type tcitem = {
    tci_state : tcitem_state option;
    tci_text : string option;
    tci_image : int option;
    tci_param : tcitem_param option;
    tci_rtlreading : bool }
let default_tcitem = {
    tci_state = None;
    tci_text = None;
    tci_image = None;
    tci_param = None;
    tci_rtlreading = false }

type tcitem_state_component =
    Tcis_buttonpressed
  | Tcis_highlighted
let all_tcitem_state_components = [
    Tcis_buttonpressed;
    Tcis_highlighted ]

type tcitem_param_type =
    Tcipt_lparam
  | Tcipt_custom of int

type tcitem_component =
    Tcif_state of tcitem_state_component list
  | Tcif_text of int
  | Tcif_image
  | Tcif_param of tcitem_param_type
let all_tcitem_components = [
    Tcif_state all_tcitem_state_components;
    Tcif_text 256;
    Tcif_image;
    Tcif_param Tcipt_lparam ]

(* Styles *)

type tabcontrol_style_option =
    TCS_BOTTOM
  | TCS_BUTTONS
  | TCS_FIXEDWIDTH
  | TCS_FLATBUTTONS
  | TCS_FOCUSNEVER
  | TCS_FOCUSONBUTTONDOWN
  | TCS_FORCEICONLEFT
  | TCS_FORCELABELLEFT
  | TCS_HOTTRACK
  | TCS_MULTILINE
  | TCS_MULTISELECT
  | TCS_OWNERDRAWFIXED
  | TCS_RAGGEDRIGHT
  | TCS_RIGHT
  | TCS_RIGHTJUSTIFY
  | TCS_SCROLLOPPOSITE
  | TCS_SINGLELINE
  | TCS_TABS
  | TCS_TOOLTIPS
  | TCS_VERTICAL

external tabcontrol_style_of_option : tabcontrol_style_option -> style = "tabcontrol_style_of_option"

let tabcontrol_style_of_options = special_style_of_options ~special_func:tabcontrol_style_of_option

(* Messages *)

let tcm_first = 0x1300

let tcm_adjustrect = tcm_first + 40
external issue_tcm_adjustrect : sender:message_sender -> larger:bool -> rect:rect -> rect = "issue_tcm_adjustrect"

let tcm_deleteallitems = tcm_first + 9
let pack_tcm_deleteallitems = pack_simple_message ~id:tcm_deleteallitems
external unpack_tcm_deleteallitems : message_result -> unit = "unpack_tcm_deleteallitems"
let issue_tcm_deleteallitems ~sender = unpack_tcm_deleteallitems (sender ~msg:pack_tcm_deleteallitems)

let tcm_deleteitem = tcm_first + 8
external pack_tcm_deleteitem : item:int -> message_contents = "pack_tcm_deleteitem"
external unpack_tcm_deleteitem : message_result -> unit = "unpack_tcm_deleteitem"
let issue_tcm_deleteitem ~sender ~item = unpack_tcm_deleteitem (sender ~msg:(pack_tcm_deleteitem ~item))

let tcm_deselectall = tcm_first + 50
external pack_tcm_deselectall : exclude_focus:bool -> message_contents = "pack_tcm_deselectall"
let unpack_tcm_deselectall = ignore
let issue_tcm_deselectall ~sender ~exclude_focus = unpack_tcm_deselectall (sender ~msg:(pack_tcm_deselectall ~exclude_focus))

let tcm_getcurfocus = tcm_first + 47
let pack_tcm_getcurfocus = pack_simple_message ~id:tcm_getcurfocus
external unpack_tcm_getcurfocus : message_result -> int = "unpack_tcm_getcurfocus"
let issue_tcm_getcurfocus ~sender = unpack_tcm_getcurfocus (sender ~msg:pack_tcm_getcurfocus)

let tcm_getcursel = tcm_first + 11
let pack_tcm_getcursel = pack_simple_message ~id:tcm_getcursel
external unpack_tcm_getcursel : message_result -> int = "unpack_tcm_getcursel"
let issue_tcm_getcursel ~sender = unpack_tcm_getcursel (sender ~msg:pack_tcm_getcursel)

let tcm_getextendedstyle = tcm_first + 53
let pack_tcm_getextendedstyle = pack_simple_message ~id:tcm_getextendedstyle
external unpack_tcm_getextendedstyle : message_result -> tabcontrol_extended_style list = "unpack_tcm_getextendedstyle"
let issue_tcm_getextendedstyle ~sender = unpack_tcm_getextendedstyle (sender ~msg:pack_tcm_getextendedstyle)

let tcm_getimagelist = tcm_first + 2
let pack_tcm_getimagelist = pack_simple_message ~id:tcm_getimagelist
external unpack_tcm_getimagelist : message_result -> himagelist = "unpack_tcm_getimagelist"
let issue_tcm_getimagelist ~sender = unpack_tcm_getimagelist (sender ~msg:pack_tcm_getimagelist)

let tcm_getitem = tcm_first + 5
external issue_tcm_getitem : sender:message_sender -> item:int -> mask:tcitem_component list -> tcitem = "issue_tcm_getitem"

let tcm_getitemcount = tcm_first + 4
let pack_tcm_getitemcount = pack_simple_message ~id:tcm_getitemcount
external unpack_tcm_getitemcount : message_result -> int = "unpack_tcm_getitemcount"
let issue_tcm_getitemcount ~sender = unpack_tcm_getitemcount (sender ~msg:pack_tcm_getitemcount)

let tcm_getitemrect = tcm_first + 10
external issue_tcm_getitemrect : sender:message_sender -> item:int -> rect = "issue_tcm_getitemrect"

let tcm_getrowcount = tcm_first + 44
let pack_tcm_getrowcount = pack_simple_message ~id:tcm_getrowcount
external unpack_tcm_getrowcount : message_result -> int = "unpack_tcm_getrowcount"
let issue_tcm_getrowcount ~sender = unpack_tcm_getrowcount (sender ~msg:pack_tcm_getrowcount)

let tcm_gettooltips = tcm_first + 45
let pack_tcm_gettooltips = pack_simple_message ~id:tcm_gettooltips
external unpack_tcm_gettooltips : message_result -> hwnd = "unpack_tcm_gettooltips"
let issue_tcm_gettooltips ~sender = unpack_tcm_gettooltips (sender ~msg:pack_tcm_gettooltips)

(* tcm_getunicodeformat: use ccm_getunicodeformat *)

let tcm_highlightitem = tcm_first + 51
external pack_tcm_highlightitem : item:int -> highlight:bool -> message_contents = "pack_tcm_highlightitem"
external unpack_tcm_highlightitem : message_result -> unit = "unpack_tcm_highlightitem"
let issue_tcm_highlightitem ~sender ~item ~highlight = unpack_tcm_highlightitem (sender ~msg:(pack_tcm_highlightitem ~item ~highlight))

let tcm_hittest = tcm_first + 13
type tabcontrol_hit_test_part =
    TCHT_ONITEM
  | TCHT_ONITEMICON
  | TCHT_ONITEMLABEL
type tabcontrol_hit_test_result =
    Tchtr_nowhere
  | Tchtr_onitem of int * tabcontrol_hit_test_part
external issue_tcm_hittest : sender:message_sender -> pt:point -> tabcontrol_hit_test_result = "issue_tcm_hittest"

let tcm_insertitem = tcm_first + 7
external issue_tcm_insertitem : sender:message_sender -> item:int -> tcitem:tcitem -> int = "issue_tcm_insertitem"

let tcm_removeimage = tcm_first + 42
external pack_tcm_removeimage : image:int -> message_contents = "pack_tcm_removeimage"
let unpack_tcm_removeimage = ignore
let issue_tcm_removeimage ~sender ~image = unpack_tcm_removeimage (sender ~msg:(pack_tcm_removeimage ~image))

let tcm_setcurfocus = tcm_first + 48
external pack_tcm_setcurfocus : item:int -> message_contents = "pack_tcm_setcurfocus"
let unpack_tcm_setcurfocus = ignore
let issue_tcm_setcurfocus ~sender ~item = unpack_tcm_setcurfocus (sender ~msg:(pack_tcm_setcurfocus ~item))

let tcm_setcursel = tcm_first + 12
external pack_tcm_setcursel : item:int -> message_contents = "pack_tcm_setcursel"
external unpack_tcm_setcursel : message_result -> int = "unpack_tcm_setcursel"
let issue_tcm_setcursel ~sender ~item = unpack_tcm_setcursel (sender ~msg:(pack_tcm_setcursel ~item))

let tcm_setextendedstyle = tcm_first + 52
external pack_tcm_setextendedstyle :
    mask:tabcontrol_extended_style list ->
    style:tabcontrol_extended_style list ->
    message_contents = "pack_tcm_setextendedstyle"
external unpack_tcm_setextendedstyle : message_result -> tabcontrol_extended_style list = "unpack_tcm_setextendedstyle"
let issue_tcm_setextendedstyle ~sender ~mask ~style = unpack_tcm_setextendedstyle (sender ~msg:(pack_tcm_setextendedstyle ~mask ~style))

let tcm_setimagelist = tcm_first + 3
external pack_tcm_setimagelist : iml:himagelist -> message_contents = "pack_tcm_setimagelist"
external unpack_tcm_setimagelist : message_result -> himagelist = "unpack_tcm_setimagelist"
let issue_tcm_setimagelist ~sender ~iml = unpack_tcm_setimagelist (sender ~msg:(pack_tcm_setimagelist ~iml))

let tcm_setitem = tcm_first + 6
external issue_tcm_setitem : sender:message_sender -> item:int -> tcitem:tcitem -> unit = "issue_tcm_setitem"

let tcm_setitemextra = tcm_first + 14
external pack_tcm_setitemextra : extra:int -> message_contents = "pack_tcm_setitemextra"
external unpack_tcm_setitemextra : message_result -> unit = "unpack_tcm_setitemextra"
let issue_tcm_setitemextra ~sender ~extra = unpack_tcm_setitemextra (sender ~msg:(pack_tcm_setitemextra ~extra))

let tcm_setitemsize = tcm_first + 41
external pack_tcm_setitemsize : size:size -> message_contents = "pack_tcm_setitemsize"
external unpack_tcm_setitemsize : message_result -> size = "unpack_tcm_setitemsize"
let issue_tcm_setitemsize ~sender ~size = unpack_tcm_setitemsize (sender ~msg:(pack_tcm_setitemsize ~size))

let tcm_setmintabwidth = tcm_first + 49
external pack_tcm_setmintabwidth : width:int -> message_contents = "pack_tcm_setmintabwidth"
external unpack_tcm_setmintabwidth : message_result -> int = "unpack_tcm_setmintabwidth"
let issue_tcm_setmintabwidth ~sender ~width = unpack_tcm_setmintabwidth (sender ~msg:(pack_tcm_setmintabwidth ~width))

let tcm_setpadding = tcm_first + 43
external pack_tcm_setpadding : padding:size -> message_contents = "pack_tcm_setpadding"
let unpack_tcm_setpadding = ignore
let issue_tcm_setpadding ~sender ~padding = unpack_tcm_setpadding (sender ~msg:(pack_tcm_setpadding ~padding))

let tcm_settooltips = tcm_first + 46
external pack_tcm_settooltips : tooltips:hwnd -> message_contents = "pack_tcm_settooltips"
external unpack_tcm_settooltips : message_result -> hwnd = "unpack_tcm_settooltips"
let issue_tcm_settooltips ~sender ~tooltips = unpack_tcm_settooltips (sender ~msg:(pack_tcm_settooltips ~tooltips))

(* tcm_setunicodeformat: use ccm_setunicodeformat *)

(* Notifications *)

type nmtckeydown = {
    nmtckd_key : virtual_key_code;
    nmtckd_data : key_data }
external unpack_nmtckeydown : msg:message_contents -> nmtckeydown = "unpack_nmtckeydown"

let tcn_first = -550
let tcn_last = -580

let tcn_getobject = tcn_first - 3
(* ... *)

let tcn_keydown = tcn_first - 0
let on_tcn_keydown = on_notify_message ~code:tcn_keydown ~unpack:unpack_nmtckeydown ~return:return_simple_message

let tcn_selchange = tcn_first - 1
let on_tcn_selchange = on_notify_message ~code:tcn_selchange ~unpack:unpack_simple_notify ~return:return_simple_message

let tcn_selchanging = tcn_first - 2
let on_tcn_selchanging = on_notify_message ~code:tcn_selchanging ~unpack:unpack_simple_notify ~return:return_common_notify
