我想实现当鼠标在区域内单击时响应某些动作的绘图区域。所以我连接到motion_notify
事件,但是单击鼠标按钮时没有任何反应。这是示例代码:
文件图.ml
open GObj
class gridViewCanvas ?width ?height ?packing ?show rows cols =
let vbox = GPack.vbox ?width ?height ?packing ?show () in
let da = GMisc.drawing_area ~packing:vbox#add () in
let drawable = lazy (new GDraw.drawable da#misc#window) in
object (self)
inherit widget vbox#as_widget
initializer
ignore(da#event#connect#expose
~callback: (fun _ -> self#repaint (); false));
ignore(da#event#connect#motion_notify
~callback: (fun _ -> prerr_endline "OK"; false))
method private drawGrid drawable =
let (width, height) = drawable#size in
let cellWidth = float_of_int width /. float_of_int cols in
let cellHeight = float_of_int height /. float_of_int rows in
drawable#set_foreground `BLACK;
let currHeight : float ref = ref 0. in
for i = 0 to rows - 1 do
drawable#line ~x: 0 ~y: (int_of_float !currHeight)
~x: width ~y: (int_of_float !currHeight);
currHeight := !currHeight +. cellHeight;
done;
let currWidth : float ref = ref 0. in
for i = 0 to cols - 1 do
drawable#line ~x: (int_of_float !currWidth) ~y: 0
~x: (int_of_float !currWidth) ~y: height;
currWidth := !currWidth +. cellWidth;
done;
()
method private repaint () =
let drawable = Lazy.force drawable in
let (width, height) = drawable#size in
drawable#set_foreground `WHITE;
drawable#rectangle ~x:0 ~y:0 ~width ~height ~filled:true ();
self#drawGrid drawable
end
文件 test.ml
open GMain
open GdkKeysyms
open Graph
let locale = GtkMain.Main.init ()
let main () =
let window = GWindow.window ~width:640 ~height:480
~title:"Title" () in
let vbox = GPack.vbox ~packing:window#add () in
window#connect#destroy ~callback:Main.quit;
let menubar = GMenu.menu_bar ~packing:vbox#pack () in
let factory = new GMenu.factory menubar in
let accel_group = factory#accel_group in
let file_menu = factory#add_submenu "File" in
let factory = new GMenu.factory file_menu ~accel_group in
factory#add_item "Quit" ~key:_Q ~callback: Main.quit;
let graph = new gridViewCanvas ~packing:vbox#add 5 3 in
window#show ();
Main.main ()
let () =
main ()
编译
ocamlfind ocamlc -g -package lablgtk2 -linkpkg graph.ml test.ml -o graphtest
知道我做错了什么吗?