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

lcl: further monitor support

Browse Source 
- add TScreen.MonitorFromPoint, TScreen.MonitorFromRect, TScreen.MonitorFromWindow
  - add TForm.Monitor
win32: add support for new TScreen methods

git-svn-id: trunk@19264 -
This commit is contained in:
paul 2009-04-07 05:29:35 +00:00
parent a75bb49700
commit 752897afdc
10 changed files with 183 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/forms.pp
View File

@ -63,6 +63,7 @@ type
TWindowState = (wsNormal, wsMinimized, wsMaximized);
TCloseAction = (caNone, caHide, caFree, caMinimize);
TMonitor = class;
TScrollingWinControl = class;
@ -412,6 +413,7 @@ type
FRestoredHeight: integer;
FShowInTaskbar: TShowInTaskbar;
FWindowState: TWindowState;
function GetMonitor: TMonitor;
function GetPixelsPerInch: Longint;
function GetRestoredLeft: integer;
function GetRestoredTop: integer;
@ -570,6 +572,7 @@ type
stored IsKeyPreviewStored default False;
property Menu : TMainMenu read FMenu write SetMenu;
property ModalResult : TModalResult read FModalResult write SetModalResult;
property Monitor: TMonitor read GetMonitor;
property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
property OnClose: TCloseEvent read FOnClose write FOnClose stored IsForm;
property OnCloseQuery : TCloseQueryEvent
@ -806,6 +809,8 @@ type
snActiveFormChanged
);
TMonitorDefaultTo = (mdNearest, mdNull, mdPrimary);
{ TScreen }
TScreen = class(TLCLComponent)
@ -902,6 +907,12 @@ type
function DisableForms(SkipForm: TCustomForm; DisabledList: TList = nil): TList;
procedure EnableForms(var AFormList: TList);
function MonitorFromPoint(const Point: TPoint;
MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
function MonitorFromRect(const Rect: TRect;
MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
function MonitorFromWindow(const Handle: THandle;
MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
public
property ActiveControl: TWinControl read FActiveControl;
property ActiveCustomForm: TCustomForm read FActiveCustomForm;

5
lcl/include/customform.inc
View File

@ -1706,6 +1706,11 @@ begin
Result:=FPixelsPerInch;
end;
function TCustomForm.GetMonitor: TMonitor;
begin
Result := Screen.MonitorFromWindow(Handle, mdNearest);
end;
function TCustomForm.GetRestoredLeft: integer;
begin
if WindowState=wsNormal then

19
lcl/include/intfbasewinapi.inc
View File

@ -16,7 +16,7 @@
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
@ -1128,7 +1128,22 @@ end;
function TWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar;
uType : Cardinal): integer;
begin
Result:= 0;
Result := 0;
end;
function TWidgetSet.MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord): HMONITOR;
begin
Result := 0;
end;
function TWidgetSet.MonitorFromRect(lprcScreenCoords: PRect; dwFlags: DWord): HMONITOR;
begin
Result := 0;
end;
function TWidgetSet.MonitorFromWindow(hWnd: HWND; dwFlags: DWord): HMONITOR;
begin
Result := 0;
end;
function TWidgetSet.MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;

47
lcl/include/screen.inc
View File

@ -19,6 +19,14 @@
}
const
MonitorSearchFlags: array[TMonitorDefaultTo] of DWord =
(
{ mdNearest } MONITOR_DEFAULTTONEAREST,
{ mdNull } MONITOR_DEFAULTTONULL,
{ mdPrimary } MONITOR_DEFAULTTOPRIMARY
);
function EnumMonitors(hMonitor: HMONITOR; hdcMonitor: HDC; lprcMonitor: PRect;
dwData: LPARAM): LongBool; stdcall;
var
@ -315,6 +323,45 @@ begin
FreeAndNil(AFormList);
end;
function TScreen.MonitorFromPoint(const Point: TPoint;
MonitorDefault: TMonitorDefaultTo): TMonitor;
var
MonitorHandle: HMONITOR;
i: integer;
begin
MonitorHandle := WidgetSet.MonitorFromPoint(Point, MonitorSearchFlags[MonitorDefault]);
for i := 0 to MonitorCount - 1 do
if Monitors[i].Handle = MonitorHandle then
Exit(Monitors[i]);
Result := nil;
end;
function TScreen.MonitorFromRect(const Rect: TRect;
MonitorDefault: TMonitorDefaultTo): TMonitor;
var
MonitorHandle: HMONITOR;
i: integer;
begin
MonitorHandle := WidgetSet.MonitorFromRect(@Rect, MonitorSearchFlags[MonitorDefault]);
for i := 0 to MonitorCount - 1 do
if Monitors[i].Handle = MonitorHandle then
Exit(Monitors[i]);
Result := nil;
end;
function TScreen.MonitorFromWindow(const Handle: THandle;
MonitorDefault: TMonitorDefaultTo): TMonitor;
var
MonitorHandle: HMONITOR;
i: integer;
begin
MonitorHandle := WidgetSet.MonitorFromWindow(Handle, MonitorSearchFlags[MonitorDefault]);
for i := 0 to MonitorCount - 1 do
if Monitors[i].Handle = MonitorHandle then
Exit(Monitors[i]);
Result := nil;
end;
function EnumFontsNoDups(
var LogFont: TEnumLogFontEx;
var Metric: TNewTextMetricEx;

15
lcl/include/winapi.inc
View File

@ -607,6 +607,21 @@ begin
Result:= WidgetSet.MessageBox(hWnd, lpText, lpCaption, uType);
end;
function MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord): HMONITOR;
begin
Result := Widgetset.MonitorFromPoint(ptScreenCoords, dwFlags);
end;
function MonitorFromRect(lprcScreenCoords: PRect; dwFlags: DWord): HMONITOR;
begin
Result := Widgetset.MonitorFromRect(lprcScreenCoords, dwFlags);
end;
function MonitorFromWindow(hWnd: HWND; dwFlags: DWord): HMONITOR;
begin
Result := Widgetset.MonitorFromWindow(hWnd, dwFlags);
end;
function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
begin
Result := WidgetSet.MoveToEx(DC, X, Y, OldPoint);

