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

split up implementation of ResizeChild

Browse Source 
git-svn-id: trunk@7371 -
This commit is contained in:
micha 2005-07-18 13:49:54 +00:00
parent 993f9a7aaa
commit 4d1f460836
8 changed files with 137 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/interfaces/win32/win32int.pp
View File

@ -166,9 +166,6 @@ Type
Procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
procedure UpdateThemesActive;
// procedures needed by interface methods
procedure ResizeChild(Sender: TWinControl; Left, Top, Width, Height: Integer);
// create and destroy
function CreateComponent(Sender : TObject): THandle; override;
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; override;
@ -242,11 +239,6 @@ Uses
////////////////////////////////////////////////////
Arrow, Calendar, CListBox, Spin, CheckLst, WinExt, LclProc;
const
// needs to move
MCM_FIRST = $1000;
MCM_GETMINREQRECT = MCM_FIRST + 9;
type
TMouseDownFocusStatus = (mfNone, mfFocusSense, mfFocusChanged);
@ -291,6 +283,9 @@ End.
{ =============================================================================
$Log$
Revision 1.142 2005/07/18 13:49:54 micha
split up implementation of ResizeChild
Revision 1.141 2005/07/18 12:44:15 micha
remove unused TLazObject

81
lcl/interfaces/win32/win32object.inc
View File

@ -515,84 +515,6 @@ Begin
IconName := StrToPChar(Str);
End;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.ResizeChild
Params: Sender - the object which invoked this function
Left, Top, Width ,Height - new dimensions for the control
Returns: Nothing
Resize a window
------------------------------------------------------------------------------}
Procedure TWin32WidgetSet.ResizeChild(Sender: TWinControl;
Left, Top, Width, Height: Integer);
Var
{$IFDEF VerboseSizeMsg}
OldLeft: Integer;
OldTop: Integer;
{$ENDIF}
lRect: TRect;
WinHandle, BuddyHandle: HWND;
StringList: TWin32ComboBoxStringList;
suppressMove: boolean;
Begin
// if not Sender.HandleAllocated then exit; --> Already checked (LM_SETSIZE and LM_RECREATEWND)
{$IFDEF VerboseSizeMsg}
OldLeft:=Left;
OldTop:=Top;
{$ENDIF}
LCLBoundsToWin32Bounds(Sender, Left, Top, Width, Height);
{$IFDEF VerboseSizeMsg}
writeln('TWin32WidgetSet.ResizeChild A ',Sender.Name,':',Sender.ClassName,
' LCL=',OldLeft,',',OldTop,',',Width,',',Height,
' Win32=',Left,',',Top,',',Width,',',Height,
'');
{$ENDIF}
WinHandle := Sender.Handle;
suppressMove := false;
case Sender.FCompStyle of
csSpinEdit:
begin
// detach from buddy first
BuddyHandle := Windows.SendMessage(WinHandle, UDM_SETBUDDY, 0, 0);
MoveWindow(BuddyHandle, Left, Top, Width, Height, True);
// reattach
Windows.SendMessage(WinHandle, UDM_SETBUDDY, BuddyHandle, 0);
suppressMove := true;
end;
csGroupBox:
begin
// check if we have a ``container'', if so, move that
BuddyHandle := GetWindowInfo(WinHandle)^.ParentPanel;
if BuddyHandle <> 0 then
begin
MoveWindow(BuddyHandle, Left, Top, Width, Height, false);
Left := 0;
Top := 0;
end;
end;
else
if Sender is TCustomComboBox then
begin
StringList := TWin32ComboBoxStringList(GetWindowInfo(WinHandle)^.List);
if StringList <> nil then
Height := StringList.ComboHeight;
end else
if Sender is TCustomCalendar then
begin
Windows.SendMessage(WinHandle, MCM_GETMINREQRECT, 0, LPARAM(@lRect));
Width := lRect.Right;
Height := lRect.Bottom;
end;
end;
if not suppressMove then
MoveWindow(WinHandle, Left, Top, Width, Height, True);
LCLControlSizeNeedsUpdate(Sender,False);
End;
{------------------------------------------------------------------------------
Function: TWin32WidgetSet.CreateComponent
Params: Sender - object for which to create visual representation
@ -716,6 +638,9 @@ end;
{
$Log$
Revision 1.312 2005/07/18 13:49:54 micha
split up implementation of ResizeChild
Revision 1.311 2005/07/18 12:37:58 micha
remove TWin32WidgetSet.RecreateWnd, use the one from Controls unit

4
lcl/interfaces/win32/win32winapi.inc
View File

@ -379,7 +379,6 @@ var
DataHandle: HGLOBAL;
Data: pointer;
Size: integer;
TextData: PChar;
Begin
Assert(False, 'TWin32WidgetSet.ClipboardGetData - Start');
Result := false;
@ -3159,6 +3158,9 @@ end;
{ =============================================================================
$Log$
Revision 1.148 2005/07/18 13:49:54 micha
split up implementation of ResizeChild
Revision 1.147 2005/07/08 17:58:02 micha
fix 798, spinedit control needs coordinates of buddy

21
lcl/interfaces/win32/win32wscalendar.pp
View File

@ -47,6 +47,8 @@ type
public
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean);
class function GetDateTime(const ACalendar: TCustomCalendar): TDateTime; override;
class procedure SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime); override;
class procedure SetDisplaySettings(const ACalendar: TCustomCalendar; const ASettings: TDisplaySettings); override;
@ -80,7 +82,24 @@ begin
FinishCreateWindow(AWinControl, Params, false);
Result := Params.Window;
// resize to proper size
TWin32WidgetSet(InterfaceObject).ResizeChild(AWinControl, Params.Left, Params.Top, 0, 0);
SetBounds(AWinControl, Params.Left, Params.Top, 0, 0);
end;
const
// TODO: needs to move
MCM_FIRST = $1000;
MCM_GETMINREQRECT = MCM_FIRST + 9;
procedure TWin32WSCalendar.AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean);
var
WinHandle: HWND;
lRect: TRect;
begin
WinHandle := AWinControl.Handle;
Windows.SendMessage(WinHandle, MCM_GETMINREQRECT, 0, LPARAM(@lRect));
Width := lRect.Right;
Height := lRect.Bottom;
end;
function TWin32WSCalendar.GetDateTime(const ACalendar: TCustomCalendar): TDateTime;

