Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.

Shane

git-svn-id: trunk@375 -

designer/designer.pp

@@ -279,6 +279,7 @@ Begin
   MouseDownComponent:=Sender;
   MouseDownSender:=Sender; 
 
+
   SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
   MouseX:=Message.Pos.X+SenderOrigin.X;
   MouseY:=Message.Pos.Y+SenderOrigin.Y;
@@ -293,6 +294,7 @@ Begin
   write(' Mouse=',MouseX,',',MouseY);
   writeln('');
 
+
   if (Message.Keys and MK_Shift) = MK_Shift then
     Write(' Shift down')
   else
@@ -392,6 +394,7 @@ Begin
     Shift := Shift +[ssCTRL];
 
 
+
   SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
   MouseX:=Message.Pos.X+SenderOrigin.X;
   MouseY:=Message.Pos.Y+SenderOrigin.Y;
@@ -406,6 +409,7 @@ Begin
   write(' Mouse=',MouseX,',',MouseY);
   writeln('');
 
+
   if Assigned(FOnGetSelectedComponentClass) then
     FOnGetSelectedComponentClass(Self,SelectedCompClass)
   else
@@ -505,18 +509,13 @@ Begin
   if SenderParentForm=nil then exit;
   SenderOrigin:=GetFormRelativeControlTopLeft(Sender);
   
-  // MG: workaround for mouse move coordinate bug in gtk-interfaces
+
-  s:=lowercase(MouseDownSender.ClassName);
-  if (s='tbutton') then begin
-    MouseX:=Message.Pos.X;
-    MouseY:=Message.Pos.Y;
-  end else begin
-  // MG: workaround end
     MouseX:=Message.Pos.X+SenderOrigin.X;
     MouseY:=Message.Pos.Y+SenderOrigin.Y;
-  end;
 
