* DoMouseEnterLeaveCheck implemented in Windows. This needs testing as I was developing under Linux only.

* Reworked the EventTest example and am now exposing all possible FPGM_ messages. The demo still needs some work though.
* Implemented Mouse Scroll support under X11

3 files changed, 229 insertions, 64 deletions

diff --git a/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr b/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr
index 786ec3a0..56cadd16 100644
--- a/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr
+++ b/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr
@@ -6,27 +6,37 @@ uses
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   cthreads,
   {$ENDIF}{$ENDIF}
-  Classes, SysUtils, GFXBase, fpGFX, gui_form, gfx_widget;
+  Classes, SysUtils, GFXBase, fpGFX, gfx_widget;
   
 type
-  TMainForm = class(TfpgForm)
+
+  { TMainForm }
+
+  TMainForm = class(TfpgWindow)
   private
+    FMoveEventCount: integer;
     function    ShiftStateToStr(AShift: word): string;
     function    MouseState(AShift: word; const AMousePos: TPoint): string;
+    procedure   MsgActivate(var msg: TfpgMessageRec); message FPGM_ACTIVATE;
+    procedure   MsgDeActivate(var msg: TfpgMessageRec); message FPGM_DEACTIVATE;
+    procedure   MsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE;
+    procedure   MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT;
+    procedure   MsgResize(var msg: TfpgMessageRec); message FPGM_RESIZE;
+    procedure   MsgMove(var msg: TfpgMessageRec); message FPGM_MOVE;
+    procedure   MsgKeyChar(var msg: TfpgMessageRec); message FPGM_KEYCHAR;
+    procedure   MsgKeyPress(var msg: TfpgMessageRec); message FPGM_KEYPRESS;
+    procedure   MsgKeyRelease(var msg: TfpgMessageRec); message FPGM_KEYRELEASE;
+    procedure   MsgMouseDown(var msg: TfpgMessageRec); message FPGM_MOUSEDOWN;
+    procedure   MsgMouseUp(var msg: TfpgMessageRec); message FPGM_MOUSEUP;
+    procedure   MsgMouseMove(var msg: TfpgMessageRec); message FPGM_MOUSEMOVE;
+    procedure   MsgDoubleClick(var msg: TfpgMessageRec); message FPGM_DOUBLECLICK;
+    procedure   MsgMouseEnter(var msg: TfpgMessageRec); message FPGM_MOUSEENTER;
+    procedure   MsgMouseExit(var msg: TfpgMessageRec); message FPGM_MOUSEEXIT;
+    procedure   MsgScroll(var msg: TfpgMessageRec); message FPGM_SCROLL;
   protected
-    procedure   HandleClose; override;
-    procedure   HandlePaint; override;
-    procedure   HandleDoubleClick(x, y: integer; button: word; shiftstate: word); override;
-    procedure   HandleKeyChar(var keycode: word; var shiftstate: word; var consumed: boolean); override;
-    procedure   HandleMouseEnter; override;
-    procedure   HandleMouseExit; override;
-    procedure   HandleMouseMove(x, y: integer; btnstate: word; shiftstate: word); override;
-    procedure   HandleLMouseDown(x, y: integer; shiftstate: word); override;
-    procedure   HandleLMouseUp(x, y: integer; shiftstate: word); override;
-    procedure   HandleRMouseDown(x, y: integer; shiftstate: word); override;
-    procedure   HandleRMouseUp(x, y: integer; shiftstate: word); override;
   public
     constructor Create(aowner: TComponent); override;
+    procedure   Show;
   end;
 
 { TMainForm }
@@ -54,85 +64,128 @@ begin
   Result := Result + '] ';
 end;
 
-procedure TMainForm.HandleClose;
+procedure TMainForm.MsgActivate(var msg: TfpgMessageRec);
+begin
+  Writeln('Window Activate message');
+end;
+
+procedure TMainForm.MsgDeActivate(var msg: TfpgMessageRec);
 begin
