paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-03 21:40:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

Patch from zaher from bug #17249 and also fixes compiling the wince interface for win32

Browse Source 
git-svn-id: trunk@27244 -
This commit is contained in:
sekelsenmat 2010-09-01 12:32:43 +00:00
parent d92436b1e6
commit c239bbb27d
4 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
lcl/interfaces/wince/wincewinapi.inc
View File

@ -1181,17 +1181,7 @@ end;}
------------------------------------------------------------------------------}
function TWinCEWidgetSet.ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom: Integer): Integer;
var
P: TPoint;
begin
// Fixes the following bug: http://bugs.freepascal.org/view.php?id=17249
if LCLIntf.GetWindowOrgEx(DC, @P) > 0 then
begin
Left := Left + P.x;
Top := Top + P.y;
Right := Right + P.x;
Bottom := Bottom + P.y;
end;
Result := Windows.ExcludeClipRect(dc, Left, Top, Right, Bottom);
end;
@ -1442,13 +1432,8 @@ end;
------------------------------------------------------------------------------}
function TWinCEWidgetSet.GetClipBox(DC : hDC; lpRect : PRect) : Longint;
var
P: TPoint;
begin
Result := Windows.GetClipBox(DC, Windows.LPRECT(lpRect));
// Fixes the following bug: http://bugs.freepascal.org/view.php?id=17249
if LCLIntf.GetWindowOrgEx(DC, @P) > 0 then
OffsetRect(lpRect^, -P.x, -P.y);
end;
{------------------------------------------------------------------------------
@ -2025,6 +2010,18 @@ begin
{$endif}
end;
function TWinCEWidgetSet.MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean;
var
P: TPoint;
lResult: Integer;
Begin
lResult := GetViewPortOrgEx(dc, @P);
if lResult <> 0 then
Result := SetViewPortOrgEx(dc, P.x+dX, P.y+dY, @P)
else
Result := False;
end;
{ This routine isn't used directly by the LCL
We implent it with SetViewPortOrgEx because GetViewPortOrgEx is
only available in Windows Mobile 5.0 +

1
lcl/interfaces/wince/wincewinapih.inc
View File

@ -142,6 +142,7 @@ function GetTextColor(DC: HDC) : TColorRef; override;
function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; override;
function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; override;
function GetViewPortExtEx(DC: HDC; Size: PSize): Integer; override;
function MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean; override;
function GetViewPortOrgEx(DC: HDC; P: PPoint): Integer; override;
function GetWindowExtEx(DC: HDC; Size: PSize): Integer; override;
function GetWindowLong(Handle : hwnd; int: Integer): PtrInt; override;

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

@ -454,6 +454,7 @@ var
begin
TWinCEWSWinControl.ShowHide(AWinControl);
{$ifndef Win32}
// In atKeyPadDevice mode, we need to install the menu upon showing
if (Application.ApplicationType = atKeyPadDevice) and
lForm.HandleObjectShouldBeVisible then
@ -463,6 +464,7 @@ begin
else
CeSetMenu(AWinControl.Handle, lForm.Menu.Handle, lForm.Menu);
end;
{$endif}
end;
end.

4
lcl/interfaces/wince/wincewsmenus.pp
View File

@ -46,8 +46,10 @@ type
class procedure UpdateCaption(const AMenuItem: TMenuItem; ACaption: String);
class procedure AttachMenuEx(const AMenuItem: TMenuItem; const AParentHandle: HMENU);
class procedure CopyMenuToHandle(const AMenuItem: TMenuItem; const ADest: HMENU);
{$ifndef Win32}
class function FindMenuForm(const AMenu: TMenu; var AMenuBarHandle: THandle;
var AForm: TForm): Boolean;
{$endif}
published
class procedure AttachMenu(const AMenuItem: TMenuItem); override;
class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override;
@ -760,6 +762,7 @@ begin
end;
end;
{$ifndef Win32}
class function TWinCEWSMenuItem.FindMenuForm(const AMenu: TMenu;
var AMenuBarHandle: THandle; var AForm: TForm): Boolean;
var
@ -776,6 +779,7 @@ begin
Break;
end;
end;
{$endif}
class procedure TWinCEWSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
begin