paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-20 10:59:23 +01:00
Code Issues Packages Projects Releases Wiki Activity

customdrawn: Adds the possibility to compile to WinCE

Browse Source 
git-svn-id: trunk@35087 -
This commit is contained in:
sekelsenmat 2012-02-02 15:18:27 +00:00
parent 971b471ca4
commit a843068398
6 changed files with 324 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

161
lcl/interfaces/customdrawn/customdrawn_winproc.pas
View File

@ -131,12 +131,20 @@ type
StayOnTopList: TList;
end;
TWinCEVersion = (wince_1, wince_2, wince_3, wince_4,
wince_5, wince_6, wince_6_1, wince_6_5, wince_7,
wince_other);
TWindowsVersion = (
wvUnknown,
//
wince_1,
wince_2,
wince_3,
wince_4,
wince_5,
wince_6,
wince_6_1,
wince_6_5,
wince_7,
wince_other,
//
wv95,
wvNT4,
wv98,
@ -148,6 +156,7 @@ type
wvVista,
//wvServer2008, // has the same major/minor as wvVista
wv7,
wv8,
wvLater
);
@ -162,7 +171,9 @@ procedure FillRawImageDescription(const ABitmapInfo: Windows.TBitmap; out ADesc:
function WinProc_RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMask: HBITMAP; ARect: PRect = nil): Boolean;
function WinProc_RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean): Boolean;
{$ifndef WinCE}
function GetBitmapOrder(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP):TRawImageLineOrder;
{$endif}
function GetBitmapBytes(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP; const ARect: TRect; ALineEnd: TRawImageLineEnd; ALineOrder: TRawImageLineOrder; out AData: Pointer; out ADataSize: PtrUInt): Boolean;
function IsAlphaBitmap(ABitmap: HBITMAP): Boolean;
function IsAlphaDC(ADC: HDC): Boolean;
@ -202,7 +213,6 @@ function WideStrCmp(W1, W2: PWideChar): Integer;
{ Automatic detection of platform }
function GetWinCEPlatform: TApplicationType;
function GetWinCEVersion: TWinCEVersion;
function IsHiResMode: Boolean;
procedure UpdateWindowsVersion;
@ -220,6 +230,8 @@ const
implementation
uses customdrawnint;
var
InRemoveStayOnTopFlags: Integer = 0;
@ -700,6 +712,45 @@ end;
Returns:
------------------------------------------------------------------------------}
{$ifdef WinCE}
function WinProc_RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean): Boolean;
var
ADesc: TRawImageDescription absolute ARawImage.Description;
DC: HDC;
BitsPtr: Pointer;
DataSize: PtrUInt;
begin
Result := False;
AMask := 0;
if not ((ADesc.BitsPerPixel = 1) and (ADesc.LineEnd = rileWordBoundary)) then
begin
DC := Windows.GetDC(0);
AMask := 0;
ABitmap := CreateDIBSectionFromDescription(DC, ADesc, BitsPtr);
//DbgDumpBitmap(ABitmap, 'CreateBitmaps - Image');
Windows.ReleaseDC(0, DC);
Result := ABitmap <> 0;
if not Result then Exit;
if BitsPtr = nil then Exit;
// copy the image data
DataSize := BytesPerLine(ADesc.Width, ADesc.BitsPerPixel) * ADesc.Height;
if DataSize > ARawImage.DataSize
then DataSize := ARawImage.DataSize;
Move(ARawImage.Data^, BitsPtr^, DataSize);
end
else
ABitmap := Windows.CreateBitmap(ADesc.Width, ADesc.Height, 1, 1, ARawImage.Data);
if ASkipMask then Exit(True);
AMask := Windows.CreateBitmap(ADesc.Width, ADesc.Height, 1, 1, ARawImage.Mask);
//DbgDumpBitmap(ABitmap, 'CreateBitmaps - Mask');
Result := AMask <> 0;
end;
{$else}
function WinProc_RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean): Boolean;
var
ADesc: TRawImageDescription absolute ARawImage.Description;
@ -839,6 +890,7 @@ begin
Result := AMask <> 0;
//DbgDumpBitmap(AMask, 'CreateBitmaps - Mask');
end;
{$endif}
function CreateDIBSectionFromDescription(ADC: HDC; const ADesc: TRawImageDescription; out ABitsPtr: Pointer): HBITMAP;
function GetMask(APrec, AShift: Byte): Cardinal;
@ -919,6 +971,7 @@ begin
DeleteDC(DstDC);
end;
{$ifndef Wince}
function GetBitmapOrder(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP): TRawImageLineOrder;
procedure DbgLog(const AFunc: String);
begin
@ -1007,7 +1060,43 @@ begin
if FullScanLine
then FreeMem(Scanline);
end;
{$endif}
{$ifdef WinCE}
//function GetBitmapBytes(ABitmap: HBITMAP; const ARect: TRect; ALineEnd: TRawImageLineEnd; var AData: Pointer; var ADataSize: PtrUInt): Boolean;
function GetBitmapBytes(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP; const ARect: TRect; ALineEnd: TRawImageLineEnd; ALineOrder: TRawImageLineOrder; out AData: Pointer; out ADataSize: PtrUInt): Boolean;
var
Section: Windows.TDIBSection;
DIBCopy: HBitmap;
DIBData: Pointer;
begin
Result := False;
// first try if the bitmap is created as section
if (Windows.GetObject(ABitmap, SizeOf(Section), @Section) > 0) and (Section.dsBm.bmBits <> nil)
then begin
with Section.dsBm do
Result := CopyImageData(bmWidth, bmHeight, bmWidthBytes, bmBitsPixel, bmBits, ARect, riloTopToBottom, riloTopToBottom, ALineEnd, AData, ADataSize);
Exit;
end;
// bitmap is not a section, retrieve only bitmap
if Windows.GetObject(ABitmap, SizeOf(Section.dsBm), @Section) = 0
then Exit;
DIBCopy := CreateDIBSectionFromDDB(ABitmap, DIBData);
if DIBCopy = 0 then
Exit;
if (Windows.GetObject(DIBCopy, SizeOf(Section), @Section) > 0) and (Section.dsBm.bmBits <> nil)
then begin
with Section.dsBm do
Result := CopyImageData(bmWidth, bmHeight, bmWidthBytes, bmBitsPixel, bmBits, ARect, riloTopToBottom, riloTopToBottom, ALineEnd, AData, ADataSize);
end;
DeleteObject(DIBCopy);
Result := True;
end;
{$else}
function GetBitmapBytes(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP; const ARect: TRect; ALineEnd: TRawImageLineEnd; ALineOrder: TRawImageLineOrder; out AData: Pointer; out ADataSize: PtrUInt): Boolean;
var
DC: HDC;
@ -1084,6 +1173,7 @@ begin
FreeMem(SrcData);
end;
{$endif}
function IsAlphaBitmap(ABitmap: HBITMAP): Boolean;
var
@ -1342,7 +1432,7 @@ 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
case WinCEWidgetset.WinCETitlePolicy of
case CDWidgetSet.WinCETitlePolicy of
tpAlwaysUseOKButton: Result := WS_EX_CAPTIONOKBTN;
@ -1607,38 +1697,6 @@ begin
end;
{$endif}
function GetWinCEVersion: TWinCEVersion;
{$ifdef MSWindows}
begin
Result := wince_other;
end;
{$else}
var
versionInfo: OSVERSIONINFO;
begin
Result := wince_other;
System.FillChar(versionInfo, sizeof(OSVERSIONINFO), #0);
versionInfo.dwOSVersionInfoSize := sizeof(OSVERSIONINFO);
if GetVersionEx(@versionInfo) then
begin
case versionInfo.dwMajorVersion of
1: Result := wince_1;
2: Result := Wince_2;
3: Result := Wince_3;
4: Result := Wince_4;
5:
begin
if versionInfo.dwMinorVersion = 2 then Result := Wince_6
else Result := Wince_5;
end;
6: Result := Wince_6;
end;
end;
end;
{$endif}
function IsHiResMode: Boolean;
begin
{$ifdef MSWindows}
@ -1677,6 +1735,32 @@ begin
end;
procedure UpdateWindowsVersion;
{$ifdef WinCE}
var
versionInfo: OSVERSIONINFO;
begin
WindowsVersion := wince_other;
System.FillChar(versionInfo, sizeof(OSVERSIONINFO), #0);
versionInfo.dwOSVersionInfoSize := sizeof(OSVERSIONINFO);
if GetVersionEx(@versionInfo) then
begin
case versionInfo.dwMajorVersion of
1: WindowsVersion := wince_1;
2: WindowsVersion := Wince_2;
3: WindowsVersion := Wince_3;
4: WindowsVersion := Wince_4;
5:
begin
if versionInfo.dwMinorVersion = 2 then WindowsVersion := Wince_6
else WindowsVersion := Wince_5;
end;
6: WindowsVersion := Wince_6;
end;
end;
end;
{$else}
begin
case Win32MajorVersion of
0..3:;
@ -1713,6 +1797,7 @@ begin
WindowsVersion := wvLater;
end;
end;
{$endif}
initialization
DefaultWindowInfo := TWindowInfo.Create;

10
lcl/interfaces/customdrawn/customdrawnint.pas
View File

@ -37,6 +37,7 @@ uses
{$ifdef CD_Android}
customdrawn_androidproc, jni, bitmap, log, keycodes,
{$endif}
{$ifdef WinCE}aygshell,{$endif}
// Widgetset
customdrawnproc,
// LCL
@ -48,6 +49,8 @@ uses
type
{$ifdef CD_Windows}
TWinCETitlePolicy = (tpAlwaysUseOKButton, tpOKButtonOnlyOnDialogs, tpControlWithBorderIcons);
PPPipeEventInfo = ^PPipeEventInfo;
PPipeEventInfo = ^TPipeEventInfo;
TPipeEventInfo = record
@ -225,6 +228,11 @@ type
{$I customdrawnwinapih.inc}
{$I customdrawnlclintfh.inc}
public
{ Variables to be set by the user }
{$ifdef WinCE}
WinCETitlePolicy: TWinCETitlePolicy;
{$endif}
end;
var
@ -234,7 +242,7 @@ function CDMessageBoxFunction(Text, Caption : PChar; Flags : Longint) : Integer;
{$ifdef CD_WINDOWS}
function WindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
LParam: Windows.LParam): LResult; {$ifdef WinCE}cdecl;{$else}stdcall;{$endif}
{$endif}
{$ifdef CD_X11}
procedure MyXConnectionWatchProc(display: PDisplay; client_data: TXPointer;

5
lcl/interfaces/customdrawn/customdrawnobject_win.inc
View File

@ -47,8 +47,10 @@ begin
if Result then
begin
WindowClass.style := WindowClass.style or CS_SAVEBITS;
{$ifndef WinCE}
if WindowsVersion >= wvXP then
WindowClass.style := WindowClass.style or CS_DROPSHADOW;
{$endif}
WindowClass.hIcon := 0;
WindowClass.hbrBackground := 0;
WindowClass.LPSzClassName := @ClsHintName;
@ -72,12 +74,15 @@ begin
{$ifdef VerboseCDForms}
DebugLn(Format('[TCDWidgetSet.CreateAppHandle] FAppHandle=%x', [PtrInt(FAppHandle)]));
{$endif}
{$ifndef WinCE}
// AllocWindowInfo(FAppHandle);
// remove useless menuitems from sysmenu
SysMenu := Windows.GetSystemMenu(FAppHandle, False);
Windows.DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND);
Windows.DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND);
Windows.DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND);
{$endif}
end;
{------------------------------------------------------------------------------

22
lcl/interfaces/customdrawn/customdrawnwinapi_win.inc
View File

@ -2153,7 +2153,11 @@ begin
// the length of utf8 vs Wide/Ansi the strings differ, so recalc.
// TODO: use the real number of chars (and not the length)
w := UTF8ToUTF16(S);
{$ifdef WinCE}
Result := Windows.GetTextExtentPoint32W(WinDC, PWideChar(W), Length(W), Size);
{$else}
Result := Windows.GetTextExtentPoint32W(WinDC, PWideChar(W), Length(W), @Size);
{$endif}
Windows.ReleaseDC(0, WinDC);
Result := True;
@ -2260,10 +2264,11 @@ begin
lHandle := lWindowInfo.NativeHandle;
WindowPlacement.length := SizeOf(WindowPlacement);
{$ifndef WinCE}
if Windows.IsIconic(lHandle) and Windows.GetWindowPlacement(lHandle, @WindowPlacement) then
R := WindowPlacement.rcNormalPosition
else
if not Windows.GetWindowRect(lHandle, @R) then Exit;
else{$endif}
if not Windows.GetWindowRect(lHandle, @R) then Exit;
LeftTop.X := R.Left;
LeftTop.Y := R.Top;
@ -2290,7 +2295,11 @@ end;
Returns: true on success
Returns the current widget Width and Height
------------------------------------------------------------------------------}
Note: Windows.GetWindowInfo doesnt exist in wince, but
we can use GetWindowLong and other APIs for most information
Also GetWindowPlacement doesnt exist
------------------------------------------------------------------------------}
function TCDWidgetSet.BackendGetWindowSize(Handle : hwnd;
var Width, Height: integer): boolean;
var
@ -2319,8 +2328,13 @@ begin
DebugLn(Format(':[TCDWidgetSet.GetWindowSize] lWindowInfo.LCLForm.Name=%s', [lWindowInfo.LCLForm.Name]));
{$endif}
{$ifdef WinCE}
Result := Boolean(Windows.GetWindowRect(Handle, R));
WP.showCmd := 0;
{$else}
WP.length := SizeOf(WP);
Result := Boolean(Windows.GetWindowPlacement(lHandle, WP));
{$endif}
if not Result then
begin
@ -2340,6 +2354,7 @@ begin
Exit;
end;
{$ifndef WinCE}
// if it is a top level window then you can't use the normal size:
// maximized or aero snap windows will have problems
if (GetWindowLong(lHandle, GWL_STYLE) and WS_CHILD = 0) then
@ -2392,6 +2407,7 @@ begin
end;
ExcludeCaption;
{$endif}
{$ifdef VerboseCDWinAPI}
DebugLn(Format(':<[TCDWidgetSet.GetWindowSize] Width=%d Height=%d', [Width, Height]));

