paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-21 19:39:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: started mouse bugfix and completed Makefile.fpc

Browse Source 
git-svn-id: trunk@1704 -
This commit is contained in:
lazarus 2002-05-24 07:16:35 +00:00
parent 2b70367d39
commit 6f9bcad3bc
9 changed files with 370 additions and 257 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/Makefile
View File

@ -199,7 +199,7 @@ override PACKAGE_NAME=lazarus/lcl
override PACKAGE_VERSION=0.8a
override TARGET_DIRS+=interfaces
override TARGET_UNITS+=allunits
override TARGET_IMPLICITUNITS+=arrow buttons calendar clipbrd clistbox comctrls controls dialogs dynhasharray extctrls filectrl forms graphics imglist interfacebase lazqueue lcllinux lmessages lresources menus messages registry spin stdctrls toolwin utrace vclglobals
override TARGET_IMPLICITUNITS+=arrow buttons calendar clipbrd clistbox comctrls commctrl controls dialogs dynhasharray extctrls filectrl forms graphics graphtype imglist interfacebase lazqueue lcllinux lcltype lmessages lresources menus messages registry spin stdctrls toolwin utrace vclglobals
override TARGET_RSTS+=dialogs
override CLEAN_FILES+=$(wildcard units/*$(OEXT)) $(wildcard units/*$(PPUEXT)) $(wildcard units/*$(RSTEXT))$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
override INSTALL_BUILDUNIT=allunits

9
lcl/Makefile.fpc
View File

@ -10,12 +10,13 @@ version=0.8a
[target]
dirs=interfaces
units=allunits
implicitunits=arrow buttons calendar clipbrd clistbox comctrls controls \
dialogs dynhasharray extctrls filectrl forms graphics \
imglist interfacebase lazqueue lcllinux lmessages lresources \
menus messages registry spin stdctrls toolwin utrace \
implicitunits=arrow buttons calendar clipbrd clistbox comctrls commctrl \
controls dialogs dynhasharray extctrls filectrl forms graphics \
graphtype imglist interfacebase lazqueue lcllinux lcltype lmessages \
lresources menus messages registry spin stdctrls toolwin utrace \
vclglobals
# !!! do not add interfaces. interfaces.ppu belongs to the interface(s).
# do not add allunits. It is just a dummy unit.
rsts=dialogs

27
lcl/include/customnotebook.inc
View File

@ -310,13 +310,13 @@ begin
Msg.Parent := Self;
Msg.fCompStyle := fCompStyle;
Msg.Page := Value;
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.SetPageIndex] A');
{$ENDIF}
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.SetPageIndex] A');
{$ENDIF}
CNSendMessage(LM_SETITEMINDEX, Self, @Msg);
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.SetPageIndex] B');
{$ENDIF}
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.SetPageIndex] B');
{$ENDIF}
end;
end;
@ -377,13 +377,13 @@ begin
Msg.Parent := Self;
Msg.fCompStyle := fCompStyle;
Msg.ShowTabs := fShowTabs;
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.SetShowTabs] A');
{$ENDIF}
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.SetShowTabs] A');
{$ENDIF}
CNSendMessage(LM_SHOWTABS, Self, @Msg);
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.SetShowTabs] B');
{$ENDIF}
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.SetShowTabs] B');
{$ENDIF}
end;
end;
@ -520,6 +520,9 @@ end;}
{ =============================================================================
$Log$
Revision 1.17 2002/05/24 07:16:31 lazarus
MG: started mouse bugfix and completed Makefile.fpc
Revision 1.16 2002/05/10 06:05:52 lazarus
MG: changed license to LGPL

5
lcl/include/treeview.inc
View File

@ -2931,7 +2931,8 @@ begin
else
break;
end;
end;
end else
Result:=nil;
end;
function TCustomTreeView.GetNodeAtY(Y: Integer): TTreeNode;
@ -4027,7 +4028,7 @@ begin
inherited MouseDown(Button, Shift, X, Y);
CursorNode:=GetNodeAt(X,Y);
bStartDrag := false;
if Button = mbLeft then begin
if (Button = mbLeft) and (CursorNode<>nil) then begin
Exclude(fStates,tvsWaitForDragging);
if CursorNode.HasChildren
and (x>=CursorNode.DisplayExpandSignLeft)

41
lcl/include/winapi.inc
View File

@ -219,6 +219,31 @@ begin
Result := InterfaceObject.GetCaretPos(lpPoint);
end;
{------------------------------------------------------------------------------
Function: GetClientBounds
Params: handle:
Result:
Returns: true on success
Returns the client bounds of a control. The client bounds is the rectangle of
the inner area of a control, where the child controls are visible. The
coordinates are relative to the control's left and top.
------------------------------------------------------------------------------}
Function GetClientBounds(handle : HWND; var Rect : TRect) : Boolean;
begin
Result := InterfaceObject.GetClientBounds(handle, Rect);
end;
{------------------------------------------------------------------------------
Function: GetClientRect
Params: handle:
Result:
Returns: true on success
Returns the client rectangle of a control. Left and Top are always 0.
The client rectangle is the size of the inner area of a control, where the
child controls are visible.
------------------------------------------------------------------------------}
Function GetClientRect(handle : HWND; var Rect : TRect) : Boolean;
begin
Result := InterfaceObject.GetClientRect(handle, Rect);
@ -229,7 +254,7 @@ Begin
Result := InterfaceObject.GetCaretPos(lpPoint);
end;
function GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): Boolean; //pbd
function GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): Boolean;
begin
Result := InterfaceObject.GetCharABCWidths(DC, p2, p3, ABCStructs);
end;
@ -949,12 +974,11 @@ end;
------------------------------------------------------------------------------}
Function PtInRect(Rect : TRect; Point : TPoint) : Boolean;
Begin
Result := not (
(Point.X < Rect.Left) or
(Point.X >= Rect.Right) or
(Point.Y < Rect.Top) or
(Point.Y >= Rect.Bottom)
);
Result := ((Point.X >= Rect.Left) and
(Point.X < Rect.Right) and
(Point.Y >= Rect.Top) and
(Point.Y < Rect.Bottom)
);
end;
{------------------------------------------------------------------------------
@ -1092,6 +1116,9 @@ end;
{ =============================================================================
$Log$
Revision 1.30 2002/05/24 07:16:32 lazarus
MG: started mouse bugfix and completed Makefile.fpc
Revision 1.29 2002/05/12 04:56:20 lazarus
MG: client rect bugs nearly completed

6
lcl/include/winapih.inc
View File

@ -86,7 +86,8 @@ function Frame3d(DC: HDC; var Rect: TRect; const FrameWidth : integer; const Sty
Function GetActiveWindow : HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCapture : HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCaretPos(var lpPoint: TPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function GetClientRect(handle : HWND; var Rect : TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function GetClientBounds(handle : HWND; var Rect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function GetClientRect(handle : HWND; var Rect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCursorPos(var lpPoint: TPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} //pbd
function GetDC(hWnd: HWND): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -266,6 +267,9 @@ function UnionRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): Boolean
{ =============================================================================
$Log$
Revision 1.25 2002/05/24 07:16:32 lazarus
MG: started mouse bugfix and completed Makefile.fpc
Revision 1.24 2002/05/10 06:05:56 lazarus
MG: changed license to LGPL

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

@ -347,75 +347,45 @@ begin
// Result := DeliverMessage(Data, MSG) = 0;
end;
{-------------------------------------------------------------------------------
GTKMotionNotify
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
Returns: GBoolean
-------------------------------------------------------------------------------}
function GTKMotionNotify(widget:PGTKWidget; event: PGDKEventMotion;
data: gPointer):GBoolean; cdecl;
data: gPointer): GBoolean; cdecl;
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;
Result:=true;
{$IFDEF VerboseMouseBugfix}
writeln('[gtkmovecursorCB] ',TControl(Data).Name,':',TControl(Data).ClassName);
{$ENDIF}
//work around
//if the gdkwindow is the same as the parent's gdkwindow, then adjust the x,y relative to the cotnrol.
// stop the signal, so that it is not sent to the parent widgets
//gtk_signal_emit_stop_by_name(PGTKObject(Widget),'motion-notify-event');
// work around:
// if the gdkwindow is the same as the parent's gdkwindow,
// then adjust the x,y relative to the control.
parWindow := gtk_widget_get_parent_window(widget);
if (ParWindow = Event^.Window) then
Begin
if ShowDebugging then
Begin
Writeln('***********************');
Writeln('Calculating new X and Y');
Writeln('TWincontrol(data).left and Top = ',TWinControl(data).Left,',',TWinControl(data).Top);
Writeln('Event^.X and Y = ',Event^.X,',',Event^.Y);
end;
Event^.X := Event^.X - TWinControl(data).left;
Event^.Y := Event^.Y - TWinControl(data).Top;
if ShowDebugging then
Begin
Writeln('CAlculated...');
Writeln('TWincontrol(data).left and Top = ',TWinControl(data).Left,',',TWinControl(data).Top);
Writeln('Event^.X and Y = ',Event^.X,',',Event^.Y);
Writeln('***********************');
end;
end;
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;
if ShowDebugging then
Begin
Writeln('re-calcing XPos and YPos');
Writeln('Event X and Y :',Event^.X,',',Event^.y);
end;
XPos := trunc(Event^.X);//Round(Event^.X);
YPos := trunc(Event^.Y); //Round(Event^.Y);
if ShowDebugging then
Begin
Writeln('Done...');
Writeln('XPos,mYPos :',XPos,',',YPos);
end;
XPos := trunc(Event^.X);
YPos := trunc(Event^.Y);
Keys := 0;
if ssShift in ShiftState then Keys := Keys or MK_SHIFT;
@ -424,13 +394,20 @@ begin
if ssRight in ShiftState then Keys := Keys or MK_RBUTTON;
if ssMiddle in ShiftState then Keys := Keys or MK_MBUTTON;
end;
Result := DeliverPostMessage(Data, Msg);
//if ssLeft in ShiftState then WriteLN(Format('[GTKMotionNotify] widget: 0x%p', [widget]));
DeliverPostMessage(Data, Msg);
if (Pointer(MCaptureHandle) <> widget)
and (MCaptureHandle <> 0)
then WriteLN(Format('[GTKMotionNotify] Capture differs --> cap:0x%x gtk:0x%p', [MCaptureHandle, widget]));
then begin
// capture differs. => gtk forgot to tell, that the capturing ended
// -> end capturing
// ToDo: end capturing
WriteLN(Format('[GTKMotionNotify] Capture differs --> cap:0x%x gtk:0x%p',
[MCaptureHandle, widget]));
end;
end;
function gtkMouseBtnPress(widget: PGtkWidget; event : pgdkEventButton;
@ -441,15 +418,22 @@ var
MessI : TLMMouse;
MessE : TLMMouseEvent;
ShiftState: TShiftState;
ShowDebugging : Boolean;
parWindow : PgdkWindow; //the Parent's GDKWindow
//ShowDebugging : Boolean;
//parWindow : PgdkWindow; //the Parent's GDKWindow
begin
//writeln('[gtkMouseBtnPress] ',ToBject(Data).ClassName,' ',Trunc(Event^.X),',',Trunc(Event^.Y));
Result:=true;
{$IFDEF VerboseMouseBugfix}
writeln('[gtkMouseBtnPress] ',TControl(Data).Name,':',TObject(Data).ClassName,' ',Trunc(Event^.X),',',Trunc(Event^.Y));
{$ENDIF}
// stop the signal, so that it is not sent to the parent widgets
//gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-press-event');
EventTrace('Mouse button Press', data);
Assert(False, Format('Trace:[gtkMouseBtnPress] ', []));
ShiftState := GTKEventState2ShiftState(Event^.State);
ShowDebugging := False;
{ShowDebugging := False;
if ShowDebugging then
Begin
writeln('_______________');
@ -466,148 +450,196 @@ begin
parWindow := gtk_widget_get_parent_window(widget);
Writeln('Parwindow is ',LongInt(parwindow));
Writeln('_______________');
end;
end;}
if event^.Button in [4,5]
then begin
if event^.Button in [4,5] then begin
// this is a mouse wheel event
MessE.Msg := LM_MOUSEWHEEL;
MessE.WheelDelta := WHEEL_DELTA[event^.Button = 4];
MessE.X := Trunc(Event^.X);
MessE.Y := trunc(Event^.Y);
MessE.State := ShiftState;
MessE.UserData := Data;
Result := DeliverPostMessage(Data, MessE);
DeliverPostMessage(Data, MessE);
end
else begin
// a normal mouse button is pressed
MessI.Keys := 0;
case event^.Button of
1 : begin
if (LMouseButtonDown) and (not ((Event^.theType = gdk_2button_press) or (Event^.theType = gdk_3button_press))) then Exit;
MessI.Keys := MessI.Keys or MK_LBUTTON;
if ((now - LLastClick) <= ((1/86400)*(DblClickTime/1000))) and (not (Event^.theType = gdk_3button_press)) then
Event^.theType := gdk_2Button_press;
LLastClick := Now;
1:begin
if (LMouseButtonDown) and
(not ((Event^.theType = gdk_2button_press)
or (Event^.theType = gdk_3button_press)))
then
Exit;
MessI.Keys := MessI.Keys or MK_LBUTTON;
if ((now - LLastClick) <= ((1/86400)*(DblClickTime/1000)))
and (not (Event^.theType = gdk_3button_press))
then
Event^.theType := gdk_2Button_press;
LLastClick := Now;
if event^.thetype = gdk_button_press then
MessI.Msg := LM_LBUTTONDOWN
else
if event^.thetype = gdk_2button_press then
begin
MessI.Msg := LM_LBUTTONDBLCLK;
LLastClick := -1;
end
else
if event^.thetype = gdk_3button_press then
begin
MessI.Msg := LM_LBUTTONTRIPLECLK;
LLastClick := -1;
end;
if event^.thetype = gdk_button_press then
MessI.Msg := LM_LBUTTONDOWN
else
if event^.thetype = gdk_2button_press then
begin
MessI.Msg := LM_LBUTTONDBLCLK;
LLastClick := -1;
end
else
if event^.thetype = gdk_3button_press then
begin
MessI.Msg := LM_LBUTTONTRIPLECLK;
LLastClick := -1;
end;
LMouseButtonDown := True;
LMouseButtonDown := True;
end;
2:begin
if (MMouseButtonDown)
and (not ((Event^.theType = gdk_2button_press)
or (Event^.theType = gdk_3button_press)))
then
Exit;
end;
2 : begin
if (MMouseButtonDown) and (not ((Event^.theType = gdk_2button_press) or (Event^.theType = gdk_3button_press))) then Exit;
MessI.Keys := MessI.Keys or MK_MBUTTON;
MessI.Keys := MessI.Keys or MK_MBUTTON;
if ((now - MLastClick) <= ((1/86400)*(DblClickTime/1000)))
and (not (Event^.theType = gdk_3button_press))
then
Event^.theType := gdk_2Button_press;
MLastClick := Now;
if ((now - MLastClick) <= ((1/86400)*(DblClickTime/1000))) and (not (Event^.theType = gdk_3button_press)) then
Event^.theType := gdk_2Button_press;
MLastClick := Now;
if event^.thetype = gdk_button_press then
MessI.Msg := LM_MBUTTONDOWN
else
if event^.thetype = gdk_2button_press then
Begin
MessI.Msg := LM_MBUTTONDBLCLK;
MLastClick := -1;
end
else
if event^.thetype = gdk_3button_press then
begin
MessI.Msg := LM_MBUTTONTRIPLECLK;
LLastClick := -1;
end;
MMouseButtonDown := True;
end;
3:begin
if (RMouseButtonDown)
and (not ((Event^.theType = gdk_2button_press)
or (Event^.theType = gdk_3button_press)))
then Exit;
MessI.Keys := MessI.Keys or MK_RBUTTON;
if event^.thetype = gdk_button_press then
MessI.Msg := LM_MBUTTONDOWN
else
if event^.thetype = gdk_2button_press then
Begin
MessI.Msg := LM_MBUTTONDBLCLK;
MLastClick := -1;
end
else
if event^.thetype = gdk_3button_press then
begin
MessI.Msg := LM_MBUTTONTRIPLECLK;
LLastClick := -1;
end;
MMouseButtonDown := True;
end;
3 : begin
if (RMouseButtonDown) and (not ((Event^.theType = gdk_2button_press) or (Event^.theType = gdk_3button_press))) then Exit;
MessI.Keys := MessI.Keys or MK_RBUTTON;
if ((now - RLastClick) <= ((1/86400)*(DblClickTime/1000)))
and (not (Event^.theType = gdk_3button_press))
then
Event^.theType := gdk_2Button_press;
RLastClick := Now;
if ((now - RLastClick) <= ((1/86400)*(DblClickTime/1000))) and (not (Event^.theType = gdk_3button_press)) then
Event^.theType := gdk_2Button_press;
RLastClick := Now;
if event^.thetype = gdk_button_press then
MessI.Msg := LM_RBUTTONDOWN
else
if event^.thetype = gdk_2button_press then
Begin
MessI.Msg := LM_RBUTTONDBLCLK;
RLastClick := -1;
end
else
if event^.thetype = gdk_3button_press then
begin
MessI.Msg := LM_RBUTTONTRIPLECLK;
LLastClick := -1;
end;
RMouseButtonDown := True;
end;
else MessI.Msg := LM_NULL;
end; //case
if event^.thetype = gdk_button_press then
MessI.Msg := LM_RBUTTONDOWN
else
if event^.thetype = gdk_2button_press then
Begin
MessI.Msg := LM_RBUTTONDBLCLK;
RLastClick := -1;
end
else
if event^.thetype = gdk_3button_press then
begin
MessI.Msg := LM_RBUTTONTRIPLECLK;
LLastClick := -1;
end;
RMouseButtonDown := True;
end;
else
begin
MessI.Msg := LM_NULL;
exit;
end;
end; // case
MessI.XPos := Trunc(Event^.X);
MessI.YPos := Trunc(Event^.Y);
if ssShift in ShiftState then MessI.Keys := MessI.Keys or MK_SHIFT;
if ssCtrl in ShiftState then MessI.Keys := MessI.Keys or MK_CONTROL;
if ssLeft in ShiftState then MessI.Keys := MessI.Keys or MK_LBUTTON;
if ssRight in ShiftState then MessI.Keys := MessI.Keys or MK_RBUTTON;
if ssMiddle in ShiftState then MessI.Keys := MessI.Keys or MK_MBUTTON;
if MessI.Msg <> LM_NULL then Result := DeliverPostMessage(Data, MessI)
else Result:= false;
DeliverPostMessage(Data, MessI);
end;
Result:=true;
end;
function gtkMouseBtnRelease( widget: PGtkWidget; event : pgdkEventButton; data: gPointer) : GBoolean; cdecl;
function gtkMouseBtnRelease(widget: PGtkWidget; event : pgdkEventButton;
data: gPointer) : GBoolean; cdecl;
var
MessI : TLMMouse;
ShiftState: TShiftState;
begin
EventTrace('Mouse button release', data);
Result:=true;
{$IFDEF VerboseMouseBugfix}
writeln('[gtkMouseBtnRelease] ',TControl(Data).Name,':',TObject(Data).ClassName,' ',Trunc(Event^.X),',',Trunc(Event^.Y));
{$ENDIF}
// stop the signal, so that it is not sent to the parent widgets
//gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-release-event');
EventTrace('Mouse button release', data);
Assert(False, Format('Trace:[gtkMouseBtnRelease] ', []));
ShiftState := gtkeventstate2shiftstate(Event^.State);
case event^.Button of
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;
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
begin
MessI.Msg := LM_NULL;
exit;
end;
end;
MessI.XPos := Trunc(Event^.X);
MessI.YPos := Trunc(Event^.Y);
ShiftState := gtkeventstate2shiftstate(Event^.State);
MessI.Keys := 0;
if ssShift in ShiftState then MessI.Keys := MessI.Keys or MK_SHIFT;
if ssCtrl in ShiftState then MessI.Keys := MessI.Keys or MK_CONTROL;
@ -615,16 +647,16 @@ begin
if ssRight in ShiftState then MessI.Keys := MessI.Keys or MK_RBUTTON;
if ssMiddle in ShiftState then MessI.Keys := MessI.Keys or MK_MBUTTON;
if MessI.Msg <> LM_NULL
then Result := DeliverPostMessage(Data, MessI)
else Result := false;
if MessI.Msg <> LM_NULL then
DeliverPostMessage(Data, MessI);
Result:=true;
end;
function gtkclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
//writeln('[gtkclickedCB] ',TObject(Data).ClassName);
//writeln('[gtkclickedCB] ',TObject(Data).ClassName);
EventTrace('clicked', data);
Assert(False, Format('Trace:OBSOLETE: [gtkclickedCB] ', []));
Mess.Msg := LM_CLICKED;
@ -822,14 +854,14 @@ begin
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkmovecursorCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
function gtkmovecursorCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
Result := True;
EventTrace('move-cursor', data);
Mess.msg := LM_MOVECURSOR;
Result := DeliverMessage(Data, Mess) = 0;
DeliverMessage(Data, Mess);
end;
function gtksize_allocateCB(widget: PGtkWidget; size :pGtkAllocation;
@ -874,6 +906,12 @@ begin
' fixwidget=',HexStr(Cardinal(GetFixedWidget(Widget)),8),
' OldPos=',TControl(Data).Left,',',TControl(Data).Top,',',TControl(Data).Width,',',TControl(Data).Height);
{$ENDIF}
{$IFDEF VerboseClientRectBugFix}
if TControl(Data) is TCustomForm then
writeln('gtksize_allocateCB: ',TControl(Data).ClassName,' ',Size^.X,',',Size^.Y);
{$ENDIF}
//if TControl(Data) is TCustomForm then
// writeln('gtksize_allocateCB: ',TControl(Data).Name,':',TControl(Data).ClassName);
SaveSizeNotification(Widget);
Result:=true;
exit;
@ -1714,6 +1752,9 @@ end;
{ =============================================================================
$Log$
Revision 1.75 2002/05/24 07:16:32 lazarus
MG: started mouse bugfix and completed Makefile.fpc
Revision 1.74 2002/05/13 14:47:01 lazarus
MG: fixed client rectangles, TRadioGroup, RecreateWnd

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

@ -1926,69 +1926,100 @@ begin
Result := False;
end;
{------------------------------------------------------------------------------
Function: GetClientBounds
Params: handle:
Result:
Returns: true on success
Returns the client bounds of a control. The client bounds is the rectangle of
the inner area of a control, where the child controls are visible. The
coordinates are relative to the control's left and top.
------------------------------------------------------------------------------}
Function TGTKObject.GetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
var
Widget, ClientWidget: PGtkWidget;
ParentOrigin, ClientOrigin: TPoint;
begin
Result := False;
if Handle = 0 then Exit;
Widget := pgtkwidget(Handle);
ClientWidget := GetFixedWidget(Widget);
if (ClientWidget <> nil) and (ClientWidget^.Window<>nil) then begin
gdk_window_get_origin(Widget^.Window,@ParentOrigin.X,@ParentOrigin.Y);
gdk_window_get_origin(ClientWidget^.Window,@ClientOrigin.X,@ClientOrigin.Y);
ARect.Left:=ClientOrigin.X-ParentOrigin.X;
ARect.Top:=ClientOrigin.Y-ParentOrigin.Y;
ARect.Right:=ARect.Left+ClientWidget^.Allocation.Width;
ARect.Bottom:=ARect.Top+ClientWidget^.Allocation.Height;
{$IFDEF VerboseMouseBugfix}
writeln('EEE ',ClientWidget^.Allocation.Y,' ',Widget^.Allocation.Y,
' ',ParentOrigin.Y,' ',ClientOrigin.Y,
' '
);
{$ENDIF}
end else begin
with Widget^.Allocation do
ARect := Rect(0,0,Width,Height);
end;
Result:=true;
end;
{------------------------------------------------------------------------------
Function: GetClientRect
Params: handle:
Result:
Returns: true on success
Returns the client rectangle of a Handle object. Left and Top are always 0.
The client rectangle is the rectangle, where a child object is visible.
Returns the client rectangle of a control. Left and Top are always 0.
The client rectangle is the size of the inner area of a control, where the
child controls are visible.
------------------------------------------------------------------------------}
Function TGTKObject.GetClientRect(handle : HWND; var ARect : TRect) : Boolean;
var
Widget, ClientWidget: PGtkWidget;
begin
Result := False;
Result := false;
if Handle = 0 then Exit;
Try
ARect.Left := 0;
ARect.Top := 0;
ClientWidget := GetFixedWidget(pgtkwidget(Handle));
if (ClientWidget <> nil) then begin
Widget := ClientWidget;
end else begin
Widget := pgtkwidget(Handle);
end;
{$IFDEF ClientRectBugFix}
if (Widget <> nil) then begin
ARect.Right:=Widget^.Allocation.Width;
ARect.Bottom:=Widget^.Allocation.Height;
end else begin
ARect.Right:=0;
ARect.Bottom:=0;
end;
{$ELSE}
if (Widget <> nil) and (Widget^.Window<>nil) then begin
gdk_window_get_size(Widget^.Window, @ARect.Right, @ARect.Bottom);
end else begin
ARect.Bottom:=0;
ARect.Right:=0;
end;
{$ENDIF}
{$IFDEF VerboseGetClientRect}
if ClientWidget<>nil then begin
writeln('GetClientRect Widget=',HexStr(Cardinal(handle),8),
' Client=',HexStr(Cardinal(ClientWidget),8),
' WindowSize=',ARect.Right,',',ARect.Bottom,
' Allocation=',ClientWidget^.Allocation.Width,',',ClientWidget^.Allocation.Height
);
end else begin
writeln('GetClientRect Widget=',HexStr(Cardinal(handle),8),
' Client=',HexStr(Cardinal(ClientWidget),8),
' WindowSize=',ARect.Right,',',ARect.Bottom,
' Allocation=',Widget^.Allocation.Width,',',Widget^.Allocation.Height
);
end;
{$ENDIF}
// Writeln('Width / Height = '+Inttostr(REct.Right)+'/'+Inttostr(Rect.Bottom));
except
on E: Exception do begin
writeln('TGTKObject.GetClientRect: ',E.Message);
Result := False;
end;
ARect.Left := 0;
ARect.Top := 0;
Widget := pgtkwidget(Handle);
ClientWidget := GetFixedWidget(Widget);
if (ClientWidget <> nil) then
Widget := ClientWidget;
{$IFDEF ClientRectBugFix}
if (Widget <> nil) then begin
ARect.Right:=Widget^.Allocation.Width;
ARect.Bottom:=Widget^.Allocation.Height;
end else begin
ARect.Right:=0;
ARect.Bottom:=0;
end;
{$ELSE}
if (Widget <> nil) and (Widget^.Window<>nil) then begin
gdk_window_get_size(Widget^.Window, @ARect.Right, @ARect.Bottom);
end else begin
ARect.Bottom:=0;
ARect.Right:=0;
end;
{$ENDIF}
{$IFDEF VerboseGetClientRect}
if ClientWidget<>nil then begin
writeln('GetClientRect Widget=',HexStr(Cardinal(handle),8),
' Client=',HexStr(Cardinal(ClientWidget),8),
' WindowSize=',ARect.Right,',',ARect.Bottom,
' Allocation=',ClientWidget^.Allocation.Width,',',ClientWidget^.Allocation.Height
);
end else begin
writeln('GetClientRect Widget=',HexStr(Cardinal(handle),8),
' Client=',HexStr(Cardinal(ClientWidget),8),
' WindowSize=',ARect.Right,',',ARect.Bottom,
' Allocation=',Widget^.Allocation.Width,',',Widget^.Allocation.Height
);
end;
{$ENDIF}
Result:=true;
end;
{------------------------------------------------------------------------------
@ -2191,10 +2222,10 @@ end;
------------------------------------------------------------------------------}
Function TGTKObject.GetParent(Handle : HWND): HWND;
var
p : pgtkwidget;
p : pgtkwidget;
begin
p := (pgtkWidget(Handle)^.parent);
result := longint(p);
p := (pgtkWidget(Handle)^.parent);
Result := longint(p);
end;
@ -2754,25 +2785,24 @@ end;
Params: none
Returns: 0
After the call, Rect will be the Handle object area in screen coordinates.
After the call, Rect will be the control area in screen coordinates.
That means, Left and Top will be the screen coordinate of the TopLeft pixel
of the Handle object and Right and Bottom will be the screen coordinate of
the BottomRight pixel.
------------------------------------------------------------------------------}
function TgtkObject.GetWindowRect(Handle: hwnd; var Rect: TRect): Integer;
function TgtkObject.GetWindowRect(Handle: hwnd; var ARect: TRect): Integer;
var
X, Y, W, H: Integer;
Widget: PGTKWidget;
begin
//Writeln('GetWindowRect');
result := 0; //default
Result := 0; //default
if Handle <> 0 then
begin
Widget := pgtkwidget(Handle);
if Widget^.Window <> nil then Begin
gdk_window_get_origin(Widget^.Window, @X, @Y);
gdk_window_get_size(Widget^.Window, @W, @H);
writeln('[TgtkObject.GetWindowRect] ',x,',',y,',',w,',',h);
end
else
Begin
@ -2782,9 +2812,8 @@ begin
Y := 200;
end;
SetRect(Rect, X, Y, X + W, Y + H);
ARect:=Rect(X,Y,X+W,Y+H);
end;
Writeln('GetWindowRect DONE');
end;
{$IFDEF ClientRectBugFix}
@ -4456,6 +4485,9 @@ end;
{ =============================================================================
$Log$
Revision 1.71 2002/05/24 07:16:34 lazarus
MG: started mouse bugfix and completed Makefile.fpc
Revision 1.70 2002/05/17 10:45:23 lazarus
MG: finddeclaration for stupid things like var a:a;

6
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -70,6 +70,7 @@ Function GetActiveWindow : HWND; override;
function GetCapture: HWND; override;
function GetCaretPos(var lpPoint: TPoint): Boolean; override;
function GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): Boolean; override;
Function GetClientBounds(handle : HWND; var ARect : TRect) : Boolean; override;
Function GetClientRect(handle : HWND; var ARect : TRect) : Boolean; override;
function GetDC(hWnd: HWND): HDC; override;
function GetFocus: HWND; override;
@ -85,7 +86,7 @@ function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize
function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; override;
Function GetWindowLong(Handle : hwnd; int: Integer): Longint; override;
Function GetWindowOrgEx(dc : hdc; var P: TPoint): Integer; override;
Function GetWindowRect(Handle : hwnd; var Rect: TRect): Integer; override;
Function GetWindowRect(Handle : hwnd; var ARect: TRect): Integer; override;
{$IFDEF ClientRectBugFix}
Function GetWindowSize(Handle : hwnd; var Width, Height: integer): boolean; override;
{$ENDIF}
@ -151,6 +152,9 @@ Function WindowFromPoint(Point : TPoint) : HWND; override;
{ =============================================================================
$Log$
Revision 1.29 2002/05/24 07:16:35 lazarus
MG: started mouse bugfix and completed Makefile.fpc
Revision 1.28 2002/05/10 06:05:58 lazarus
MG: changed license to LGPL