fix sizing/non-sizing border sizes

git-svn-id: trunk@5461 -
This commit is contained in:
micha 2004-05-12 15:11:46 +00:00
parent 65faba3c10
commit bb7c7d9a06
3 changed files with 49 additions and 29 deletions

View File

@ -690,13 +690,8 @@ activate_time : the time at which the activation event occurred.
begin
// the LCL defines the size of a form without border, win32 with.
// -> adjust size according to BorderStyle
case TCustomForm(Sender).BorderStyle of
bsSizeable,bsSingle,bsDialog:
Windows.AdjustWindowRect(@SizeRect,WS_OVERLAPPEDWINDOW,false);
bsToolWindow,bsSizeToolWin:
Windows.AdjustWindowRectEx(@SizeRect,WS_OVERLAPPEDWINDOW,false,WS_EX_TOOLWINDOW);
//bsNone: -> Do Nothing
end;
Windows.AdjustWindowRectEx(@SizeRect, BorderStyleToWin32Flags(TCustomForm(Sender).BorderStyle), false,
BorderStyleToWin32FlagsEx(TCustomForm(Sender).BorderStyle));
end;
end;
ResizeChild(TheWinControl, Left, Top,
@ -2036,26 +2031,10 @@ Begin
csForm:
Begin
Assert(False, 'Trace:CreateComponent - Creating a Form Window');
Flags:= WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
Case TCustomForm(Sender).BorderStyle of
//bsSizeable:; -> Default
bsSingle:
Flags:= Flags and DWORD(not WS_THICKFRAME);
bsDialog:
Flags:= Flags and DWORD(not (WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX));
bsNone:
Flags:= WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
bsToolWindow:
Begin
FlagsEx:=WS_EX_TOOLWINDOW;
Flags:= Flags and DWORD(not WS_THICKFRAME);
End;
bsSizeToolWin:
FlagsEx:=WS_EX_TOOLWINDOW;
End;//case
If TCustomForm(Sender).FormStyle = fsStayOnTop Then
FlagsEx:= FlagsEx or WS_EX_TOPMOST;
Flags := BorderStyleToWin32Flags(TCustomForm(Sender).BorderStyle);
FlagsEx := BorderStyleToWin32FlagsEx(TCustomForm(Sender).BorderStyle);
if TCustomForm(Sender).FormStyle = fsStayOnTop then
FlagsEx := FlagsEx or WS_EX_TOPMOST;
pClassName := @ClsName;
WindowTitle := StrCaption;
Left := LongInt(CW_USEDEFAULT);
@ -2974,6 +2953,9 @@ End;
{
$Log$
Revision 1.192 2004/05/12 15:11:46 micha
fix sizing/non-sizing border sizes
Revision 1.191 2004/05/12 09:46:25 micha
fix toolbar buttons by handling them as customcontrols
remove handledialogmessage, now handled in lcl

View File

@ -728,6 +728,31 @@ Begin
dec(Top,TopOffset);
End;
function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD;
begin
Result := WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
case Style of
//bsSizeable:; -> Default
bsSingle:
Result := Result and DWORD(not WS_THICKFRAME);
bsDialog:
Result := Result and DWORD(not (WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX));
bsNone:
Result := WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
bsToolWindow:
Result := Result and DWORD(not WS_THICKFRAME);
end;
end;
function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD;
begin
Result := 0;
case Style of
bsToolWindow, bsSizeToolWin:
Result := WS_EX_TOOLWINDOW;
end;
end;
{$IFDEF ASSERT_IS_ON}
{$UNDEF ASSERT_IS_ON}
{$C-}
@ -736,6 +761,9 @@ End;
{ =============================================================================
$Log$
Revision 1.40 2004/05/12 15:11:46 micha
fix sizing/non-sizing border sizes
Revision 1.39 2004/02/23 08:19:05 micha
revert intf split

View File

@ -1995,14 +1995,21 @@ begin
Height := Bottom - Top;
end;
// convert top level lcl window coordinaties to win32 coord
Style := Windows.GetWindowLong(Handle, GWL_STYLE);
ExStyle := Windows.GetWindowLong(Handle, GWL_EXSTYLE);
if (Style and WS_BORDER) <> 0 then
if (Style and WS_THICKFRAME) <> 0 then
begin
// convert top level lcl window coordinaties to win32 coord
// thick, sizing border
// add twice, top+bottom border
Dec(Width, 2*Windows.GetSystemMetrics(SM_CXSIZEFRAME));
Dec(Height, 2*Windows.GetSystemMetrics(SM_CYSIZEFRAME));
end else
if (Style and WS_BORDER) <> 0 then
begin
// thin, non-sizing border
Dec(Width, 2*Windows.GetSystemMetrics(SM_CXFIXEDFRAME));
Dec(Height, 2*Windows.GetSystemMetrics(SM_CYFIXEDFRAME));
end;
if (Style and WS_CAPTION) <> 0 then
if (ExStyle and WS_EX_TOOLWINDOW) <> 0 then
@ -2975,6 +2982,9 @@ end;
{ =============================================================================
$Log$
Revision 1.108 2004/05/12 15:11:46 micha
fix sizing/non-sizing border sizes
Revision 1.107 2004/04/11 10:19:28 micha
cursor management updated:
- lcl notifies interface via WSControl.SetCursor of changes