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

let rebarclassname = "ReBarWindow32"

type rebar_band_style =
    RBBS_BREAK
  | RBBS_CHILDEDGE
  | RBBS_FIXEDBMP
  | RBBS_FIXEDSIZE
  | RBBS_GRIPPERALWAYS
  | RBBS_HIDDEN
  | RBBS_NOGRIPPER
  | RBBS_NOVERT
  | RBBS_VARIABLEHEIGHT

type rebar_color = {
    rbc_fore : color;
    rbc_back : color }
type rebar_child_size = {
    rbcs_min_size : size;
    rbcs_height : int;
    rbcs_max_height : int;
    rbcs_integral : int }
type rebarbandinfo = {
    rbbi_style : rebar_band_style list option;
    rbbi_colors : rebar_color option;
    rbbi_text : string option;
    rbbi_image : int option;
    rbbi_child : hwnd option;
    rbbi_child_size : rebar_child_size option;
    rbbi_size : int option;
    rbbi_background : hbitmap option;
    rbbi_id : int option;
    rbbi_ideal_size : int option;
    rbbi_lparam : int32 option;
    rbbi_header_size : int option }
let default_rebarbandinfo = {
    rbbi_style = None;
    rbbi_colors = None;
    rbbi_text = None;
    rbbi_image = None;
    rbbi_child = None;
    rbbi_child_size = None;
    rbbi_size = None;
    rbbi_background = None;
    rbbi_id = None;
    rbbi_ideal_size = None;
    rbbi_lparam = None;
    rbbi_header_size = None }

type rebarbandinfo_component =
    Rbbim_style
  | Rbbim_colors
  | Rbbim_text of int
  | Rbbim_image
  | Rbbim_child
  | Rbbim_childsize
  | Rbbim_size
  | Rbbim_background
  | Rbbim_id
  | Rbbim_idealsize
  | Rbbim_lparam
  | Rbbim_headersize

(* Styles *)

type rebar_style_option =
    RBS_AUTOSIZE
  | RBS_BANDBORDERS
  | RBS_DBLCLKTOGGLE
  | RBS_FIXEDORDER
  | RBS_REGISTERDROP
  | RBS_TOOLTIPS
  | RBS_VARHEIGHT
  | RBS_VERTICALGRIPPER

external rebar_style_of_option : rebar_style_option -> style = "rebar_style_of_option"

let rebar_style_of_options = special_style_of_options ~special_func:rebar_style_of_option

(* Messages *)

let rb_begindrag = wm_user + 24
external pack_rb_begindrag : band:int -> pos:point option -> message_contents = "pack_rb_begindrag"
let unpack_rb_begindrag = ignore
let issue_rb_begindrag ~sender ~band ~pos = unpack_rb_begindrag (sender ~msg:(pack_rb_begindrag ~band ~pos))

let rb_deleteband = wm_user + 2
external pack_rb_deleteband : band:int -> message_contents = "pack_rb_deleteband"
external unpack_rb_deleteband : message_result -> unit = "unpack_rb_deleteband"
let issue_rb_deleteband ~sender ~band = unpack_rb_deleteband (sender ~msg:(pack_rb_deleteband ~band))

let rb_dragmove = wm_user + 26
external pack_rb_dragmove : pos:point option -> message_contents = "pack_rb_dragmove"
let unpack_rb_dragmove = ignore
let issue_rb_dragmove ~sender ~pos = unpack_rb_dragmove (sender ~msg:(pack_rb_dragmove ~pos))

let rb_enddrag = wm_user + 25
let pack_rb_enddrag = pack_simple_message ~id:rb_enddrag
let unpack_rb_enddrag = ignore
let issue_rb_enddrag ~sender = unpack_rb_enddrag (sender ~msg:pack_rb_enddrag)

let rb_getbandborders = wm_user + 34
external issue_rb_getbandborders : sender:message_sender -> band:int -> rect = "issue_rb_getbandborders"

let rb_getbandcount = wm_user + 12
let pack_rb_getbandcount = pack_simple_message ~id:rb_getbandcount
external unpack_rb_getbandcount : message_result -> int = "unpack_rb_getbandcount"
let issue_rb_getbandcount ~sender = unpack_rb_getbandcount (sender ~msg:pack_rb_getbandcount)

let rb_getbandinfo = wm_user + 29
external issue_rb_getbandinfo : sender:message_sender -> band:int -> mask:rebarbandinfo_component list -> rebarbandinfo = "issue_rb_getbandinfo"

let rb_getbarheight = wm_user + 27
let pack_rb_getbarheight = pack_simple_message ~id:rb_getbarheight
external unpack_rb_getbarheight : message_result -> int = "unpack_rb_getbarheight"
let issue_rb_getbarheight ~sender = unpack_rb_getbarheight (sender ~msg:pack_rb_getbarheight)

let rb_getbarinfo = wm_user + 3
external issue_rb_getbarinfo : sender:message_sender -> himagelist = "issue_rb_getbarinfo"