-  WriteLn('HandleClose');
-  inherited HandleClose;
+  Writeln('Window is Deactivate message');
+end;
+
+procedure TMainForm.MsgClose(var msg: TfpgMessageRec);
+begin
+  Writeln('Window Close message');
+  Halt(0);
+end;
+
+procedure TMainForm.MsgPaint(var msg: TfpgMessageRec);
+var
+  h: integer;
+begin
+  Writeln('Paint message');
+  Canvas.BeginDraw;
+  h := Canvas.Font.Height;
+  Canvas.SetColor(clWhite);
+  Canvas.FillRectangle(0, 0, Width, Height);
+  Canvas.SetTextColor(clBlack);
+  Canvas.DrawString(0, 0, 'Event test');
+  Canvas.DrawString(0, h, 'Do something interactive (move mouse, press keys...)');
+  Canvas.DrawString(0, h*2, 'and watch the output on the console.');
+  Canvas.EndDraw;
 end;
 
-procedure TMainForm.HandlePaint;
+procedure TMainForm.MsgResize(var msg: TfpgMessageRec);
 begin
-  WriteLn('HandlePaint');
-  inherited HandlePaint;
+  Writeln('Resize');
+  FWidth  := msg.Params.rect.Width;
+  FHeight := msg.Params.rect.Height;
 end;
 
-procedure TMainForm.HandleDoubleClick(x, y: integer; button: word;
-  shiftstate: word);
+procedure TMainForm.MsgMove(var msg: TfpgMessageRec);
 begin
-  WriteLn('HandleDoubleClick');
-  inherited HandleDoubleClick(x, y, button, shiftstate);
+  Writeln('Window Move');
 end;
 
-procedure TMainForm.HandleKeyChar(var keycode: word; var shiftstate: word;
-  var consumed: boolean);
+procedure TMainForm.MsgKeyChar(var msg: TfpgMessageRec);
 begin
