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

TWinControl.WmSize/Move now updates interface messages smarter

Browse Source 
git-svn-id: trunk@4375 -
This commit is contained in:
mattias 2003-07-06 20:40:34 +00:00
parent 9fe6966160
commit 256475cd40
9 changed files with 113 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
docs/CrossCompile.txt
View File

@ -62,9 +62,9 @@ Install the units:
This will create the correct directory structure, but probably in the wrong
directory. Move the /usr/local/lib/fpc/<version>/i386-win32/units directory to
your fpc install directory. For example if your linux units (e.g. classes.ppu)
is located in /usr/lib/fpc/1.0.8/units/linux/ then do
[]$ rm -rf /usr/lib/fpc/1.0.8/units/win32
[]$ mv /usr/local/lib/fpc/<version>/i386-win32/units /usr/lib/fpc/1.0.8/units/win32
is located in /usr/lib/fpc/1.0.10/units/linux/ then do
[]$ rm -rf /usr/lib/fpc/<version>/units/win32
[]$ mv /usr/local/lib/fpc/<version>/cross/i386-win32/units /usr/lib/fpc/<version>/units/win32
3. Making /etc/fpc.cfg target independent:

5
lcl/include/control.inc
View File

@ -2435,7 +2435,7 @@ var
Locked: boolean;
begin
if (Message.SizeType = Size_Restored)
and (FWidth = Message.Width) and (FHeight = Message.Height) then exit;
and (FWidth = Message.Width) and (FHeight = Message.Height) then exit;
{$IFDEF CHECK_POSITION}
writeln('[TControl.WMSize] Name=',Name,':',ClassName,' Message.Width=',Message.Width,' Message.Height=',Message.Height,' Width=',Width,' Height=',Height);
@ -2483,6 +2483,9 @@ end;
{ =============================================================================
$Log$
Revision 1.141 2003/07/06 20:40:34 mattias
TWinControl.WmSize/Move now updates interface messages smarter
Revision 1.140 2003/07/06 17:53:34 mattias
updated polish localization

28
lcl/include/interfacebase.inc
View File

@ -955,7 +955,7 @@ end;
Function TInterfaceBase.GetParent(Handle : HWND): HWND;
begin
Result := 0;
Result := 0;
end;
Function TInterfaceBase.GetProp(Handle : hwnd; Str : PChar): Pointer;
@ -1064,6 +1064,29 @@ begin
Result := 0;
end;
function TInterfaceBase.GetWindowRelativePosition(Handle : hwnd;
var Left, Top: integer): boolean;
// return the position of the left, top coordinate relative to the clientorigin
// of its parent. This is normally the Left, Top of a TWinControl. But not
// during moving/sizing
var
ChildRect: TRect;
ParentLeftTop: TPoint;
ParentHandle: hWnd;
begin
Result:=false;
GetWindowRect(Handle,ChildRect);
Left:=ChildRect.Left;
Top:=ChildRect.Top;
ParentHandle:=GetParent(Handle);
if ParentHandle<>0 then begin
if not ClientToScreen(ParentHandle,ParentLeftTop) then exit;
dec(Left,ParentLeftTop.X);
dec(Top,ParentLeftTop.Y);
end;
Result := true;
end;
Function TInterfaceBase.GetWindowSize(Handle : hwnd;
var Width, Height: integer): boolean;
begin
@ -1780,6 +1803,9 @@ end;
{ =============================================================================
$Log$
Revision 1.96 2003/07/06 20:40:34 mattias
TWinControl.WmSize/Move now updates interface messages smarter
Revision 1.95 2003/07/04 10:12:16 mattias
added default message handler to win32 interface

9
lcl/include/winapi.inc
View File

@ -600,6 +600,12 @@ begin
Result := InterfaceObject.GetWindowRect(Handle, Rect);
end;
function GetWindowRelativePosition(Handle : hwnd;
var Left, Top: integer): boolean;
begin
Result := InterfaceObject.GetWindowRelativePosition(Handle,Left,Top);
end;
Function GetWindowSize(Handle : hwnd; var Width, Height: integer): boolean;
begin
Result := InterfaceObject.GetWindowSize(Handle, Width, Height);
@ -1634,6 +1640,9 @@ end;
{ =============================================================================
$Log$
Revision 1.90 2003/07/06 20:40:34 mattias
TWinControl.WmSize/Move now updates interface messages smarter
Revision 1.89 2003/07/04 10:12:16 mattias
added default message handler to win32 interface

6
lcl/include/winapih.inc
View File

@ -159,7 +159,8 @@ function GetTextExtentPoint32(DC: HDC; Str: PChar; Count: Integer; var Size: TSi
function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowLong(Handle : hwnd; int : Integer): Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowRect(Handle : hwnd; var Rect : TRect): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function GetWindowSize(Handle : hwnd; var Width, Height: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowRelativePosition(Handle : hwnd; var Left, Top: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowSize(Handle : hwnd; var Width, Height: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowOrgEx(dc : hdc; P : PPoint): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GradientFill(DC: HDC; Vertices: PTriVertex; NumVertices : Longint;
Meshes: Pointer; NumMeshes : Longint; Mode : Longint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -388,6 +389,9 @@ procedure RaiseLastOSError;
{ =============================================================================
$Log$
Revision 1.83 2003/07/06 20:40:34 mattias
TWinControl.WmSize/Move now updates interface messages smarter
Revision 1.82 2003/07/04 10:12:16 mattias
added default message handler to win32 interface

41
lcl/include/wincontrol.inc
View File

@ -2304,14 +2304,25 @@ end;
event handler.
------------------------------------------------------------------------------}
procedure TWinControl.WMMove(var Message: TLMMove);
var
NewWidth, NewHeight: integer;
begin
{$IFDEF VerboseSizeMsg}
writeln('TWinControl.WMMove A ',Name,':',ClassName,' Message=',Message.XPos,',',Message.YPos,
' BoundsRealized=',FBoundsRealized.Left,',',FBoundsRealized.Top,',',FBoundsRealized.Right-FBoundsRealized.Left,',',FBoundsRealized.Bottom-FBoundsRealized.Top);
{$ENDIF}
NewWidth:=Width;
NewHeight:=Height;
if Message.MoveType=Move_SourceIsInterface then begin
// interface widget has moved
FBoundsRealized:=Bounds(Message.XPos,Message.YPos,
FBoundsRealized.Right-FBoundsRealized.Left,
FBoundsRealized.Bottom-FBoundsRealized.Top);
// -> update size and realized bounds
NewWidth:=FBoundsRealized.Right-FBoundsRealized.Left;
NewHeight:=FBoundsRealized.Bottom-FBoundsRealized.Top;
if HandleAllocated then
GetWindowSize(Handle,NewWidth,NewHeight);
FBoundsRealized:=Bounds(Message.XPos,Message.YPos,NewWidth,NewHeight);
end;
inherited WMMove(Message);
SetBoundsKeepBase(Message.XPos,Message.YPos,NewWidth,NewHeight,Parent<>nil);
end;
{------------------------------------------------------------------------------
@ -2325,13 +2336,26 @@ end;
in FBoundsRealized to avoid sending a size message back to the interface.
------------------------------------------------------------------------------}
procedure TWinControl.WMSize(var Message: TLMSize);
var
NewLeft, NewTop: integer;
begin
{$IFDEF VerboseSizeMsg}
writeln('TWinControl.WMSize A ',Name,':',ClassName,' Message=',Message.Width,',',Message.Height,
' BoundsRealized=',FBoundsRealized.Left,',',FBoundsRealized.Top,',',FBoundsRealized.Right-FBoundsRealized.Left,',',FBoundsRealized.Bottom-FBoundsRealized.Top);
{$ENDIF}
NewLeft:=Left;
NewTop:=Top;
if Message.SizeType=Size_SourceIsInterface then begin
// interface widget has resized
FBoundsRealized.Right:=FBoundsRealized.Left+Message.Width;
FBoundsRealized.Bottom:=FBoundsRealized.Top+Message.Height;
// -> update position and realized bounds
NewLeft:=FBoundsRealized.Left;
NewTop:=FBoundsRealized.Top;
if HandleAllocated then
GetWindowRelativePosition(Handle,NewLeft,NewTop);
FBoundsRealized:=Bounds(NewLeft,NewTop,Message.Width,Message.Height);
end;
inherited WMSize(Message);
SetBoundsKeepBase(NewLeft,NewTop,Message.Width,Message.Height,Parent<>nil);
end;
{------------------------------------------------------------------------------
@ -2890,6 +2914,9 @@ end;
{ =============================================================================
$Log$
Revision 1.152 2003/07/06 20:40:34 mattias
TWinControl.WmSize/Move now updates interface messages smarter
Revision 1.151 2003/07/04 10:12:16 mattias
added default message handler to win32 interface

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

@ -5099,6 +5099,25 @@ begin
end;
end;
{------------------------------------------------------------------------------
Function: GetWindowRelativePosition
Params: Handle : hwnd;
Returns: true on success
returns the current widget Left, Top, relative to the client origin of its
parent
------------------------------------------------------------------------------}
function TgtkObject.GetWindowRelativePosition(Handle : hwnd;
var Left, Top: integer): boolean;
begin
if GtkWidgetIsA(PGtkWidget(Handle),GTk_WIDGET_TYPE) then begin
Result:=true;
Left:=PGtkWidget(Handle)^.Allocation.X;
Top:=PGtkWidget(Handle)^.Allocation.Y;
end else
Result:=false;
end;
{------------------------------------------------------------------------------
Function: GetWindowSize
Params: Handle : hwnd;
@ -8571,6 +8590,9 @@ end;
{ =============================================================================
$Log$
Revision 1.260 2003/07/06 20:40:34 mattias
TWinControl.WmSize/Move now updates interface messages smarter
Revision 1.259 2003/07/04 22:06:49 mattias
implemented interface graphics

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

@ -120,6 +120,7 @@ function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; override;
Function GetWindowLong(Handle : hwnd; int: Integer): Longint; override;
Function GetWindowOrgEx(dc : hdc; P: PPoint): Integer; override;
Function GetWindowRect(Handle : hwnd; var ARect: TRect): Integer; override;
function GetWindowRelativePosition(Handle : hwnd; var Left, Top: integer): boolean; override;
Function GetWindowSize(Handle : hwnd; var Width, Height: integer): boolean; override;
function GradientFill(DC: HDC; Vertices: PTriVertex; NumVertices : Longint;
Meshes: Pointer; NumMeshes : Longint; Mode : Longint): Boolean; Override;
@ -210,6 +211,9 @@ Procedure DeleteCriticalSection(var CritSection: TCriticalSection); Override;
{ =============================================================================
$Log$
Revision 1.73 2003/07/06 20:40:34 mattias
TWinControl.WmSize/Move now updates interface messages smarter
Revision 1.72 2003/07/02 15:56:15 mattias
fixed win32 painting and started creating bitmaps from rawimages

7
lcl/interfaces/win32/win32callback.inc
View File

@ -341,7 +341,7 @@ Begin
Begin
Msg := LM_MOVE;
// MoveType := WParam; WParam is not defined!
MoveType := 0;
MoveType := Size_SourceIsInterface;
XPos := R.Left;
YPos := R.Top;
End;
@ -437,7 +437,7 @@ Begin
With TLMSize(LMessage) Do
Begin
Msg := LM_SIZE;
SizeType := WParam;
SizeType := Size_SourceIsInterface; //WParam;
Width := R.Right - R.Left;
Height := R.Bottom - R.Top;
End;
@ -560,6 +560,9 @@ end;
{
$Log$
Revision 1.37 2003/07/06 20:40:34 mattias
TWinControl.WmSize/Move now updates interface messages smarter
Revision 1.36 2003/07/04 10:12:16 mattias
added default message handler to win32 interface