-  if (Message.keys and MK_LButton) = MK_LButton then begin
+
+//debugging commented out
+{  if (Message.keys and MK_LButton) = MK_LButton then begin
     Write('MouseMoveOnControl'
           ,' ',Sender.ClassName
           ,' ',GetCaptureControl<>nil
@@ -531,7 +530,7 @@ Begin
     end;
     writeln();
   end;
-
+}
   Shift := [];
   if (TLMMouse(Message).keys and MK_Shift) = MK_Shift then
     Shift := [ssShift];

ide/main.pp

@@ -3755,21 +3755,29 @@ procedure TMainIDE.DoBringToFrontFormOrUnit;
 var AForm: TCustomForm;
   ActiveUnitInfo: TUnitInfo;
 begin
-  if FCodeLastActivated then begin
+  if FCodeLastActivated then
-    if SourceNoteBook.NoteBook<>nil then AForm:=SourceNotebook
+   begin
-    else AForm:=nil;
+    if SourceNoteBook.NoteBook<>nil then
-  end else begin
+       AForm:=SourceNotebook
-    if (SourceNoteBook.NoteBook<>nil) then begin
+    else
+       AForm:=nil;
+   end
+   else
+   begin
+    if (SourceNoteBook.NoteBook<>nil) then
+     begin
       ActiveUnitInfo:=Project.UnitWithEditorIndex(
         SourceNoteBook.NoteBook.PageIndex);
       if (ActiveUnitInfo<>nil) then
         AForm:=TCustomForm(ActiveUnitInfo.Form);
-    end;
+     end;
   end;
-  if AForm<>nil then begin
+
+  if AForm<>nil then
+   begin
     AForm.Hide;
     AForm.Show;
-  end;
+   end;
 end;
 
 procedure TMainIDE.OnMacroSubstitution(TheMacro: TTransferMacro; var s:string;
@@ -4361,6 +4369,10 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.129  2001/10/31 16:29:20  lazarus
+  Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
+  Shane
+
   Revision 1.128  2001/10/26 20:36:48  lazarus
   Added an OnSelectionChanged event in Main.pp fired by MSgView dialog.  This fires when the ListBox gets clicked on.
   This allows the editor to highlight different lines when you click on different error messages.
@@ -8969,6 +8981,10 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.129  2001/10/31 16:29:20  lazarus
+  Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
+  Shane
+
   Revision 1.128  2001/10/26 20:36:48  lazarus
   Added an OnSelectionChanged event in Main.pp fired by MSgView dialog.  This fires when the ListBox gets clicked on.
   This allows the editor to highlight different lines when you click on different error messages.

lcl/controls.pp

@@ -1140,6 +1140,10 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.23  2001/10/31 16:29:21  lazarus
+  Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
+  Shane
+
   Revision 1.22  2001/10/07 07:28:32  lazarus
   MG: fixed setpixel and TCustomForm.OnResize event
 

lcl/include/control.inc

@@ -506,8 +506,10 @@ end;
 {------------------------------------------------------------------------------}
 procedure TControl.DoMouseDown(var Message: TLMMouse; Button: TMOuseButton; Shift:TShiftState);
 begin
-  if not (csNoStdEvents in ControlStyle)
+  if not (csNoStdEvents in ControlStyle) then
-  then with Message do MouseDown(Button, KeysToShiftState(Keys) + Shift, XPos, YPos);
+  Begin
+    with Message do MouseDown(Button, KeysToShiftState(Keys) + Shift, XPos, YPos);
+  end;
 end;
 
 {------------------------------------------------------------------------------}
@@ -717,7 +719,7 @@ end;
 {------------------------------------------------------------------------------}
 procedure TControl.SetMouseCapture(Value : Boolean);
 begin
-  if MouseCapture <> Value 
+  if MouseCapture <> Value
   then begin
     if Value 
     then SetCaptureControl(Self) 
@@ -1008,20 +1010,9 @@ end;
 {------------------------------------------------------------------------------}
 Procedure TControl.WMMouseMove(Var Message: TLMMouseMove);
 Begin
-//The next line is commented out because it throws an exception.
-
-{if (CaptureControl <> self) and (dragging) then exit;
-   begin
-   CaptureControl.Perform(CM_MOUSELEAVE,0,0);
-   if not CaptureControl.Dragging then
-   CaptureControl := Self;
-   end;
- }
-
   if not (csNoStdEvents in COntrolStyle)
   then with Message do
-    MouseMove(KeystoShiftState(Keys), XPos, YPos);
+       MouseMove(KeystoShiftState(Keys), XPos, YPos);
-
 End;
 
 {------------------------------------------------------------------------------}
@@ -1325,6 +1316,10 @@ end;
 
 { =============================================================================
   $Log$
+  Revision 1.28  2001/10/31 16:29:21  lazarus
+  Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
+  Shane
+
   Revision 1.27  2001/10/16 20:01:28  lazarus
   MG: removed splashform fix, because of the unpredictable side effects
 

lcl/include/wincontrol.inc

@@ -467,38 +467,21 @@ var
   Control : TControl;
   P : TPoint;
 begin
-//  WriteLN(Format('[TWinControl.IsControlMouseMsg] %s', [ClassName]));
+  if GetCapture = Handle
-  if GetCapture = Handle 
   then begin
-//    WriteLN(Format('[TWinControl.IsControlMouseMsg] %s --> We are capture', [ClassName]));
     Control := nil;
-{    if CaptureControl <> nil
+    if (CaptureControl <> nil)
-    then WriteLN(Format('[TWinControl.IsControlMouseMsg] %s --> CaptureControl = %s', [ClassName, CaptureControl.ClassName]));
-}
-    if (CaptureControl <> nil) 
     and (CaptureControl.Parent = Self) 
     then Control := CaptureControl;
   end
   else Control := ControlAtPos(SmallPointtoPoint(Message.Pos),False);
 
-    if CaptureControl <> nil
-    then WriteLN(Format('[TWinControl.IsControlMouseMsg] %s --> CaptureControl = %s', [ClassName, CaptureControl.ClassName]));
-
-{if Control <> nil then
-  Writeln('---------------COntrol is present.  Its '+TCOntrol(Control).name)
-  else
-  Writeln('ISCONTROLMOUSEMSG - Control=nil');
-}
   Result := False;
-  if Control <> nil 
+  if Control <> nil then
-  then begin
+  begin
-//    Writeln('Control <> nil');
     P.X := Message.XPos - Control.Left;
     P.Y := Message.YPos - Control.Top;
-//    writeln('P.x and P.y = '+inttostr(p.x)+'  '+inttostr(p.y));
-//    WriteLN(Format('[TWinControl.IsControlMouseMsg] %s --> perform message', [Control.ClassName]));
     Control.Perform(Message.Msg, Message.Keys, LongInt(PointtoSmallPoint(P)));
-//    Writeln('done');
     Result := True;
   end;
 end;
@@ -1948,6 +1931,10 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.40  2001/10/31 16:29:22  lazarus
+  Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
+  Shane
+
   Revision 1.39  2001/10/10 17:55:04  lazarus
   MG: fixed caret lost, gtk cleanup, bracket lvls, bookmark saving
 

lcl/interfaces/gtk/gtkcallback.inc

@@ -4,6 +4,11 @@
 //  {$DEFINE ASSERT_IS_ON}
 {$ENDIF}
 
+var
+//testing
+LMouseButtonDown,MMouseButtonDown,RMouseButtonDown : Boolean;  //used to track the mouse buttons
+
+
 
 // temp solution to fill msgqueue
 function DeliverPostMessage(const Target: Pointer; var Message): GBoolean;
@@ -307,6 +312,7 @@ begin
   { Message results : True - do nothing, False - destroy or hide window }
   Result:= DeliverMessage(Data, Mess) = 0;
   if longint(widget)=MCaptureHandle then MCaptureHandle:=0;
+  
 end;
 
 function gtkresizeCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
@@ -325,31 +331,46 @@ function GTKMotionNotify(widget:PGTKWidget; event: PGDKEventMotion; data: gPoint
 var
   Msg: TLMMouseMove;
   ShiftState: TShiftState;
+  parWindow : PgdkWindow;  //the Parent's GDKWindow
+  ShowDebugging : Boolean;
+  
 begin
+  ShowDebugging := False;
+  if ShowDebugging then
+  Begin
+  writeln('_______________');
+  Writeln('Motion Notify');
+  Writeln('Control = ',TControl(data).Name);
+  Writeln('Handle = ',Longint(TWinControl(data).Handle));
+  Writeln('Widget = ',LongInt(widget));
+  Writeln('Window = ',Longint(Event^.Window));
+  Writeln('Coords = ',trunc(Event^.x),',',trunc(Event^.Y));
+  Writeln('Send Event',Event^.send_Event);
+  Writeln('Event Type',Event^.thetype);
+  Writeln('Coords root = ',trunc(Event^.x_root),',',trunc(Event^.Y_root));
+  Writeln('State = ',event^.state);
+  Writeln('TGtkWidget^.Window is ',Longint(Widget^.Window));
+  parWindow := gtk_widget_get_parent_window(widget);
+  Writeln('Parwindow is ',LongInt(parwindow));
+  Writeln('_______________');
+  end;
 
-
+  //work around
+  //if the gdkwindow is the same as the parent's gdkwindow, then adjust the x,y relative to the cotnrol.
+  parWindow := gtk_widget_get_parent_window(widget);
+  if (ParWindow = Event^.Window) then
+     Begin
+         Event^.X := Event^.X - TWinControl(data).left;
+         Event^.Y := Event^.Y - TWinControl(data).Top;
+     end;
+       
   ShiftState := GTKEventState2ShiftState(Event^.State);
   with Msg do
   begin
     Msg := LM_MouseMove;
     XPos := Round(Event^.X);
     YPos := Round(Event^.Y);
-//    XPos := Trunc(Event^.X);
+
-//    YPos := trunc(Event^.Y);
-{    Writeln('MOUSEMOVE Signal');
-    Writeln('X = ');
-    Writeln('  '+inttostr(XPos));
-    Writeln('Y = ');
-    Writeln('  '+inttostr(YPos));
-    Writeln('X_root = ');
-    Writeln('  '+inttostr(round(Event^.X_Root)));
-    Writeln('Y_root = ');
-    Writeln('  '+inttostr(round(Event^.Y_Root)));
-    writeln('widget is ='+inttostr(longint(widget)));
-    if (TObject(data) is TCOntrol) then
-    writeln('Control is ='+TControl(data).classname);
-    Writeln('------------------');
- }
     Keys := 0;
     if ssShift in ShiftState then Keys := Keys or MK_SHIFT;
     if ssCtrl in ShiftState then Keys := Keys or MK_CONTROL;
@@ -376,6 +397,7 @@ var
   ShiftState: TShiftState;
 begin
 //writeln('[gtkMouseBtnPress] ',ToBject(Data).ClassName,' ',Trunc(Event^.X),',',Trunc(Event^.Y));
+
   EventTrace('Mouse button Press', data);
 
   Assert(False, Format('Trace:[gtkMouseBtnPress] ', []));
@@ -396,25 +418,33 @@ begin
     MessI.Keys := 0;
     case event^.Button of
          1 : begin
+               if LMouseButtonDown then Exit;
                MessI.Keys := MessI.Keys or MK_LBUTTON;
-               if event^.thetype = gdk_button_press then begin
+               if event^.thetype = gdk_button_press then
-                 MessI.Msg := LM_LBUTTONDOWN;
+                 MessI.Msg := LM_LBUTTONDOWN
-               end else
+                else
                  MessI.Msg := LM_LBUTTONDBLCLK;
+                 
+             LMouseButtonDown := True;
+
              end;
          2 : begin
+               if MMouseButtonDown then Exit;
                MessI.Keys := MessI.Keys or MK_MBUTTON;
                if event^.thetype = gdk_button_press then
                  MessI.Msg := LM_MBUTTONDOWN
                else
                  MessI.Msg := LM_MBUTTONDBLCLK;
+               MMouseButtonDown := True;
              end;
          3 : begin
+               if RMouseButtonDown then Exit;
                MessI.Keys := MessI.Keys or MK_RBUTTON;
                if event^.thetype = gdk_button_press then
                  MessI.Msg := LM_RBUTTONDOWN
                else
                  MessI.Msg := LM_RBUTTONDBLCLK;
+               RMouseButtonDown := True;
              end;
          else MessI.Msg := LM_NULL;
     end; //case
@@ -428,6 +458,7 @@ begin
 
     if MessI.Msg <> LM_NULL then Result := DeliverPostMessage(Data, MessI); 
   end;
+  
 end;
 
 function gtkMouseBtnRelease( widget: PGtkWidget; event : pgdkEventButton; data: gPointer) : GBoolean; cdecl;
@@ -442,9 +473,27 @@ begin
   ShiftState := gtkeventstate2shiftstate(Event^.State);
 
   case event^.Button of
-    1 : MessI.Msg := LM_LBUTTONUP;
+    1 : if not(LMouseButtonDown) then
-    2 : MessI.Msg := LM_MBUTTONUP;
+           Exit
-    3 : MessI.Msg := LM_RBUTTONUP;
+           else
+             Begin
+                MessI.Msg := LM_LBUTTONUP;
+                LMouseButtonDown := False;
+             end;
+    2 : if not(MMouseButtonDown) then
+           Exit
+           else
+             Begin
+                MessI.Msg := LM_MBUTTONUP;
+                MMouseButtonDown := False;
+             end;
+    3 : if not(RMouseButtonDown) then
+           Exit
+           else
+             Begin
+                MessI.Msg := LM_RBUTTONUP;
+                RMouseButtonDown := False;
+             end
     else MessI.Msg := LM_NULL;
   end;
   MessI.XPos := Trunc(Event^.X);
@@ -459,6 +508,7 @@ begin
   if MessI.Msg <> LM_NULL 
   then Result := DeliverPostMessage(Data, MessI)
   else Result := True;
+
 end;
 
 function gtkclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
@@ -1156,6 +1206,10 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.39  2001/10/31 16:29:22  lazarus
+  Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
+  Shane
+
   Revision 1.38  2001/10/16 14:19:13  lazarus
   MG: added nvidia opengl support and a new opengl example from satan
 

lcl/interfaces/gtk/gtkobject.inc

@@ -422,8 +422,16 @@ begin
          end
          else Begin
             AParent := (Sender as TWinControl).Parent;
-            Assert(False, Format('Trace:  [TgtkObject.IntSendMessage3] %s --> Calling Add Child: %s', [AParent.ClassName, Sender.ClassNAme]));
+            if Not Assigned(AParent) then
-            AddChild(Pgtkwidget(AParent.Handle), PgtkWidget(Handle), AParent.Left, AParent.Top);
+               Begin
+                 Assert(true, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Parent is not assigned', [Sender.ClassName]));
+
+               end
+               else
+               Begin
+                Assert(False, Format('Trace:  [TgtkObject.IntSendMessage3] %s --> Calling Add Child: %s', [AParent.ClassName, Sender.ClassNAme]));
+                AddChild(Pgtkwidget(AParent.Handle), PgtkWidget(Handle), AParent.Left, AParent.Top);
+               end;
          end;
       end;
 
@@ -1412,11 +1420,11 @@ procedure TGTKObject.SetCallback(Msg : LongInt; Sender : TObject);
       with Handler^ do
       begin
         //look for realize handler
-        if  (Id > 0) and 
+        if  (Id > 0) and
             (Signal_ID = RealizeID) and
             (Func = TGTKSignalFunc(@GTKRealizeCB))
            then RealizeHandler := Handler;
-        
+
         if  (Id > 0) and
             (Signal_ID = SignalID) and
             (Func = TGTKSignalFunc(ACallBackProc)) and
@@ -1458,6 +1466,7 @@ begin
   if gObject = nil then Exit;
   
   gFixed := PGTKObject(GetFixedWidget(gObject));
+
   if gFixed = nil then gFixed := gObject;
 
   case Msg of
@@ -1567,7 +1576,10 @@ begin
     
     LM_MOUSEMOVE:
     begin
-      ConnectSignal(gFixed, 'motion-notify-event', @GTKMotionNotify, GDK_POINTER_MOTION_MASK)
+//       if ((sender is tCustomForm) )then
+//       ConnectSignal(gFixed, 'motion-notify-event', @GTKMotionNotify)
+//       else
+       ConnectSignal(gFixed, 'motion-notify-event', @GTKMotionNotify, GDK_POINTER_MOTION_MASK)
     end;
     
     LM_PRESSED :
@@ -3101,6 +3113,10 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.64  2001/10/31 16:29:22  lazarus
+  Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
+  Shane
+
   Revision 1.63  2001/10/16 20:01:28  lazarus
   MG: removed splashform fix, because of the unpredictable side effects
 

lcl/interfaces/gtk/gtkproc.inc

@@ -748,6 +748,10 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.24  2001/10/31 16:29:23  lazarus
+  Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
+  Shane
+
   Revision 1.23  2001/10/08 12:57:07  lazarus
   MG: fixed GetPixel
 

lcl/interfaces/gtk/gtkwinapi.inc

@@ -3016,6 +3016,7 @@ begin
   end;
      
   Assert(False, Format('Trace:< [TgtkObject.SetCapture] 0x%x --> 0x%x', [Value, Result]));
+
 end;
 
 {------------------------------------------------------------------------------
@@ -3604,6 +3605,10 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.46  2001/10/31 16:29:23  lazarus
+  Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
+  Shane
+
   Revision 1.45  2001/10/24 00:35:55  lazarus
   MG: fixes for fpc 1.1: range check errors