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

lcl: add TScreen.PrimaryMonitor

Browse Source 
git-svn-id: trunk@19262 -
This commit is contained in:
paul 2009-04-07 02:52:51 +00:00
parent 4db59e3374
commit 5600446d97
2 changed files with 13 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/forms.pp
View File

@ -850,6 +850,7 @@ type
function GetHeight : Integer;
function GetMonitor(Index: Integer): TMonitor;
function GetMonitorCount: Integer;
function GetPrimaryMonitor: TMonitor;
function GetWidth : Integer;
procedure AddForm(AForm: TCustomForm);
procedure RemoveForm(AForm: TCustomForm);
@ -925,12 +926,13 @@ type
property HintFont: TFont read GetHintFont;
property MonitorCount: Integer read GetMonitorCount;
property Monitors[Index: Integer]: TMonitor read GetMonitor;
property PixelsPerInch: integer read FPixelsPerInch;
property PrimaryMonitor: TMonitor read GetPrimaryMonitor;
property Width: Integer read GetWidth;
property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange
write FOnActiveControlChange;
property OnActiveFormChange: TNotifyEvent read FOnActiveFormChange
write FOnActiveFormChange;
property PixelsPerInch: integer read FPixelsPerInch;
end;

10
lcl/include/screen.inc
View File

@ -551,6 +551,16 @@ begin
Result := FMonitors.Count;
end;
function TScreen.GetPrimaryMonitor: TMonitor;
var
i: integer;
begin
for i := 0 to MonitorCount - 1 do
if Monitors[i].Primary then
Exit(Monitors[i]);
Result := nil;
end;
function TScreen.GetHintFont: TFont;
begin
if (FHintFont=nil) then