paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-24 15:19:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: pass device coords for SelectClipRGN (issue #15508)

Browse Source 
git-svn-id: trunk@25239 -
This commit is contained in:
paul 2010-05-07 11:21:56 +00:00
parent 4809be32c6
commit 6f99fb6338
1 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/include/canvas.inc
View File

@ -68,13 +68,18 @@ end;
procedure TCanvas.SetClipRect(const ARect: TRect); procedure TCanvas.SetClipRect(const ARect: TRect);
var var
RGN: HRGN; RGN: HRGN;
LogicalRect: TRect;
begin begin
inherited SetClipRect(ARect); inherited SetClipRect(ARect);
{$ifndef ver2_2} {$ifndef ver2_2}
if inherited GetClipping then if inherited GetClipping then
begin begin
{$endif} {$endif}
with ARect do // ARect is in logical coords. CreateRectRGN accepts device coords.
// So we need to translate them
LogicalRect := ARect;
LPtoDP(Handle, LogicalRect, 2);
with LogicalRect do
RGN := CreateRectRGN(Left, Top, Right, Bottom); RGN := CreateRectRGN(Left, Top, Right, Bottom);
SelectClipRGN(Handle, RGN); SelectClipRGN(Handle, RGN);
DeleteObject(RGN); DeleteObject(RGN);