From a843068398f2432bfd9d79aa58c452c7ce38024e Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Thu, 2 Feb 2012 15:18:27 +0000 Subject: [PATCH] customdrawn: Adds the possibility to compile to WinCE git-svn-id: trunk@35087 - --- .../customdrawn/customdrawn_winproc.pas | 161 +++++++--- lcl/interfaces/customdrawn/customdrawnint.pas | 10 +- .../customdrawn/customdrawnobject_win.inc | 5 + .../customdrawn/customdrawnwinapi_win.inc | 22 +- .../customdrawn/customdrawnwsforms_win.inc | 279 ++++++++++-------- lcl/interfaces/customdrawn/wincallback.inc | 8 +- 6 files changed, 324 insertions(+), 161 deletions(-) diff --git a/lcl/interfaces/customdrawn/customdrawn_winproc.pas b/lcl/interfaces/customdrawn/customdrawn_winproc.pas index 1bf4bd90d2..b33a4dd45f 100644 --- a/lcl/interfaces/customdrawn/customdrawn_winproc.pas +++ b/lcl/interfaces/customdrawn/customdrawn_winproc.pas @@ -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; diff --git a/lcl/interfaces/customdrawn/customdrawnint.pas b/lcl/interfaces/customdrawn/customdrawnint.pas index 3a700cc68b..e2fbe57ea5 100644 --- a/lcl/interfaces/customdrawn/customdrawnint.pas +++ b/lcl/interfaces/customdrawn/customdrawnint.pas @@ -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; diff --git a/lcl/interfaces/customdrawn/customdrawnobject_win.inc b/lcl/interfaces/customdrawn/customdrawnobject_win.inc index 4f14e1b717..c6214b4b91 100644 --- a/lcl/interfaces/customdrawn/customdrawnobject_win.inc +++ b/lcl/interfaces/customdrawn/customdrawnobject_win.inc @@ -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; {------------------------------------------------------------------------------ diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc b/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc index 922a138429..66652f2a7f 100644 --- a/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc +++ b/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc @@ -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])); diff --git a/lcl/interfaces/customdrawn/customdrawnwsforms_win.inc b/lcl/interfaces/customdrawn/customdrawnwsforms_win.inc index aded85e704..f7eb11f3e3 100644 --- a/lcl/interfaces/customdrawn/customdrawnwsforms_win.inc +++ b/lcl/interfaces/customdrawn/customdrawnwsforms_win.inc @@ -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 diff --git a/lcl/interfaces/customdrawn/wincallback.inc b/lcl/interfaces/customdrawn/wincallback.inc index eb71088861..59d72f134d 100644 --- a/lcl/interfaces/customdrawn/wincallback.inc +++ b/lcl/interfaces/customdrawn/wincallback.inc @@ -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