let rb_getbkcolor = wm_user + 20
let pack_rb_getbkcolor = pack_simple_message ~id:rb_getbkcolor
external unpack_rb_getbkcolor : message_result -> color = "unpack_rb_getbkcolor"
let issue_rb_getbkcolor ~sender = unpack_rb_getbkcolor (sender ~msg:pack_rb_getbkcolor)

let rb_getdroptarget = ccm_first + 4
(* ... *)

let rb_getcolorscheme = ccm_first + 3
external issue_rb_getcolorscheme : sender:message_sender -> colorscheme = "issue_rb_getcolorscheme"

let rb_getpalette = wm_user + 38
let pack_rb_getpalette = pack_simple_message ~id:rb_getpalette
external unpack_rb_getpalette : message_result -> hpalette = "unpack_rb_getpalette"
let issue_rb_getpalette ~sender = unpack_rb_getpalette (sender ~msg:pack_rb_getpalette)

let rb_getrect = wm_user + 9
external issue_rb_getrect : sender:message_sender -> band:int -> rect = "issue_rb_getrect"

let rb_getrowcount = wm_user + 13
let pack_rb_getrowcount = pack_simple_message ~id:rb_getrowcount
external unpack_rb_getrowcount : message_result -> int = "unpack_rb_getrowcount"
let issue_rb_getrowcount ~sender = unpack_rb_getrowcount (sender ~msg:pack_rb_getrowcount)

let rb_getrowheight = wm_user + 14
external pack_rb_getrowheight : row:int -> message_contents = "pack_rb_getrowheight"
external unpack_rb_getrowheight : message_result -> int = "unpack_rb_getrowheight"
let issue_rb_getrowheight ~sender ~row = unpack_rb_getrowheight (sender ~msg:(pack_rb_getrowheight ~row))

let rb_gettextcolor = wm_user + 22
let pack_rb_gettextcolor = pack_simple_message ~id:rb_gettextcolor
external unpack_rb_gettextcolor : message_result -> color = "unpack_rb_gettextcolor"
let issue_rb_gettextcolor ~sender = unpack_rb_gettextcolor (sender ~msg:pack_rb_gettextcolor)

let rb_gettooltips = wm_user + 17
let pack_rb_gettooltips = pack_simple_message ~id:rb_gettooltips
external unpack_rb_gettooltips : message_result -> hwnd = "unpack_rb_gettooltips"
let issue_rb_gettooltips ~sender = unpack_rb_gettooltips (sender ~msg:pack_rb_gettooltips)

(* rb_getunicodeformat: use ccm_getunicodeformat *)

let rb_hittest = wm_user + 8
type rebar_hit_test_part =
    RBHT_CAPTION
  | RBHT_CLIENT
  | RBHT_GRABBER
type rebar_hit_test_result =
    Rbht_nowhere
  | Rbht_band of int * rebar_hit_test_part
external issue_rb_hittest : sender:message_sender -> pt:point -> rebar_hit_test_result = "issue_rb_hittest"

let rb_idtoindex = wm_user + 16
external pack_rb_idtoindex : id:int -> message_contents = "pack_rb_idtoindex"
external unpack_rb_idtoindex : message_result -> int = "unpack_rb_idtoindex"
let issue_rb_idtoindex ~sender ~id = unpack_rb_idtoindex (sender ~msg:(pack_rb_idtoindex ~id))

let rb_insertband = wm_user + 1
external issue_rb_insertband : sender:message_sender -> band:int -> info:rebarbandinfo -> unit = "issue_rb_insertband"

let rb_maximizeband = wm_user + 31
external pack_rb_maximizeband : band:int -> ideal:bool -> message_contents = "pack_rb_maximizeband"
let unpack_rb_maximizeband = ignore
let issue_rb_maximizeband ~sender ~band ~ideal = unpack_rb_maximizeband (sender ~msg:(pack_rb_maximizeband ~band ~ideal))

let rb_minimizeband = wm_user + 30
external pack_rb_minimizeband : band:int -> message_contents = "pack_rb_minimizeband"
let unpack_rb_minimizeband = ignore
let issue_rb_minimizeband ~sender ~band = unpack_rb_minimizeband (sender ~msg:(pack_rb_minimizeband ~band))

let rb_moveband = wm_user + 39
external pack_rb_moveband : from_band:int -> to_band:int -> message_contents = "pack_rb_moveband"
external unpack_rb_moveband : message_result -> unit = "unpack_rb_moveband"
let issue_rb_moveband ~sender ~from_band ~to_band = unpack_rb_moveband (sender ~msg:(pack_rb_moveband ~from_band ~to_band))

let rb_setbandinfo = wm_user + 6
external issue_rb_setbandinfo : sender:message_sender -> band:int -> info:rebarbandinfo -> unit = "issue_rb_setbandinfo"

let rb_setbarinfo = wm_user + 4
external issue_rb_setbarinfo : sender:message_sender -> iml:himagelist -> unit = "issue_rb_setbarinfo"

