From 2cbcc53a574b0fcfd5dd083a0d6f8289b0f27bce Mon Sep 17 00:00:00 2001 From: lazarus Date: Wed, 31 Oct 2001 16:29:23 +0000 Subject: [PATCH] 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 | 19 +++--- ide/main.pp | 32 ++++++--- lcl/controls.pp | 4 ++ lcl/include/control.inc | 25 +++----- lcl/include/wincontrol.inc | 29 +++------ lcl/interfaces/gtk/gtkcallback.inc | 100 ++++++++++++++++++++++------- lcl/interfaces/gtk/gtkobject.inc | 26 ++++++-- lcl/interfaces/gtk/gtkproc.inc | 4 ++ lcl/interfaces/gtk/gtkwinapi.inc | 5 ++ 9 files changed, 162 insertions(+), 82 deletions(-) diff --git a/designer/designer.pp b/designer/designer.pp index ab12427128..ac5a982766 100644 --- a/designer/designer.pp +++ b/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]; diff --git a/ide/main.pp b/ide/main.pp index 0f4b5c25ca..0960f2cd4a 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -3755,21 +3755,29 @@ procedure TMainIDE.DoBringToFrontFormOrUnit; var AForm: TCustomForm; ActiveUnitInfo: TUnitInfo; begin - if FCodeLastActivated then begin - if SourceNoteBook.NoteBook<>nil then AForm:=SourceNotebook - else AForm:=nil; - end else begin - if (SourceNoteBook.NoteBook<>nil) then begin + if FCodeLastActivated then + begin + if SourceNoteBook.NoteBook<>nil then + AForm:=SourceNotebook + 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. diff --git a/lcl/controls.pp b/lcl/controls.pp index 96b0e839ec..6318c051f2 100644 --- a/lcl/controls.pp +++ b/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 diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 264c50aca2..f28fce84e1 100644 --- a/lcl/include/control.inc +++ b/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) - then with Message do MouseDown(Button, KeysToShiftState(Keys) + Shift, XPos, YPos); + if not (csNoStdEvents in ControlStyle) then + 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 diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index b3c83e8948..4ac2b47ed0 100644 --- a/lcl/include/wincontrol.inc +++ b/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 - then WriteLN(Format('[TWinControl.IsControlMouseMsg] %s --> CaptureControl = %s', [ClassName, CaptureControl.ClassName])); -} - if (CaptureControl <> nil) + 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 - then begin -// Writeln('Control <> nil'); + if Control <> nil then + begin 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 diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index 5eca8dcf61..a3f3ebb814 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/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 - MessI.Msg := LM_LBUTTONDOWN; - end else + if event^.thetype = gdk_button_press then + MessI.Msg := LM_LBUTTONDOWN + 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; - 2 : MessI.Msg := LM_MBUTTONUP; - 3 : MessI.Msg := LM_RBUTTONUP; + 1 : if not(LMouseButtonDown) then + Exit + 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 diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index bf7fe7b940..ceaaa8a453 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/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])); - AddChild(Pgtkwidget(AParent.Handle), PgtkWidget(Handle), AParent.Left, AParent.Top); + if Not Assigned(AParent) then + 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 diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index 833fa38444..b67afc8ba3 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/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 diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 9fa5753552..06368f49d1 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/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