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

lcl: add TMonitor.PixelsPerInch

Browse Source 
git-svn-id: trunk@53687 -
This commit is contained in:
ondrej 2016-12-15 08:18:10 +00:00
parent c52584ecb0
commit 9ec0b84232
2 changed files with 12 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/forms.pp
View File

@ -940,6 +940,7 @@ type
function GetInfo(out Info: TMonitorInfo): Boolean; {inline; fpc bug - compilation error with inline}
function GetLeft: Integer;
function GetHeight: Integer;
function GetPixelsPerInch: Integer;
function GetTop: Integer;
function GetWidth: Integer;
function GetBoundsRect: TRect;
@ -955,6 +956,7 @@ type
property BoundsRect: TRect read GetBoundsRect;
property WorkareaRect: TRect read GetWorkareaRect;
property Primary: Boolean read GetPrimary;
property PixelsPerInch: Integer read GetPixelsPerInch;
end;
{ TMonitorList }

10
lcl/include/monitor.inc
View File

@ -27,6 +27,16 @@ begin
Result := Left;
end;
function TMonitor.GetPixelsPerInch: Integer;
var
X, Y: UINT;
begin
if WidgetSet.GetDpiForMonitor(FHandle, MDT_EFFECTIVE_DPI, X, Y)=S_OK then
Result := X
else
Result := Screen.PixelsPerInch;
end;
function TMonitor.GetHeight: Integer;
begin
with GetBoundsRect do