let rb_setbkcolor = wm_user + 19
external pack_rb_setbkcolor : color:color -> message_contents = "pack_rb_setbkcolor"
external unpack_rb_setbkcolor : message_result -> color = "unpack_rb_setbkcolor"
let issue_rb_setbkcolor ~sender ~color = unpack_rb_setbkcolor (sender ~msg:(pack_rb_setbkcolor ~color))

let rb_setcolorscheme = ccm_first + 2
external issue_rb_setcolorscheme : sender:message_sender -> cs:colorscheme -> unit = "issue_rb_setcolorscheme"

let rb_setpalette = wm_user + 37
external pack_rb_setpalette : palette:hpalette -> message_contents = "pack_rb_setpalette"
external unpack_rb_setpalette : message_result -> hpalette = "unpack_rb_setpalette"
let issue_rb_setpalette ~sender ~palette = unpack_rb_setpalette (sender ~msg:(pack_rb_setpalette ~palette))

let rb_setparent = wm_user + 7
external pack_rb_setparent : parent:hwnd -> message_contents = "pack_rb_setparent"
external unpack_rb_setparent : message_result -> hwnd = "unpack_rb_setparent"
let issue_rb_setparent ~sender ~parent = unpack_rb_setparent (sender ~msg:(pack_rb_setparent ~parent))

let rb_settextcolor = wm_user + 21
external pack_rb_settextcolor : color:color -> message_contents = "pack_rb_settextcolor"
external unpack_rb_settextcolor : message_result -> color = "unpack_rb_settextcolor"
let issue_rb_settextcolor ~sender ~color = unpack_rb_settextcolor (sender ~msg:(pack_rb_settextcolor ~color))

let rb_settooltips = wm_user + 18
external pack_rb_settooltips : tooltips:hwnd -> message_contents = "pack_rb_settooltips"
let unpack_rb_settooltips = ignore
let issue_rb_settooltips ~sender ~tooltips = unpack_rb_settooltips (sender ~msg:(pack_rb_settooltips ~tooltips))

(* rb_setunicodeformat: use ccm_setunicodeformat *)

let rb_showband = wm_user + 35
external pack_rb_showband : band:int -> show:bool -> message_contents = "pack_rb_showband"
external unpack_rb_showband : message_result -> unit = "unpack_rb_showband"
let issue_rb_showband ~sender ~band ~show = unpack_rb_showband (sender ~msg:(pack_rb_showband ~band ~show))

let rb_sizetorect = wm_user + 23
external issue_rb_sizetorect : sender:message_sender -> rect:rect -> bool = "issue_rb_sizetorect"

(* Notifications *)

external unpack_nmcustomdraw_rebar_item_spec : msg:message_contents -> int = "unpack_nmcustomdraw_rebar_item_spec"

type nmrebar = {
    nmrb_band : int option;
    nmrb_style : rebar_band_style list option;
    nmrb_id : int option;
    nmrb_lparam : int32 option }
external unpack_nmrebar : msg:message_contents -> nmrebar = "unpack_nmrebar"

type nmrebarchildsize = {
    nmrbcs_band : int option;
    nmrbcs_id : int;
    nmrbcs_child_rect : rect;
    nmrbcs_band_rect : rect }

type nmrbautosize = {
    nmrbas_changed : bool;
    nmrbas_target : rect;
    nmrbas_actual : rect }
external unpack_nmrbautosize : msg:message_contents -> nmrbautosize = "unpack_nmrbautosize"

let rbn_first = -831
let rbn_last = -859

let rbn_autosize = rbn_first - 3
let on_rbn_autosize = on_notify_message ~code:rbn_autosize ~unpack:unpack_nmrbautosize ~return:return_simple_message

let rbn_begindrag = rbn_first - 4
let on_rbn_begindrag = on_notify_message ~code:rbn_begindrag ~unpack:unpack_nmrebar ~return:return_common_notify

let rbn_childsize = rbn_first - 8
external on_rbn_childsize :
    (nmrebarchildsize, rect) notify_message_handler ->
    wnd:hwnd ->
    msg:message_contents ->
    message_result option = "on_rbn_childsize"

let rbn_deletedband = rbn_first - 7
let on_rbn_deletedband = on_notify_message ~code:rbn_deletedband ~unpack:unpack_nmrebar ~return:return_simple_message

let rbn_deletingband = rbn_first - 6
let on_rbn_deletingband = on_notify_message ~code:rbn_deletingband ~unpack:unpack_nmrebar ~return:return_simple_message

let rbn_enddrag = rbn_first - 5
let on_rbn_enddrag = on_notify_message ~code:rbn_enddrag ~unpack:unpack_nmrebar ~return:return_simple_message

let rbn_getobject = rbn_first - 1
(* ... *)

let rbn_heightchange = rbn_first - 0
let on_rbn_heightchange = on_notify_message ~code:rbn_heightchange ~unpack:unpack_simple_notify ~return:return_simple_message

let rbn_layoutchanged = rbn_first - 2
let on_rbn_layoutchanged = on_notify_message ~code:rbn_layoutchanged ~unpack:unpack_simple_notify ~return:return_simple_message