37
lcl/interfaces/win32/win32wscontrols.pp
View File

@ -66,6 +66,8 @@ type
protected
public
class procedure AddControl(const AControl: TControl); override;
class procedure AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean); virtual;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
@ -312,6 +314,11 @@ begin
SetParent(ChildHandle, ParentHandle);
end;
procedure TWin32WSWinControl.AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean);
begin
end;
function TWin32WSWinControl.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
begin
AText := '';
@ -366,9 +373,35 @@ begin
SWP_NOSIZE or SWP_NOSENDCHANGING);
end;
procedure TWin32WSWinControl.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer);
{------------------------------------------------------------------------------
Method: SetBounds
Params: AWinControl - the object which invoked this function
ALeft, ATop, AWidth, AHeight - new dimensions for the control
Pre: AWinControl.HandleAllocated
Returns: Nothing
Resize a window
------------------------------------------------------------------------------}
procedure TWin32WSWinControl.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
var
IntfLeft, IntfTop, IntfWidth, IntfHeight: integer;
suppressMove: boolean;
begin
TWin32WidgetSet(InterfaceObject).ResizeChild(AWinControl, ALeft, ATop, AWidth, AHeight);
IntfLeft := ALeft; IntfTop := ATop;
IntfWidth := AWidth; IntfHeight := AHeight;
LCLBoundsToWin32Bounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight);
{$IFDEF VerboseSizeMsg}
writeln('TWin32WSWinControl.ResizeWindow A ',AWinControl.Name,':',AWinControl.ClassName,
' LCL=',ALeft,',',ATop,',',AWidth,',',AHeight,
' Win32=',IntfLeft,',',IntfTop,',',IntfWidth,',',IntfHeight,
'');
{$ENDIF}
suppressMove := false;
AdaptBounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight, suppressMove);
if not suppressMove then
MoveWindow(AWinControl.Handle, IntfLeft, IntfTop, IntfWidth, IntfHeight, true);
LCLControlSizeNeedsUpdate(AWinControl, false);
end;
procedure TWin32WSWinControl.SetColor(const AWinControl: TWinControl);

47
lcl/interfaces/win32/win32wsextctrls.pp
View File

