paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-02 12:52:44 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed gtk capturing setting LCL CaptureControl

Browse Source 
git-svn-id: trunk@8247 -
This commit is contained in:
mattias 2005-12-02 12:06:13 +00:00
parent 466590d235
commit 6d975c970d
5 changed files with 25 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lcl/controls.pp
View File

@ -2037,6 +2037,7 @@ procedure RecreateWnd(const AWinControl:TWinControl);
var
DefaultDockTreeClass: TDockTreeClass;
procedure SetCaptureControl(AWinControl: TWinControl; const Position: TPoint);
procedure SetCaptureControl(Control: TControl);
function GetCaptureControl: TControl;
procedure CancelDrag;
@ -2335,6 +2336,19 @@ begin
then Result := CaptureControl;
end;
procedure SetCaptureControl(AWinControl: TWinControl; const Position: TPoint);
var
Control: TControl;
begin
Control:=AWinControl;
if (AWinControl<>nil) then begin
Control:=AWinControl.ControlAtPos(Position,false,true,false);
if Control=nil then
Control:=AWinControl;
end;
SetCaptureControl(Control);
end;
procedure SetCaptureControl(Control: TControl);
var
OldCaptureWinControl: TWinControl;

4
lcl/include/control.inc
View File

@ -1547,8 +1547,8 @@ end;
procedure TControl.DoMouseDown(var Message: TLMMouse; Button: TMouseButton;
Shift: TShiftState);
begin
if not (csNoStdEvents in ControlStyle) then
Begin
//DebugLn('TControl.DoMouseDown ',DbgSName(Self),' ');
if not (csNoStdEvents in ControlStyle) then begin
with Message do
MouseDown(Button, KeysToShiftState(Keys) + Shift, XPos, YPos);
end;

1
lcl/include/wincontrol.inc
View File

@ -2500,6 +2500,7 @@ begin
Control := ControlAtPos(SmallPointToPoint(TheMessage.Pos),False,True,False);
end;
//DebugLn('TWinControl.IsControlMouseMsg ',DbgSName(Self),' Control=',DbgSName(Control));
Result := False;
if Control <> nil then
begin

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

@ -1132,7 +1132,7 @@ begin
EventXY:=Point(TruncToInt(Event^.X),TruncToInt(Event^.Y));
ShiftState := GTKEventState2ShiftState(Event^.State);
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY,
PGtkWidget(AWinControl.Handle));
PGtkWidget(AWinControl.Handle));
//DebugLn('DeliverMouseDownMessage ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y));
if event^.Button in [4,5] then begin
@ -1241,6 +1241,8 @@ function gtkMouseBtnPress(widget: PGtkWidget; event: pgdkEventButton;
var
DesignOnlySignal: boolean;
CaptureWidget: PGtkWidget;
EventXY: TPoint;
MappedXY: TPoint;
begin
Result := CallBackDefaultReturn;
@ -1278,8 +1280,10 @@ begin
CaptureWidget:=PGtkWidget(TWinControl(Data).Handle);
if Event^.button=1 then begin
CaptureMouseForWidget(CaptureWidget,mctGTKIntf);
//Result := not CallBackDefaultReturn;
EventXY:=Point(TruncToInt(Event^.X),TruncToInt(Event^.Y));
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY,CaptureWidget);
SetCaptureControl(TWinControl(Data),MappedXY);
//CaptureMouseForWidget(CaptureWidget,mctGTKIntf);
end;
end else begin
// stop the signal, so that the widget does not auto react

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

@ -4474,7 +4474,7 @@ var
OldMouseCaptureWidget: PGtkWidget;
begin
{$IFDEF VerboseMouseCapture}
DebugLn('ReleaseMouseCapture ',ord(MouseCaptureType),' MouseCaptureWidget=[',GetWidgetDebugReport(MouseCaptureWidget),']');
DebugLn('ReleaseMouseCapture ',dbgs(ord(MouseCaptureType)),' MouseCaptureWidget=[',GetWidgetDebugReport(MouseCaptureWidget),']');
{$ENDIF}
if MouseCaptureType=mctGTK then exit;
OldMouseCaptureWidget:=MouseCaptureWidget;