paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-22 13:59:22 +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 { Policy for using the "OK" close button in the title instead of
the default "X" minimize button } the default "X" minimize button }
TWinCETitlePolicy = (tpAlwaysUseOKButton, tpOKButtonOnlyOnDialogs); TWinCETitlePolicy = (tpAlwaysUseOKButton, tpOKButtonOnlyOnDialogs, tpControlWithBorderIcons);
PPPipeEventInfo = ^PPipeEventInfo; PPPipeEventInfo = ^PPipeEventInfo;
PPipeEventInfo = ^TPipeEventInfo; 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 GetWin32ControlPos(Window, Parent: HWND; var Left, Top: integer);
procedure UpdateWindowStyle(Handle: HWnd; Style: integer; StyleMask: integer); procedure UpdateWindowStyle(Handle: HWnd; Style: integer; StyleMask: integer);
function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD; function BorderStyleToWinAPIFlags(Style: TFormBorderStyle): DWORD;
function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD; function BorderStyleToWinAPIFlagsEx(AForm: TCustomForm; Style: TFormBorderStyle): DWORD;
function GetFileVersion(FileName: string): dword; function GetFileVersion(FileName: string): dword;
function AllocWindowInfo(Window: HWND): PWindowInfo; function AllocWindowInfo(Window: HWND): PWindowInfo;
@ -1028,8 +1028,8 @@ begin
Bottom := AHeight; Bottom := AHeight;
end; end;
BorderStyle := Form.BorderStyle; BorderStyle := Form.BorderStyle;
Windows.AdjustWindowRectEx(@SizeRect, BorderStyleToWin32Flags( Windows.AdjustWindowRectEx(@SizeRect, BorderStyleToWinAPIFlags(
BorderStyle), false, BorderStyleToWin32FlagsEx(BorderStyle)); BorderStyle), false, BorderStyleToWinAPIFlagsEx(Form, BorderStyle));
AWidth := SizeRect.Right - SizeRect.Left; AWidth := SizeRect.Right - SizeRect.Left;
AHeight := SizeRect.Bottom - SizeRect.Top; AHeight := SizeRect.Bottom - SizeRect.Top;
end; end;
@ -1062,7 +1062,7 @@ begin
Windows.SetWindowLong(Handle, GWL_STYLE, NewStyle); Windows.SetWindowLong(Handle, GWL_STYLE, NewStyle);
end; end;
function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD; function BorderStyleToWinAPIFlags(Style: TFormBorderStyle): DWORD;
begin begin
Result := WS_CLIPCHILDREN or WS_CLIPSIBLINGS; Result := WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
case Application.ApplicationType of case Application.ApplicationType of
@ -1097,7 +1097,7 @@ begin
end; end;
end; end;
function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD; function BorderStyleToWinAPIFlagsEx(AForm: TCustomForm; Style: TFormBorderStyle): DWORD;
begin begin
Result := 0; Result := 0;
@ -1118,10 +1118,18 @@ begin
{$ifdef WinCE} {$ifdef WinCE}
// Adds an "OK" close button to the title bar instead of the standard // Adds an "OK" close button to the title bar instead of the standard
// "X" minimize button, unless the developer overrides that decision // "X" minimize button, unless the developer overrides that decision
if WinCEWidgetset.WinCETitlePolicy = tpAlwaysUseOKButton then case WinCEWidgetset.WinCETitlePolicy of
Result := WS_EX_CAPTIONOKBTN
tpAlwaysUseOKButton: Result := WS_EX_CAPTIONOKBTN;
tpControlWithBorderIcons:
begin
if not (biMinimize in AForm.BorderIcons) then Result := WS_EX_CAPTIONOKBTN;
end;
else else
if Style = bsDialog then Result := WS_EX_CAPTIONOKBTN; if Style = bsDialog then Result := WS_EX_CAPTIONOKBTN;
end;
{$endif} {$endif}
end; end;

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

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