paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 05:59:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

Allows the button policy to be chosen per-form in Windows CE

Browse Source 
git-svn-id: trunk@15576 -
This commit is contained in:
sekelsenmat 2008-06-25 23:40:33 +00:00
parent bf73615fac
commit 3c3f190780
3 changed files with 23 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/interfaces/wince/winceint.pp
View File

@ -107,7 +107,7 @@ type
{ Policy for using the "OK" close button in the title instead of
the default "X" minimize button }
TWinCETitlePolicy = (tpAlwaysUseOKButton, tpOKButtonOnlyOnDialogs);
TWinCETitlePolicy = (tpAlwaysUseOKButton, tpOKButtonOnlyOnDialogs, tpControlWithBorderIcons);
PPPipeEventInfo = ^PPipeEventInfo;
PPipeEventInfo = ^TPipeEventInfo;

24
lcl/interfaces/wince/winceproc.pp
View File

@ -80,8 +80,8 @@ procedure LCLFormSizeToWin32Size(Form: TCustomForm; var AWidth, AHeight: Integer
procedure GetWin32ControlPos(Window, Parent: HWND; var Left, Top: integer);
procedure UpdateWindowStyle(Handle: HWnd; Style: integer; StyleMask: integer);
function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD;
function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD;
function BorderStyleToWinAPIFlags(Style: TFormBorderStyle): DWORD;
function BorderStyleToWinAPIFlagsEx(AForm: TCustomForm; Style: TFormBorderStyle): DWORD;
function GetFileVersion(FileName: string): dword;
function AllocWindowInfo(Window: HWND): PWindowInfo;
@ -1028,8 +1028,8 @@ begin
Bottom := AHeight;
end;
BorderStyle := Form.BorderStyle;
Windows.AdjustWindowRectEx(@SizeRect, BorderStyleToWin32Flags(
BorderStyle), false, BorderStyleToWin32FlagsEx(BorderStyle));
Windows.AdjustWindowRectEx(@SizeRect, BorderStyleToWinAPIFlags(
BorderStyle), false, BorderStyleToWinAPIFlagsEx(Form, BorderStyle));
AWidth := SizeRect.Right - SizeRect.Left;
AHeight := SizeRect.Bottom - SizeRect.Top;
end;
@ -1062,7 +1062,7 @@ begin
Windows.SetWindowLong(Handle, GWL_STYLE, NewStyle);
end;
function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD;
function BorderStyleToWinAPIFlags(Style: TFormBorderStyle): DWORD;
begin
Result := WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
case Application.ApplicationType of
@ -1097,7 +1097,7 @@ begin
end;
end;
function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD;
function BorderStyleToWinAPIFlagsEx(AForm: TCustomForm; Style: TFormBorderStyle): DWORD;
begin
Result := 0;
@ -1118,10 +1118,18 @@ begin
{$ifdef WinCE}
// Adds an "OK" close button to the title bar instead of the standard
// "X" minimize button, unless the developer overrides that decision
if WinCEWidgetset.WinCETitlePolicy = tpAlwaysUseOKButton then
Result := WS_EX_CAPTIONOKBTN
case WinCEWidgetset.WinCETitlePolicy of
tpAlwaysUseOKButton: Result := WS_EX_CAPTIONOKBTN;
tpControlWithBorderIcons:
begin
if not (biMinimize in AForm.BorderIcons) then Result := WS_EX_CAPTIONOKBTN;
end;
else
if Style = bsDialog then Result := WS_EX_CAPTIONOKBTN;
end;
{$endif}
end;

13
lcl/interfaces/wince/wincewsforms.pp
View File

@ -205,10 +205,10 @@ var
BorderStyle: TFormBorderStyle;
begin
BorderStyle := AForm.BorderStyle;
Flags := BorderStyleToWin32Flags(BorderStyle);
Flags := BorderStyleToWinAPIFlags(BorderStyle);
if AForm.Parent <> nil then
Flags := (Flags or WS_CHILD) and not WS_POPUP;
FlagsEx := BorderStyleToWin32FlagsEx(BorderStyle);
FlagsEx := BorderStyleToWinAPIFlagsEx(AForm, BorderStyle);
if (AForm.FormStyle in fsAllStayOnTop) then
FlagsEx := FlagsEx or WS_EX_TOPMOST;
Flags := Flags or CalcBorderIconsFlags(AForm);
@ -219,8 +219,8 @@ begin
// the LCL defines the size of a form without border, win32 with.
// -> adjust size according to BorderStyle
SizeRect := AForm.BoundsRect;
Windows.AdjustWindowRectEx(@SizeRect, BorderStyleToWin32Flags(
AForm.BorderStyle), false, BorderStyleToWin32FlagsEx(AForm.BorderStyle));
Windows.AdjustWindowRectEx(@SizeRect, BorderStyleToWinAPIFlags(
AForm.BorderStyle), false, BorderStyleToWinAPIFlagsEx(AForm, AForm.BorderStyle));
end;
procedure CalculateDialogPosition(var Params: TCreateWindowExParams;
@ -400,8 +400,8 @@ begin
-> adjust size according to BorderStyle
Must be done after setting sizeRect }
BorderStyle := TCustomForm(AWinControl).BorderStyle;
Windows.AdjustWindowRectEx(@SizeRect, BorderStyleToWin32Flags(
BorderStyle), false, BorderStyleToWin32FlagsEx(BorderStyle));
Windows.AdjustWindowRectEx(@SizeRect, BorderStyleToWinAPIFlags(
BorderStyle), false, BorderStyleToWinAPIFlagsEx(TCustomForm(AWinControl), BorderStyle));
// rect adjusted, pass to inherited to do real work
TWinCEWSWinControl.SetBounds(AWinControl, SizeRect.Left, SizeRect.Top,
@ -409,7 +409,6 @@ begin
end;
class procedure TWinCEWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
iconHandle: HICON;
begin
if not WSCheckHandleAllocated(AForm, 'SetIcon') then
Exit;