1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
|
let _ = GMain.init ()
(* Un texte fictif pour remplir les GText.view. *)
let dots =
let buf = Buffer.create 16 in
let str = String.make 80 'A' ^ "\n" in
for i = 1 to 10 do Buffer.add_string buf str done;
Buffer.contents buf
(* La fenêtre principale. *)
let window =
let wnd = GWindow.window
~resizable:false
~position:`CENTER () in
wnd#connect#destroy GMain.quit;
wnd
let container = GPack.vbox
~spacing:10
~border_width:10
~packing:window#add ()
(* Une fonction pour créer un GText.view avec des barres de défilement.
* Le buffer du GText.view est initialisé avec le texte précédent. *)
let make_view ~packing =
let scroll = GBin.scrolled_window
~hpolicy:`ALWAYS
~vpolicy:`ALWAYS
~packing () in
let view = GText.view ~wrap_mode:`CHAR ~packing:scroll#add () in
view#buffer#set_text dots;
view
(* Une liste de 16 GText.view. *)
let views =
let table = GPack.table
~rows:4
~columns:4
~row_spacings:10
~col_spacings:10
~homogeneous:true
~packing:container#add () in
let rec loop acc = function
| (4, _) -> acc
| (i, 4) -> loop acc (i + 1, 0)
| (i ,j) -> let packing = table#attach ~left:i ~top:j in
loop (make_view ~packing :: acc) (i, j + 1)
in loop [] (0, 0)
(* La fonction qui permet d'effacer le contenu des buffers.
* On peut aussi utiliser view#buffer#set_text "". *)
let reset_buffers () =
List.iter (fun view ->
view#buffer#delete
~start:view#buffer#start_iter
~stop:view#buffer#end_iter
) views
(* Le bouton d'effacement. *)
let clear_button =
let btn = GButton.button
~label:"Effacer"
~packing:(container#pack ~expand:false) () in
btn#connect#clicked reset_buffers;
btn
let _ =
window#show ();
GMain.main () |
Partager