paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-30 22:22:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
Shane

git-svn-id: trunk@375 -
This commit is contained in:
lazarus 2001-10-31 16:29:23 +00:00
parent 4f24702fca
commit 2cbcc53a57
9 changed files with 162 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
designer/designer.pp
View File

@ -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];

32
ide/main.pp
View File

@ -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.

4
lcl/controls.pp
View File

@ -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

25
lcl/include/control.inc
View File

@ -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

29
lcl/include/wincontrol.inc
View File

@ -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

100
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -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

26
lcl/interfaces/gtk/gtkobject.inc
View File

@ -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

4
lcl/interfaces/gtk/gtkproc.inc
View File

@ -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

5
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -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