4
lcl/include/winapih.inc
View File

@ -173,6 +173,10 @@ function LineTo(DC: HDC; X, Y: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual
function MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord): HMONITOR; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MonitorFromRect(lprcScreenCoords: PRect; dwFlags: DWord): HMONITOR; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MonitorFromWindow(hWnd: HWND; dwFlags: DWord): HMONITOR; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function OffsetRect --> independent

63
lcl/interfaces/win32/win32extra.pas
View File

@ -387,6 +387,10 @@ var
GetComboBoxInfo: function(hwndCombo: HWND; pcbi: PComboboxInfo): BOOL; stdcall;
EnumDisplayMonitors: function(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool; stdcall;
GetMonitorInfo: function(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean; stdcall;
MonitorFromWindow: function(hWnd: HWND; dwFlags: DWORD): HMONITOR; stdcall;
MonitorFromRect: function(lprcScreenCoords: PRect; dwFlags: DWord): HMONITOR; stdcall;
MonitorFromPoint: function(ptScreenCoords: TPoint; dwFlags: DWord): HMONITOR; stdcall;
const
@ -971,8 +975,50 @@ begin
Result := False;
end;
function _MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord): HMONITOR;
begin
if ((dwFlags and (MONITOR_DEFAULTTOPRIMARY or MONITOR_DEFAULTTONEAREST) <> 0 ) or
((ptScreenCoords.x >= 0) and
(ptScreenCoords.x < GetSystemMetrics(SM_CXSCREEN)) and
(ptScreenCoords.y >= 0) and
(ptScreenCoords.y < GetSystemMetrics(SM_CYSCREEN)))) then
Result := xPRIMARY_MONITOR
else
Result := 0;
end;
const
function _MonitorFromRect(lprcScreenCoords: PRect; dwFlags: DWord): HMONITOR;
begin
if ((dwFlags and (MONITOR_DEFAULTTOPRIMARY or MONITOR_DEFAULTTONEAREST) <> 0) or
((lprcScreenCoords^.right > 0) and
(lprcScreenCoords^.bottom > 0) and
(lprcScreenCoords^.left < GetSystemMetrics(SM_CXSCREEN)) and
(lprcScreenCoords^.top < GetSystemMetrics(SM_CYSCREEN)))) then
Result := xPRIMARY_MONITOR
else
Result := 0;
end;
function _MonitorFromWindow(hWnd: HWND; dwFlags: DWord): HMONITOR;
var
wp: TWindowPlacement;
B: Boolean;
begin
if (dwFlags and (MONITOR_DEFAULTTOPRIMARY or MONITOR_DEFAULTTONEAREST) <> 0) then
Exit(xPRIMARY_MONITOR);
if IsIconic(hWnd) then
B := GetWindowPlacement(hWnd, @wp)
else
B := GetWindowRect(hWnd, @wp.rcNormalPosition);
if B then
Result := _MonitorFromRect(@wp.rcNormalPosition, dwFlags)
else
Result := 0;
end;
const
msimg32lib = 'msimg32.dll';
user32lib = 'user32.dll';
@ -1033,6 +1079,21 @@ begin
Pointer(GetMonitorInfo) := p
else
Pointer(GetMonitorInfo) := @_GetMonitorInfo;
p := GetProcAddress(user32handle, 'MonitorFromWindow');
if p <> nil then
Pointer(MonitorFromWindow) := p
else
Pointer(MonitorFromWindow) := @_MonitorFromWindow;
p := GetProcAddress(user32handle, 'MonitorFromRect');
if p <> nil then
Pointer(MonitorFromRect) := p
else
Pointer(MonitorFromRect) := @_MonitorFromRect;
p := GetProcAddress(user32handle, 'MonitorFromPoint');
if p <> nil then
Pointer(MonitorFromPoint) := p
else
Pointer(MonitorFromPoint) := @_MonitorFromPoint;
end;
end;

15
lcl/interfaces/win32/win32winapi.inc
View File

@ -2529,6 +2529,21 @@ begin
{$endif}
end;
function TWin32WidgetSet.MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord): HMONITOR;
begin
Result := Win32Extra.MonitorFromPoint(ptScreenCoords, dwFlags);
end;
function TWin32WidgetSet.MonitorFromRect(lprcScreenCoords: PRect; dwFlags: DWord): HMONITOR;
begin
Result := Win32Extra.MonitorFromRect(lprcScreenCoords, dwFlags);
end;
function TWin32WidgetSet.MonitorFromWindow(hWnd: HWND; dwFlags: DWord): HMONITOR;
begin
Result := Win32Extra.MonitorFromWindow(hWnd, dwFlags);
end;
{------------------------------------------------------------------------------
Method: MoveToEx
Params: DC - handle of device context

3
lcl/interfaces/win32/win32winapih.inc
View File

@ -141,6 +141,9 @@ function LineTo(DC: HDC; X, Y: Integer): Boolean; override;
function MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
function MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer): Boolean; override;
function MessageBox(HWnd: HWND; LPText, LPCaption: PChar; UType: Cardinal): Integer; override;
function MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord): HMONITOR; override;
function MonitorFromRect(lprcScreenCoords: PRect; dwFlags: DWord): HMONITOR; override;
function MonitorFromWindow(hWnd: HWND; dwFlags: DWord): HMONITOR; override;
function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; override;
function PeekMessage(Var LPMsg: TMsg; Handle: HWND; WMsgFilterMin, WMsgFilterMax, WRemoveMsg: UINT): Boolean; override;

4
lcl/lcltype.pp
View File

@ -863,6 +863,10 @@ type
{ monitor support }
const
MONITOR_DEFAULTTONULL = $00000000;
MONITOR_DEFAULTTOPRIMARY = $00000001;
MONITOR_DEFAULTTONEAREST = $00000002;
MONITORINFOF_PRIMARY = $00000001;
CCHDEVICENAME = 32;