279
lcl/interfaces/customdrawn/customdrawnwsforms_win.inc
View File

@ -131,6 +131,7 @@ end;
class procedure TCDWSCustomForm.WSWinControl_SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
{$ifndef WinCE}
var
IntfLeft, IntfTop, IntfWidth, IntfHeight: integer;
suppressMove: boolean;
@ -168,6 +169,29 @@ begin
end;
LCLControlSizeNeedsUpdate(AWinControl, True);
end;
{$else}
var
IntfLeft, IntfTop, IntfWidth, IntfHeight: integer;
suppressMove: boolean;
begin
IntfLeft := ALeft; IntfTop := ATop;
IntfWidth := AWidth; IntfHeight := AHeight;
LCLBoundsToWin32Bounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight);
{$IFDEF VerboseSizeMsg}
Debugln('TWinCEWSWinControl.ResizeWindow A ',AWinControl.Name,':',AWinControl.ClassName,
' LCL=',dbgs(ALeft),',',dbgs(ATop),',',dbgs(AWidth)+','+dbgs(AHeight),
' Win32=',dbgs(IntfLeft)+','+dbgs(IntfTop)+','+dbgs(IntfWidth),',',dbgs(IntfHeight),
'');
{$ENDIF}
suppressMove := false;
AdaptBounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight, suppressMove);
// Some controls, like spins, may set suppressMove in AdaptBounds
if not suppressMove then
MoveWindow(AWinControl.Handle, IntfLeft, IntfTop, IntfWidth, IntfHeight, true);
LCLControlSizeNeedsUpdate(AWinControl, false);
end;
{$endif}
class function TCDWSCustomForm.DoCreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
@ -189,7 +213,6 @@ class function TCDWSCustomForm.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
lForm: TCustomForm absolute AWinControl;
Bounds: TRect;
SystemMenu: HMenu;
// Create Params
Parent, Window: HWND;
@ -203,6 +226,138 @@ var
//
NCCreateParams: TNCCreateParams;
AErrorCode: DWORD;
//
BorderStyle: TFormBorderStyle;
WR: Windows.RECT;
lWinBounds, lOldLCLBounds, lNewLCLBounds: TRect;
{$ifdef WinCE}
begin
{$ifdef VerboseWinCE}
DebugLn('TWinCEWSCustomForm.CreateHandle');
{$endif}
NCCreateParams.DefWndProc := nil;
NCCreateParams.WinControl := AWinControl;
NCCreateParams.Handled := False;
// general initialization of Params
//Fillchar(Params,Sizeof(Params),0);
Window := HWND(nil);
WindowTitle := UTF8ToUTF16(AParams.Caption);
//SubClassWndProc := @WindowProc;
Flags := AParams.Style;
FlagsEx := AParams.ExStyle;
// Never set the parent of a window to AppHandle,
// otherwise wince will really try to make it a child
Parent := AParams.WndParent;
Left := AParams.X;
Top := AParams.Y;
Width := AParams.Width;
Height := AParams.Height;
LCLBoundsToWin32Bounds(AWinControl, Left, Top, Width, Height);
// if AWinControl is TCustomControl then
// if TCustomControl(AWinControl).BorderStyle = bsSingle then
// FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
// SetStdBiDiModeParams(AWinControl, Params);
// customization of Params
// Different from win32
SubClassWndProc := nil; // Otherwise crash in wince, works in win32
BorderStyle := TCustomForm(AWinControl).BorderStyle;
// Same as in win32
CalcFormWindowFlags(lForm, Flags, FlagsEx);
pClassName := @ClsName;
WindowTitle := UTF8ToUTF16(AParams.Caption);
// Get the difference between the client and window sizes
lWinBounds := lForm.BoundsRect;
Windows.AdjustWindowRectEx(@lWinBounds, Flags, false, FlagsEx);
if Application.ApplicationType in [atPDA, atKeyPadDevice, atDefault] then
begin
// Gets the work area
Windows.SystemParametersInfo(SPI_GETWORKAREA, 0, @WR, 0);
{ The position and size of common windows is ignored on PDA mode,
and a position and size that covers the whole workarea excluding
the menu is used. The Workarea size automatically excludes the
Taskbar.
Simply using CM_USEDEFAULT produces a too large Height, which
covers the menus. So the workarea size is detected (which ignores
the Taskbar).
In some devices subtracting the menu size seams to work better, but
others, if no menu is present, it's a big problem.
}
if (BorderStyle <> bsDialog) and (BorderStyle <> bsNone) then
begin
Left := WR.Left;
Top := WR.Top;
Height := WR.Bottom - WR.Top;
Width := WR.Right - WR.Left;
// Update the position of the window for the LCL
AWinControl.BoundsRect := Bounds(
Left, Top, Width, Height);
end
else if (BorderStyle = bsDialog) then
{
For dialogs, the window is put in the middle of the screen.
On normal dialogs we need to take into consideration the size of
the window decoration.
For the Top and Left coordinates, using CM_USEDEFAULT produces
a wrong and bad result. Using the Workarea rectagle works fine
for most devices, but not all, so we put the dialog in the center.
}
begin
Top := WR.Top + (WR.Bottom - WR.Top) div 2
- (lWinBounds.Bottom - lWinBounds.Top) div 2;
Left := WR.Left + (WR.Right - WR.Left) div 2
- (lWinBounds.Right - lWinBounds.Left) div 2;
Height := lWinBounds.Bottom - lWinBounds.Top;
Width := lWinBounds.Right - lWinBounds.Left;
// Update the position of the window for the LCL
lOldLCLBounds := lForm.BoundsRect;
lNewLCLBounds.Left := Left - (lWinBounds.Left - lOldLCLBounds.Left);
lNewLCLBounds.Top := Top - (lWinBounds.Top - lOldLCLBounds.Top);
lNewLCLBounds.Right := Left + Width
- (lWinBounds.Right - lOldLCLBounds.Right);
lNewLCLBounds.Bottom := Top + Height
- (lWinBounds.Bottom - lOldLCLBounds.Bottom);
AWinControl.BoundsRect := lNewLCLBounds;
end
else { BorderStyle = bsNone }
{ On borderless Windows we allow the user full control of the
window position
}
begin
//CalculateDialogPosition(Params, lWinBounds, lForm);
end;
end
else
begin
{ On Desktop mode we need to take into consideration the size of
the window decoration }
//CalculateDialogPosition(Params, lWinBounds, lForm);
end;
// create window
Window := CreateWindowExW(FlagsEx, pClassName,
PWideChar(WindowTitle), Flags,
Left, Top, Width, Height, Parent, 0, HInstance, @NCCreateParams);
Result := Window;
end;
{$else}
begin
{$ifdef VerboseCDForms}
DebugLn(Format(':>[TCDWSCustomForm.CreateHandle] AWincontrol=%x left=%d Top=%d'
@ -255,7 +410,7 @@ begin
end;
CalcFormWindowFlags(lForm, Flags, FlagsEx);
pClassName := @ClsName[0];
AdjustFormBounds(lForm, Bounds);
AdjustFormBounds(lForm, lWinBounds);
if (lForm.Position in [poDefault, poDefaultPosOnly]) and not (csDesigning in lForm.ComponentState) then
begin
Left := CW_USEDEFAULT;
@ -263,8 +418,8 @@ begin
end
else
begin
Left := Bounds.Left;
Top := Bounds.Top;
Left := lWinBounds.Left;
Top := lWinBounds.Top;
end;
if (lForm.Position in [poDefault, poDefaultSizeOnly]) and not (csDesigning in lForm.ComponentState) then
begin
@ -273,8 +428,8 @@ begin
end
else
begin
Width := Bounds.Right - Bounds.Left;
Height := Bounds.Bottom - Bounds.Top;
Width := lWinBounds.Right - lWinBounds.Left;
Height := lWinBounds.Bottom - lWinBounds.Top;
end;
//SubClassWndProc := @CustomFormWndProc;
if not (csDesigning in lForm.ComponentState) and lForm.AlphaBlend then
@ -324,117 +479,7 @@ begin
[PtrInt(Result)]));
{$endif}
end;
(*var
Params: TCreateWindowExParams;
LForm : TCustomForm;
BorderStyle: TFormBorderStyle;
WR: Windows.RECT;
lWinBounds, lOldLCLBounds, lNewLCLBounds: TRect;
begin
{$ifdef VerboseWinCE}
DebugLn('TWinCEWSCustomForm.CreateHandle');
{$endif}
// general initialization of Params
PrepareCreateWindow(AWinControl, AParams, Params);
// customization of Params
with Params do
begin
// Different from win32
SubClassWndProc := nil; // Otherwise crash in wince, works in win32
BorderStyle := TCustomForm(AWinControl).BorderStyle;
// Same as in win32
lForm := TCustomForm(AWinControl);
CalcFormWindowFlags(lForm, Flags, FlagsEx);
pClassName := @ClsName;
WindowTitle := StrCaption;
// Get the difference between the client and window sizes
lWinBounds := lForm.BoundsRect;
Windows.AdjustWindowRectEx(@lWinBounds, Flags, false, FlagsEx);
if Application.ApplicationType in [atPDA, atKeyPadDevice, atDefault] then
begin
// Gets the work area
Windows.SystemParametersInfo(SPI_GETWORKAREA, 0, @WR, 0);
{ The position and size of common windows is ignored on PDA mode,
and a position and size that covers the whole workarea excluding
the menu is used. The Workarea size automatically excludes the
Taskbar.
Simply using CM_USEDEFAULT produces a too large Height, which
covers the menus. So the workarea size is detected (which ignores
the Taskbar).
In some devices subtracting the menu size seams to work better, but
others, if no menu is present, it's a big problem.
}
if (BorderStyle <> bsDialog) and (BorderStyle <> bsNone) then
begin
Left := WR.Left;
Top := WR.Top;
Height := WR.Bottom - WR.Top;
Width := WR.Right - WR.Left;
// Update the position of the window for the LCL
AWinControl.BoundsRect := Bounds(
Params.Left, Params.Top, Params.Width, Params.Height);
end
else if (BorderStyle = bsDialog) then
{
For dialogs, the window is put in the middle of the screen.
On normal dialogs we need to take into consideration the size of
the window decoration.
For the Top and Left coordinates, using CM_USEDEFAULT produces
a wrong and bad result. Using the Workarea rectagle works fine
for most devices, but not all, so we put the dialog in the center.
}
begin
Top := WR.Top + (WR.Bottom - WR.Top) div 2
- (lWinBounds.Bottom - lWinBounds.Top) div 2;
Left := WR.Left + (WR.Right - WR.Left) div 2
- (lWinBounds.Right - lWinBounds.Left) div 2;
Height := lWinBounds.Bottom - lWinBounds.Top;
Width := lWinBounds.Right - lWinBounds.Left;
// Update the position of the window for the LCL
lOldLCLBounds := lForm.BoundsRect;
lNewLCLBounds.Left := Params.Left - (lWinBounds.Left - lOldLCLBounds.Left);
lNewLCLBounds.Top := Params.Top - (lWinBounds.Top - lOldLCLBounds.Top);
lNewLCLBounds.Right := Params.Left + Params.Width
- (lWinBounds.Right - lOldLCLBounds.Right);
lNewLCLBounds.Bottom := Params.Top + Params.Height
- (lWinBounds.Bottom - lOldLCLBounds.Bottom);
AWinControl.BoundsRect := lNewLCLBounds;
end
else { BorderStyle = bsNone }
{ On borderless Windows we allow the user full control of the
window position
}
begin
CalculateDialogPosition(Params, lWinBounds, lForm);
end;
end
else
begin
{ On Desktop mode we need to take into consideration the size of
the window decoration }
CalculateDialogPosition(Params, lWinBounds, lForm);
end;
end;
// create window
FinishCreateWindow(AWinControl, Params, false);
Result := Params.Window;
{$if defined(VerboseWinCE) or defined(VerboseSizeMsg)}
DebugLn('Window Handle = ' + IntToStr(Result));
{$endif}
end; *)
{$endif}
class procedure TCDWSCustomForm.DestroyHandle(const AWinControl: TWinControl);
begin

8
lcl/interfaces/customdrawn/wincallback.inc
View File

@ -830,6 +830,7 @@ begin
end;
WM_CONTEXTMENU:
begin
{$ifndef WinCE}
WinProcess := false;
NotifyUserInput := True;
PLMsg := @LMContextMenu;
@ -841,6 +842,7 @@ begin
hWnd := Window;
Result := 0;
end;
{$endif}
end;
WM_SETCURSOR:
begin
@ -954,11 +956,11 @@ begin
begin
// Implements back-key sending to edits, instead of hiding the form
// See http://bugs.freepascal.org/view.php?id=16699
if HIWORD(lParam) = VK_ESCAPE then
{if HIWORD(lParam) = VK_ESCAPE then
begin
SHSendBackToFocusWindow(Msg, wParam, lParam);
Exit;
end;
end;}
end;
{$endif}
else
@ -991,6 +993,7 @@ begin
case Msg of
WM_MOVE:
begin
{$ifndef WinCE}
PLMsg:=@LMMove;
with LMMove Do
begin
@ -1036,6 +1039,7 @@ begin
Exit;
end;
end;
{$endif}
end;
WM_SIZE:
begin