Right mouse button selection mode

Patch by Nikola Radovanovic <nrad@eunet.rs>

1 files changed, 38 insertions, 3 deletions

diff --git a/libgtk_kylix/GTKControls.pas b/libgtk_kylix/GTKControls.pas
index 8004857..d839a65 100644
--- a/libgtk_kylix/GTKControls.pas
+++ b/libgtk_kylix/GTKControls.pas
@@ -1,6 +1,6 @@
 (*
     GTK-Kylix Library: GTKControls - Basic objects
-    Version 0.6.22  (last updated 2007-12-19)
+    Version 0.6.23  (last updated 2008-11-11)
     Copyright (C) 2007 Tomas Bzatek <tbzatek@users.sourceforge.net>
 
     This library is free software; you can redistribute it and/or
@@ -62,7 +62,7 @@ type
   TGTKPosition = (poLeft, poRight, poTop, poBottom);
   
 (****************************************** TGTKCONTROL *************************************************************************)
-  TGDKMouseButton = (mbLeft, mbMiddle, mbRight);
+  TGDKMouseButton = (mbLeft, mbMiddle, mbRight, mbNoButton);
   TGDKKeyEvent = procedure (Sender: TObject; Key: Word; Shift: TShiftState; var Accept: boolean) of object;
   TGDKMouseEvent = procedure (Sender: TObject; Button: TGDKMouseButton; Shift: TShiftState; X, Y: Integer; var Accept: boolean) of object;
   TGDKFocusEvent = procedure (Sender: TObject; var Accept: boolean) of object;
@@ -74,7 +74,7 @@ type
     FParent: TGTKControl;
     FPopupMenu: TGTKControl;
     FButtonPressSignalHandler, FButtonReleaseSignalHandler, FKeyDownSignalHandler, FKeyUpSignalHandler,
-    FFocusInSignalHandler, FFocusOutSignalHandler, FExposeSignalHandler: gulong;
+    FFocusInSignalHandler, FFocusOutSignalHandler, FExposeSignalHandler, FMotionNotifyHandler: gulong;
     FOnKeyDown: TGDKKeyEvent;
     FOnKeyUp: TGDKKeyEvent;
     FOnEnter: TGDKFocusEvent;
@@ -83,6 +83,7 @@ type
     FOnMouseUp: TGDKMouseEvent;
     FOnDblClick: TGDKMouseEvent;
     FOnExpose: TGDKExposeEvent;
+    FOnMouseMove: TGDKMouseEvent;
     function GetWidth: Integer;
     function GetHeight: Integer;
     function GetLeft: Integer;
@@ -111,6 +112,7 @@ type
     procedure SetCanFocus(Value: boolean);
     procedure SetOnExpose(Value: TGDKExposeEvent);
     procedure SetControlState(Value: TGTKControlState);
+    procedure SetOnMouseMove(Value: TGDKMouseEvent);
   protected
     procedure SetParent(const Value: TGTKControl); virtual;
   public
@@ -159,6 +161,7 @@ type
     property OnExit: TGDKFocusEvent read FOnExit write SetOnExit;
     property OnMouseDown: TGDKMouseEvent read FOnMouseDown write SetOnMouseDown;
     property OnMouseUp: TGDKMouseEvent read FOnMouseUp write SetOnMouseUp;
+    property OnMouseMove: TGDKMouseEvent read FOnMouseMove write SetOnMouseMove;
     property OnDblClick: TGDKMouseEvent read FOnDblClick write SetOnDblClick;
     property OnExpose: TGDKExposeEvent read FOnExpose write SetOnExpose;
     property ComponentState;
@@ -313,6 +316,9 @@ begin
   FOnEnter := nil;
   FOnExit := nil;
   FOnExpose := nil;
+  FOnMouseMove := nil;
+  FOnMouseDown := nil;
+  FOnMouseUp := nil;
 end;
 
 destructor TGTKControl.Destroy;
@@ -702,6 +708,35 @@ begin
   end;
 end;
 
+function TGTKControl_motion_notify_event(widget: PGtkWidget; event: PGdkEventMotion; user_data: gpointer): gboolean; cdecl;
+var Shift: TShiftState;
+    Button: TGDKMouseButton;
+    Accept: boolean;
+begin
+  Accept := True;
+  if event^.is_hint <> 0 then Exit;
+  Shift := [];
+  if event^.state and GDK_SHIFT_MASK = GDK_SHIFT_MASK then Include(Shift, ssShift);
+  if event^.state and GDK_CONTROL_MASK = GDK_CONTROL_MASK then Include(Shift, ssCtrl);
+  if event^.state and GDK_MOD1_MASK = GDK_MOD1_MASK then Include(Shift, ssAlt);
+  if event^.state and GDK_BUTTON1_MASK = GDK_BUTTON1_MASK then Button := mbLeft else
+  if event^.state and GDK_BUTTON2_MASK = GDK_BUTTON2_MASK then Button := mbMiddle else
+  if event^.state and GDK_BUTTON3_MASK = GDK_BUTTON3_MASK then Button := mbRight else
+  Button := mbNoButton;
+  if Assigned(TGTKControl(widget).FOnMouseMove)
+    then TGTKControl(widget).FOnMouseMove(TGTKControl(widget), Button, Shift, Trunc(event^.x), Trunc(event^.y), Accept);
+  Result := not Accept;
+end;
+
+procedure TGTKControl.SetOnMouseMove(Value: TGDKMouseEvent);
+begin
+  if @FOnMouseMove <> @Value then begin
+    FOnMouseMove := Value;
+    if Assigned(Value) then FMotionNotifyHandler := g_signal_connect_swapped(PGtkObject(FWidget), 'motion-notify-event', G_CALLBACK(@TGTKControl_motion_notify_event), Self)
+                       else g_signal_handler_disconnect(PGtkObject(FWidget), FMotionNotifyHandler);
+  end;
+end;
+
 function TGTKControl.GetDefault: boolean;
 begin
   Result := False;