-  Write('Character generated: ');
-  if Char(keycode) >= ' ' then
-    WriteLn('''', Char(keycode), '''')
-  else
-    WriteLn('#', Ord(keycode));
+  Write('Keychar - Character generated: ');
+//  if Char(keycode) >= ' ' then
+//    WriteLn('''', Char(keycode), '''')
+//  else
+//    WriteLn('#', Ord(keycode));
+end;
 
-  inherited HandleKeyChar(keycode, shiftstate, consumed);
+procedure TMainForm.MsgKeyPress(var msg: TfpgMessageRec);
+begin
+  Writeln('KeyPress');
 end;
 
-procedure TMainForm.HandleMouseEnter;
+procedure TMainForm.MsgKeyRelease(var msg: TfpgMessageRec);
 begin
-  WriteLn('Mouse entered window');
-  inherited HandleMouseEnter;
+  Writeln('KeyRelease');
 end;
 
-procedure TMainForm.HandleMouseExit;
+procedure TMainForm.MsgMouseDown(var msg: TfpgMessageRec);
 begin
-  WriteLn('Mouse left window');
-  inherited HandleMouseExit;
+  Writeln('Mouse button down.' + ' button=' + IntToStr(msg.Params.mouse.Buttons));
 end;
 
-procedure TMainForm.HandleMouseMove(x, y: integer; btnstate: word;
-  shiftstate: word);
+procedure TMainForm.MsgMouseUp(var msg: TfpgMessageRec);
 begin
-  WriteLn(MouseState(shiftstate, Point(x, y)), 'Mouse moved');
-  inherited HandleMouseMove(x, y, btnstate, shiftstate);
+  Writeln('Mouse button up.' + ' button=' + IntToStr(msg.Params.mouse.Buttons));
+end;
+
+procedure TMainForm.MsgMouseMove(var msg: TfpgMessageRec);
+var
+  s: string;
+begin
+  inc(FMoveEventCount);
+  // only report mouse moves every 10 messages - just to limit the output a bit
+  if (FMoveEventCount mod 10) = 0 then
+  begin
+    s := Format('[%d,%d] ', [msg.Params.mouse.x, msg.Params.mouse.y]);
+    WriteLn(s + 'Mouse move message');
+//    WriteLn(MouseState(shiftstate, Point(x, y)), 'Mouse moved');
+  end;
 end;
 
-procedure TMainForm.HandleLMouseDown(x, y: integer; shiftstate: word);
+procedure TMainForm.MsgDoubleClick(var msg: TfpgMessageRec);
 begin
-  WriteLn('Left mouse button down');
-  inherited HandleLMouseDown(x, y, shiftstate);
+  Writeln('Mouse doubleclick');
 end;
 
-procedure TMainForm.HandleLMouseUp(x, y: integer; shiftstate: word);
+procedure TMainForm.MsgMouseEnter(var msg: TfpgMessageRec);
 begin
-  Writeln('Left mouse button up');
-  inherited HandleLMouseUp(x, y, shiftstate);
+  Writeln('Mouse enter');
 end;
 
-procedure TMainForm.HandleRMouseDown(x, y: integer; shiftstate: word);
+procedure TMainForm.MsgMouseExit(var msg: TfpgMessageRec);
 begin
-  Writeln('Right mouse button down');
-  inherited HandleRMouseDown(x, y, shiftstate);
+  Writeln('Mouse exit');
 end;
 
-procedure TMainForm.HandleRMouseUp(x, y: integer; shiftstate: word);
+procedure TMainForm.MsgScroll(var msg: TfpgMessageRec);
 begin
-  WriteLn('Right mouse button up');
-  inherited HandleRMouseUp(x, y, shiftstate);
+  Writeln('Mouse scroll delta=' + IntToStr(msg.Params.mouse.x) + ' button=' + IntToStr(msg.Params.mouse.Buttons));
 end;
 
 constructor TMainForm.Create(aowner: TComponent);
 begin
   inherited Create(aowner);
-  SetPosition(100, 100, 500, 100);
-  WindowTitle := 'fpGFX event test';
+  FMoveEventCount := 0;
+  FWidth    := 400;
+  FHeight   := 100;
+  WindowAttributes := [waSizeable, waScreenCenterPos];
+end;
+
+procedure TMainForm.Show;
+begin
+  AllocateWindowHandle;
+  // We can't set a title if we don't have a window handle. So we do that here
+  // and not in the constructor.
+  DoSetWindowTitle('fpGFX event test');
 end;
   
   
diff --git a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas
index 9d989c7d..990d424c 100644
--- a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas
+++ b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas
@@ -109,7 +109,12 @@ type
   end;
 
 
+  { TfpgWindowImpl }
+
   TfpgWindowImpl = class(TfpgWindowBase)
+  private
+    FMouseInWindow: boolean;
+    function    DoMouseEnterLeaveCheck(AWindow: TfpgWindowImpl; uMsg, wParam, lParam: Cardinal): Boolean;
   protected
     FWinHandle: TfpgWinHandle;
     FModalForWin: TfpgWindowImpl;
@@ -435,8 +440,15 @@ begin
         sstate := sstate or ss_shift;
       msgp.mouse.shiftstate := sstate;
 
-      if mcode <> 0 then
-        fpgSendMessage(nil, w, mcode, msgp);
+
+      if uMsg = WM_MouseMove then
+      begin
+        if w.DoMouseEnterLeaveCheck(w, uMsg, wParam, lParam) then
+        begin
+          if mcode <> 0 then
+            fpgSendMessage(nil, w, mcode, msgp);
+        end;
+      end;
       {
       if uMsg = WM_MOUSEMOVE then
       begin
@@ -678,6 +690,72 @@ end;
 
 { TfpgWindowImpl }
 
+function TfpgWindowImpl.DoMouseEnterLeaveCheck(AWindow: TfpgWindowImpl; uMsg, wParam, lParam: Cardinal): Boolean;
+
+  //----------------------
+  function CursorInDifferentWindow: Boolean;
+  var
+    pt: Windows.POINT;
+  begin
+    pt.x := LoWord(lParam);
+    pt.y := HiWord(lParam);
+
+    // only WM_MOUSEWHEEL uses screen coordinates!!!
+    if uMsg <> WM_MOUSEWHEEL then
+      Windows.ClientToScreen(FWinHandle, @pt);
+
+    Result := WindowFromPoint(pt) <> FWinHandle;
+  end;
+
+var
+  pt: Windows.POINT;
+//  Event: TFEvent;
+  msgp: TfpgMessageParams;
+begin
+  FillChar(msgp, sizeof(msgp), 0);
+  if not FMouseInWindow then
+  begin
+    FMouseInWindow := True;
+//    DoSetCursor;
+    Windows.SetCapture(FWinHandle);
+    //Event := TFEvent.Create;
+    //try
+      //Event.lParam := lParam;
+      //Event.EventType := etMouseEnter;
+      //ProcessEvent(Event);
+    //finally
+      //Event.Free;
+    //end;
+    msgp.
+    fpgSendMessage(nil, AWindow, FPGM_MOUSEENTER, msgp);
+    Result := uMsg <> WM_MOUSEMOVE;
+  end else
+  begin
+    pt.x := LoWord(lParam);
+    pt.y := HiWord(lParam);
+    if uMsg = WM_MOUSEWHEEL then
+      Windows.ScreenToClient(Handle, @pt);
+    if (pt.x < 0) or (pt.y < 0) or (pt.x >= ClientWidth) or
+      (pt.y >= ClientHeight) or CursorInDifferentWindow then
+      FMouseInWindow := False;
+
+    if (not FHasMouseCapture) and (not FMouseInWindow) then
+    begin
+      Windows.ReleaseCapture;
+      //Event := TFEvent.Create;
+      //try
+        //Event.EventType := etMouseLeave;
+        //ProcessEvent(Event);
+      //finally
+        //Event.Free;
+      //end;
+      fpgSendMessage(nil, AWindow, FPGM_MOUSELEAVE, msgp);
+      Result := False;
+    end else
+      Result := True;
+  end;
+end;
+
 procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase);
 var
   wcname: string;
diff --git a/prototypes/fpgui2/source/core/x11/gfx_x11.pas b/prototypes/fpgui2/source/core/x11/gfx_x11.pas
index 48790287..9a5eff08 100644
--- a/prototypes/fpgui2/source/core/x11/gfx_x11.pas
+++ b/prototypes/fpgui2/source/core/x11/gfx_x11.pas
@@ -478,6 +478,7 @@ end;
 procedure TfpgApplicationImpl.DoWaitWindowMessage(atimeoutms: integer);
 var
   ev: TXEvent;
+  NewEvent: TXevent;
   n: integer;
   i: integer;
   r: integer;
@@ -529,12 +530,13 @@ begin
   blockmsg := False;
   fillchar(msgp, sizeof(msgp), 0);
 
-  //  WriteLn('Event ',GetXEventName(ev._type),': ', ev._type,' window: ', ev.xany.window);
-  
+
   // According to a comment in X.h, the valid event types start with 2!
   if ev._type < 2 then
     exit;
 
+// WriteLn('Event ',GetXEventName(ev._type),': ', ev._type,' window: ', ev.xany.window);
+
 
   case ev._type of
     MSG_KEYPRESS,
@@ -616,10 +618,32 @@ begin
           // generate scroll events:
           if ev._type = MSG_MOUSEDOWN then
           begin
-            if ev.xbutton.button > 5 then
-              i := 1
+            if ev.xbutton.button = Button4 then
+              i := -1
             else
-              i := 3; // amount
+              i := 1;
+              
+    	      // Check for other mouse wheel messages in the queue
+            while XCheckTypedWindowEvent(display, ev.xany.window, X.ButtonPress, @NewEvent) do
+            begin
+  	          if NewEvent.xbutton.Button = 4 then
+  	            Dec(i)
+              else if NewEvent.xbutton.Button = 5 then
+  	            Inc(i)
+              else
+        	    begin
+        	      XPutBackEvent(display, @NewEvent);
+                break;
+        	    end;
+            end;
+
+//            if ev.xbutton.button > 5 then
+//              i := 1
+//            else
+//              i := 3; // amount
+
+            msgp.mouse.x := i;
+            fpgPostMessage(nil, w, FPGM_SCROLL, msgp);
 //            fpgPostMessage(nil, ewg, MSG_SCROLL, ev.xbutton.button mod 4, i, ev.xbutton.state );
           end;
         end
@@ -639,8 +663,10 @@ begin
           repeat
             //
           until not XCheckTypedWindowEvent(display, ev.xany.window, MSG_PAINT, @ev);
-
-          fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_PAINT);
+          if ev.xexpose.count = 0 then
+          begin
+            fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_PAINT);
+          end;
         end;
 
     MSG_MOUSEMOVE:
@@ -722,6 +748,14 @@ begin
     MSG_MOUSEEXIT:
         fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_MOUSEEXIT);
 
+    GraphicsExpose,
+    NoExpose:
+      // Do Nothing
+      // writeln('got a GraphicsExpose or NoExpose event');
+      { If this application calls XCopyArea or XCopyPlane
+        and the graphics_exposures member of the GC is
+        True and the source is a window, these events may
+        be generated; handle GraphicsExpose like Expose }
     else
       {$Note This needs attention}
       WriteLn('fpGFX/X11: Unhandled X11 event received: ', GetXEventName(ev._type));