helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gRange.ml

   1 (* $Id$ *)
   2
   3 open Gaux
   4 open Gtk
   5 open GtkBase
   6 open GtkRange
   7 open GObj
   8
   9 class progress obj = object
  10   inherit widget_full obj
  11   method set_adjustment adj =
  12     Progress.set_adjustment obj (GData.as_adjustment adj)
  13   method set_show_text = Progress.set_show_text obj
  14   method set_format_string = Progress.set_format_string obj
  15   method set_text_alignment = Progress.set_text_alignment obj
  16   method set_activity_mode = Progress.set_activity_mode obj
  17   method set_value = Progress.set_value obj
  18   method set_percentage = Progress.set_percentage obj
  19   method configure = Progress.configure obj
  20   method value = Progress.get_value obj
  21   method percentage = Progress.get_percentage obj
  22   method current_text = Progress.get_current_text obj
  23   method adjustment = new GData.adjustment (Progress.get_adjustment obj)
  24 end
  25
  26 class progress_bar obj = object
  27   inherit progress (obj : Gtk.progress_bar obj)
  28   method event = new GObj.event_ops obj
  29   method set_bar_style = ProgressBar.set_bar_style obj
  30   method set_discrete_blocks = ProgressBar.set_discrete_blocks obj
  31   method set_activity_step = ProgressBar.set_activity_step obj
  32   method set_activity_blocks = ProgressBar.set_activity_blocks obj
  33   method set_orientation = ProgressBar.set_orientation obj
  34 end
  35
  36 let progress_bar ?adjustment ?bar_style ?discrete_blocks
  37     ?activity_step ?activity_blocks ?value ?percentage ?activity_mode
  38     ?show_text ?format_string ?text_xalign ?text_yalign
  39     ?packing ?show () =
  40   let w =
  41     match adjustment with None -> ProgressBar.create ()
  42     | Some adj ->
  43         ProgressBar.create_with_adjustment (GData.as_adjustment adj)
  44   in
  45   ProgressBar.set w ?bar_style ?discrete_blocks
  46     ?activity_step ?activity_blocks;
  47   Progress.set w ?value ?percentage ?activity_mode
  48     ?show_text ?format_string ?text_xalign ?text_yalign;
  49   pack_return (new progress_bar w) ~packing ~show
  50
  51 class range obj = object
  52   inherit widget_full obj
  53   method adjustment = new GData.adjustment (Range.get_adjustment obj)
  54   method set_adjustment adj =
  55     Range.set_adjustment obj (GData.as_adjustment adj)
  56   method set_update_policy = Range.set_update_policy obj
  57 end
  58
  59 class scale obj = object
  60   inherit range (obj : Gtk.scale obj)
  61   method set_digits = Scale.set_digits obj
  62   method set_draw_value = Scale.set_draw_value obj
  63   method set_value_pos = Scale.set_value_pos obj
  64 end
  65
  66 let scale dir ?adjustment ?digits ?draw_value ?value_pos
  67     ?packing ?show () =
  68   let w =
  69     Scale.create dir ?adjustment:(may_map ~f:GData.as_adjustment adjustment)
  70   in
  71   let () = Scale.set w ?digits ?draw_value ?value_pos in
  72   pack_return (new scale w) ~packing ~show
  73
  74 class scrollbar obj = object
  75   inherit range (obj : Gtk.scrollbar obj)
  76   method event = new GObj.event_ops obj
  77 end
  78
  79 let scrollbar dir ?adjustment ?update_policy ?packing ?show () =
  80   let w = Scrollbar.create dir
  81       ?adjustment:(may_map ~f:GData.as_adjustment adjustment) in
  82   let () = may update_policy ~f:(Range.set_update_policy w) in
  83   pack_return (new scrollbar w) ~packing ~show