@ -63,6 +63,7 @@ type
const AChild: TCustomPage; const AIndex: integer); override;
class procedure MovePage(const ANotebook: TCustomNotebook;
const AChild: TCustomPage; const NewIndex: integer); override;
class procedure RemoveAllNBPages(const ANotebook: TCustomNotebook);
class procedure RemovePage(const ANotebook: TCustomNotebook;
const AIndex: integer); override;
@ -247,28 +248,6 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: RemoveAllNBPages
Params: Notebook - The notebook control
Returns: Nothing
Removes all pages from a notebook control (showtabs becomes false)
------------------------------------------------------------------------------}
procedure RemoveAllNBPages(Notebook: TCustomNotebook);
var
I: Integer;
R: TRect;
begin
for I := Notebook.PageCount - 1 downto 0 do
Windows.SendMessage(Notebook.Handle, TCM_DELETEITEM, Windows.WPARAM(I), 0);
// Adjust page size to fit in tabcontrol, need bounds of notebook in client of parent
TWin32WidgetSet(InterfaceObject).GetClientRect(Notebook.Handle, R);
R.Right := R.Right - R.Left;
R.Bottom := R.Bottom - R.Top;
for I := 0 to Notebook.PageCount - 1 do
TWin32WidgetSet(InterfaceObject).ResizeChild(Notebook.Page[I], R.Left, R.Top, R.Right, R.Bottom);
end;
{ sets focus to a control on the newly focused tab page }
procedure NotebookTabChanged(Notebook: TCustomNotebook; NewIndex: integer);
var
@ -413,6 +392,30 @@ begin
Windows.SendMessage(ANotebook.Handle, TCM_DELETEITEM, Windows.WPARAM(AIndex), 0);
end;
{------------------------------------------------------------------------------
Method: RemoveAllNBPages
Params: Notebook - The notebook control
Returns: Nothing
Removes all pages from a notebook control (showtabs becomes false)
------------------------------------------------------------------------------}
procedure TWin32WSCustomNotebook.RemoveAllNBPages(const ANotebook: TCustomNotebook);
var
I: Integer;
R: TRect;
WinHandle: HWND;
begin
WinHandle := ANotebook.Handle;
for I := ANotebook.PageCount - 1 downto 0 do
Windows.SendMessage(WinHandle, TCM_DELETEITEM, Windows.WPARAM(I), 0);
// Adjust page size to fit in tabcontrol, need bounds of notebook in client of parent
TWin32WidgetSet(InterfaceObject).GetClientRect(WinHandle, R);
R.Right := R.Right - R.Left;
R.Bottom := R.Bottom - R.Top;
for I := 0 to ANotebook.PageCount - 1 do
SetBounds(ANotebook.Page[I], R.Left, R.Top, R.Right, R.Bottom);
end;
function TWin32WSCustomNotebook.GetPageRealIndex(const ANotebook: TCustomNotebook; AIndex: Integer): Integer;
var
X: Integer;

16
lcl/interfaces/win32/win32wsspin.pp
View File

@ -46,6 +46,8 @@ type
private
protected
public
class function AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer): boolean;
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class function GetSelStart(const ACustomSpinEdit: TCustomSpinEdit): integer; override;
@ -115,6 +117,20 @@ begin
Result := Params.Window;
end;
function TWin32WSCustomSpinEdit.AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer): boolean;
var
WinHandle, BuddyHandle: HWND;
begin
WinHandle := AWinControl.Handle;
// detach from buddy first
BuddyHandle := Windows.SendMessage(WinHandle, UDM_SETBUDDY, 0, 0);
MoveWindow(BuddyHandle, Left, Top, Width, Height, True);
// reattach
Windows.SendMessage(WinHandle, UDM_SETBUDDY, BuddyHandle, 0);
Result := true;
end;
function TWin32WSCustomSpinEdit.GetSelStart(const ACustomSpinEdit: TCustomSpinEdit): integer;
begin
Result := EditGetSelStart(SendMessage(ACustomSpinEdit.Handle, UDM_GETBUDDY, 0, 0));

32
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -59,6 +59,8 @@ type
public
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean);
end;
{ TWin32WSGroupBox }
@ -77,6 +79,8 @@ type
public
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean);
class function GetSelStart(const ACustomComboBox: TCustomComboBox): integer; override;
class function GetSelLength(const ACustomComboBox: TCustomComboBox): integer; override;
class function GetItemIndex(const ACustomComboBox: TCustomComboBox): integer; override;
@ -388,6 +392,22 @@ begin
Result := Params.Window;
end;
procedure TWin32WSCustomGroupBox.AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean);
var
WinHandle, BuddyHandle: HWND;
begin
WinHandle := AWinControl.Handle;
// check if we have a ``container'', if so, move that
BuddyHandle := GetWindowInfo(WinHandle)^.ParentPanel;
if BuddyHandle <> 0 then
begin
MoveWindow(BuddyHandle, Left, Top, Width, Height, false);
Left := 0;
Top := 0;
end;
end;
{ TWin32WSCustomListBox }
function TWin32WSCustomListBox.CreateHandle(const AWinControl: TWinControl;
@ -583,6 +603,18 @@ begin
Result := Params.Window;
end;
procedure TWin32WSCustomComboBox.AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean);
var
WinHandle: HWND;
StringList: TWin32ComboBoxStringList;
begin
WinHandle := AWinControl.Handle;
StringList := TWin32ComboBoxStringList(GetWindowInfo(WinHandle)^.List);
if StringList <> nil then
Height := StringList.ComboHeight;
end;
function TWin32WSCustomComboBox.GetSelStart(const ACustomComboBox: TCustomComboBox): integer;
begin
SendMessage(ACustomComboBox.Handle, CB_GETEDITSEL, Windows.WPARAM(@Result), Windows.LPARAM(nil));