(* OCaml-Win32
 * win32_statusbar.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: Status Bars *)

let statusclassname = "msctls_statusbar32"

type statusbar_text_option =
    SBT_NOBORDERS
  | SBT_OWNERDRAW
  | SBT_POPOUT
  | SBT_RTLREADING

external create_status_window : style:style -> text:string -> parent:hwnd -> id:int -> hwnd = "create_status_window"

external draw_status_text : dc:hdc -> rect:rect -> text:string -> options:statusbar_text_option list -> unit = "draw_status_text"

external menu_help :
    msg:message_contents ->
    menu:hmenu ->
    inst:hinstance ->
    status:hwnd ->
    id_menu_pairs:(int * hmenu) list ->
    unit = "menu_help"

(* Styles *)

type statusbar_style_option =
    SBARS_SIZEGRIP

external statusbar_style_of_option : statusbar_style_option -> style = "statusbar_style_of_option"

let statusbar_style_of_options = special_common_control_style_of_options ~special_func:statusbar_style_of_option

(* Messages *)

let sb_getborders = wm_user + 7
external issue_sb_getborders : sender:message_sender -> (int * int * int) = "issue_sb_getborders"

let sb_geticon = wm_user + 20
external pack_sb_geticon : part:int -> message_contents = "pack_sb_geticon"
external unpack_sb_geticon : message_result -> hicon = "unpack_sb_geticon"
let issue_sb_geticon ~sender ~part = unpack_sb_geticon (sender ~msg:(pack_sb_geticon ~part))

let sb_getparts = wm_user + 6
external issue_sb_getparts : sender:message_sender -> max_count:int -> (int * int array) = "issue_sb_getparts"

let sb_getrect = wm_user + 10
external issue_sb_getrect : sender:message_sender -> part:int -> rect = "issue_sb_getrect"

let sb_gettext = wm_user + 2
external issue_sb_gettext : sender:message_sender -> part:int -> max_length:int -> (string * statusbar_text_option list) = "issue_sb_gettext"
external pack_sb_gettext_ownerdraw : part:int -> message_contents = "pack_sb_gettext_ownerdraw"
external unpack_sb_gettext_ownerdraw : message_result -> int32 = "unpack_sb_gettext_ownerdraw"
let issue_sb_gettext_ownerdraw ~sender ~part = unpack_sb_gettext_ownerdraw (sender ~msg:(pack_sb_gettext_ownerdraw ~part))

let sb_gettextlength = wm_user + 3
external pack_sb_gettextlength : part:int -> message_contents = "pack_sb_gettextlength"
external unpack_sb_gettextlength : message_result -> (int * statusbar_text_option list) = "unpack_sb_gettextlength"
let issue_sb_gettextlength ~sender ~part = unpack_sb_gettextlength (sender ~msg:(pack_sb_gettextlength ~part))

let sb_gettiptext = wm_user + 18
external issue_sb_gettiptext : sender:message_sender -> part:int -> max_length:int -> string = "issue_sb_gettiptext"

(* sb_getunicodeformat: use ccm_getunicodeformat *)

let sb_issimple = wm_user + 14
let pack_sb_issimple = pack_simple_message ~id:sb_issimple
external unpack_sb_issimple : message_result -> bool = "unpack_sb_issimple"
let issue_sb_issimple ~sender = unpack_sb_issimple (sender ~msg:pack_sb_issimple)

let sb_setbkcolor = ccm_first + 1
external pack_sb_setbkcolor : color:color -> message_contents = "pack_sb_setbkcolor"
external unpack_sb_setbkcolor : message_result -> color = "unpack_sb_setbkcolor"
let issue_sb_setbkcolor ~sender ~color = unpack_sb_setbkcolor (sender ~msg:(pack_sb_setbkcolor ~color))

let sb_seticon = wm_user + 15
external pack_sb_seticon : part:int -> icon:hicon -> message_contents = "pack_sb_seticon"
external unpack_sb_seticon : message_result -> unit = "unpack_sb_seticon"
let issue_sb_seticon ~sender ~part ~icon = unpack_sb_seticon (sender ~msg:(pack_sb_seticon ~part ~icon))

let sb_setminheight = wm_user + 8
external pack_sb_setminheight : height:int -> message_contents = "pack_sb_setminheight"
let unpack_sb_setminheight = ignore
let issue_sb_setminheight ~sender ~height = unpack_sb_setminheight (sender ~msg:(pack_sb_setminheight ~height))

let sb_setparts = wm_user + 4
external issue_sb_setparts : sender:message_sender -> widths:int array -> unit = "issue_sb_setparts"

let sb_settext = wm_user + 1
external issue_sb_settext :
    sender:message_sender ->
    part:int ->
    text:string ->
    options:statusbar_text_option list ->
    unit = "issue_sb_settext"
external pack_sb_settext_ownerdraw : part:int -> data:int32 -> message_contents = "pack_sb_settext_ownerdraw"
external unpack_sb_settext_ownerdraw : message_result -> unit = "unpack_sb_settext_ownerdraw"
let issue_sb_settext_ownerdraw ~sender ~part ~data = unpack_sb_settext_ownerdraw (sender ~msg:(pack_sb_settext_ownerdraw ~part ~data))

let sb_settiptext = wm_user + 16
external issue_sb_settiptext : sender:message_sender -> part:int -> text:string -> unit = "issue_sb_settiptext"

(* sb_setunicodeformat: use ccm_setunicodeformat *)

let sb_simple = wm_user + 9
external pack_sb_simple : simple:bool -> message_contents = "pack_sb_simple"
external unpack_sb_simple : message_result -> unit = "unpack_sb_simple"
let issue_sb_simple ~sender ~simple = unpack_sb_simple (sender ~msg:(pack_sb_simple ~simple))

(* Notifications *)

let sbn_first = -880
let sbn_last = -899

let sbn_simplemodechange = sbn_first - 0
let on_sbn_simplemodechange = on_notify_message ~code:sbn_simplemodechange ~unpack:unpack_simple_notify ~return:return_simple_message
