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

lcl: add TMonitor class which represents single screen monitor, add TScreen.MonitorCount, TScreen.Monitors[]

Browse Source 
win32, qt, gtk2: implement EnumDisplayMonitors, GetMonitorInfo

git-svn-id: trunk@19239 -
This commit is contained in:
paul 2009-04-06 08:14:58 +00:00
parent 78549425be
commit 3a19dfff75
14 changed files with 334 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
lcl/forms.pp
View File

@ -746,6 +746,43 @@ type
THintWindowClass = class of THintWindow;
{ TMonitor }
TMonitor = class(TObject)
private
FHandle: HMONITOR;
FMonitorNum: Integer;
function GetInfo(out Info: TMonitorInfo): Boolean; {inline; fpc bug - compilation error with inline}
function GetLeft: Integer;
function GetHeight: Integer;
function GetTop: Integer;
function GetWidth: Integer;
function GetBoundsRect: TRect;
function GetWorkareaRect: TRect;
function GetPrimary: Boolean;
public
property Handle: HMONITOR read FHandle;
property MonitorNum: Integer read FMonitorNum;
property Left: Integer read GetLeft;
property Height: Integer read GetHeight;
property Top: Integer read GetTop;
property Width: Integer read GetWidth;
property BoundsRect: TRect read GetBoundsRect;
property WorkareaRect: TRect read GetWorkareaRect;
property Primary: Boolean read GetPrimary;
end;
{ TMonitorList }
TMonitorList = class(TList)
private
function GetItem(AIndex: Integer): TMonitor;
procedure SetItem(AIndex: Integer; const AValue: TMonitor);
protected
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
public
property Items[AIndex: Integer]: TMonitor read GetItem write SetItem; default;
end;
{ TScreen }
@ -770,6 +807,7 @@ type
);
{ TScreen }
TScreen = class(TLCLComponent)
private
FActiveControl: TWinControl;
@ -789,12 +827,14 @@ type
FScreenHandlers: array[TScreenNotification] of TMethodList;
FLastActiveControl: TWinControl;
FLastActiveCustomForm: TCustomForm;
FMonitors: TMonitorList;
FOnActiveControlChange: TNotifyEvent;
FOnActiveFormChange: TNotifyEvent;
FPixelsPerInch : integer;
FSaveFocusedList: TList;
procedure DeleteCursor(AIndex: Integer);
procedure DestroyCursors;
procedure DestroyMonitors;
function GetCursors(AIndex: Integer): HCURSOR;
function GetCustomFormCount: Integer;
function GetCustomFormZOrderCount: Integer;
@ -808,12 +848,15 @@ type
function GetFormCount: Integer;
function GetForms(IIndex: Integer): TForm;
function GetHeight : Integer;
function GetMonitor(Index: Integer): TMonitor;
function GetMonitorCount: Integer;
function GetWidth : Integer;
procedure AddForm(AForm: TCustomForm);
procedure RemoveForm(AForm: TCustomForm);
procedure SetCursor(const AValue: TCursor);
procedure SetCursors(AIndex: Integer; const AValue: HCURSOR);
procedure UpdateLastActive;
procedure UpdateMonitors;
procedure RestoreLastActive;
procedure AddHandler(HandlerType: TScreenNotification;
const Handler: TMethod; AsLast: Boolean);
@ -880,6 +923,8 @@ type
property Fonts: TStrings read GetFonts;
property Height: Integer read Getheight;
property HintFont: TFont read GetHintFont;
property MonitorCount: Integer read GetMonitorCount;
property Monitors[Index: Integer]: TMonitor read GetMonitor;
property Width: Integer read GetWidth;
property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange
write FOnActiveControlChange;
@ -1627,7 +1672,10 @@ procedure FreeWidgetSet;
begin
//debugln('FreeWidgetSet');
if Screen <> nil then
begin
Screen.DestroyCursors;
Screen.DestroyMonitors;
end;
if Application=nil then exit;
Application.Free;
Application:=nil;
@ -1646,6 +1694,7 @@ end;
{$I customframe.inc}
{$I customform.inc}
{$I customdockform.inc}
{$I monitor.inc}
{$I screen.inc}
{$I application.inc}
{$I applicationproperties.inc}

18
lcl/include/intfbasewinapi.inc
View File

@ -84,8 +84,8 @@ begin
Result:=0;
end;
function TWidgetSet.ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean;
Begin
function TWidgetSet.ClientToScreen(Handle : HWND; var P : TPoint) : Boolean;
begin
Result := False;
end;
@ -714,17 +714,22 @@ begin
DebugLn('TWidgetSet.EnterCriticalSection Not implemented yet');
end;
function TWidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
begin
Result := False;
end;
function TWidgetSet.EnumFontFamilies(DC: HDC; Family: Pchar; EnumFontFamProc: FontEnumProc; LParam:Lparam):longint;
begin
DebugLn('EnumFontFamilies is not yet implemented for this widgetset');
result := 0;
Result := 0;
end;
function TWidgetSet.EnumFontFamiliesEx(DC: HDC; LpLogFont:PLogFont;
Callback: FontEnumExProc; Lparam:LParam; Flags: dword): longint;
begin
DebugLn('EnumFontFamiliesEx is not yet implemented for this widgetset');
result := 0;
Result := 0;
end;
function TWidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean;
@ -914,6 +919,11 @@ begin
Result := 0;
end;
function TWidgetset.GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
begin
Result := False;
end;
function TWidgetSet.GetObject(GDIObject: HGDIOBJ; BufSize: Integer;
Buf: Pointer): Integer;
begin

52
lcl/include/screen.inc
View File

@ -8,7 +8,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, *
@ -18,6 +18,19 @@
*****************************************************************************
}
function EnumMonitors(hMonitor: HMONITOR; hdcMonitor: HDC; lprcMonitor: PRect;
dwData: LPARAM): LongBool; stdcall;
var
Screen: TScreen absolute dwData;
Monitor: TMonitor;
begin
Monitor := TMonitor.Create;
Monitor.FHandle := hMonitor;
Monitor.FMonitorNum := Screen.FMonitors.Add(Monitor);
Result := True;
end;
{------------------------------------------------------------------------------
Method: TScreen.Create
Params: AOwner: the owner of the class
@ -30,16 +43,17 @@ begin
inherited Create(AOwner);
FFonts := TStringlist.Create;
FCursorMap := TMap.Create(its4, SizeOf(HCursor));
FMonitors := TMonitorList.Create;
TStringlist(FFonts).Sorted := True;
FCustomForms:=TList.Create;
FCustomFormsZOrdered:=TList.Create;
FCustomForms := TList.Create;
FCustomFormsZOrdered := TList.Create;
FFormList := TList.Create;
FDataModuleList := TList.Create;
FPixelsPerInch:= ScreenInfo.PixelsPerInchX;
FPixelsPerInch := ScreenInfo.PixelsPerInchX;
FSaveFocusedList := TList.Create;
AddDataModule:=@DoAddDataModule;
RemoveDataModule:=@DoRemoveDataModule;
AddDataModule := @DoAddDataModule;
RemoveDataModule := @DoRemoveDataModule;
end;
{------------------------------------------------------------------------------
@ -53,7 +67,7 @@ destructor TScreen.Destroy;
var
HandlerType: TScreenNotification;
begin
for HandlerType:=Low(FScreenHandlers) to High(FScreenHandlers) do
for HandlerType := Low(FScreenHandlers) to High(FScreenHandlers) do
FreeThenNil(FScreenHandlers[HandlerType]);
FreeThenNil(FHintFont);
FreeThenNil(FDataModuleList);
@ -64,6 +78,7 @@ begin
FreeThenNil(FFonts);
// DestroyCursors; - free on widgetset free
FCursorMap.Free;
FMonitors.Free;
inherited Destroy;
end;
@ -376,6 +391,11 @@ begin
FCursorMap.Clear;
end;
procedure TScreen.DestroyMonitors;
begin
FMonitors.Clear;
end;
{------------------------------------------------------------------------------
function TScreen.GetCursors(Index: Integer): HCURSOR;
------------------------------------------------------------------------------}
@ -519,6 +539,18 @@ begin
Result := GetSystemMetrics(SM_CYSCREEN);
end;
function TScreen.GetMonitor(Index: Integer): TMonitor;
begin
Result := FMonitors[Index];
end;
function TScreen.GetMonitorCount: Integer;
begin
if FMonitors.Count = 0 then
UpdateMonitors;
Result := FMonitors.Count;
end;
function TScreen.GetHintFont: TFont;
begin
if (FHintFont=nil) then
@ -633,6 +665,12 @@ begin
end;
end;
procedure TScreen.UpdateMonitors;
begin
DestroyMonitors;
EnumDisplayMonitors(0, nil, @EnumMonitors, LParam(Self));
end;
procedure TScreen.RestoreLastActive;
begin
if (FLastActiveControl <> nil) and FLastActiveControl.CanFocus then

12
lcl/include/winapi.inc
View File

@ -63,7 +63,7 @@ begin
Result := WidgetSet.CallWindowProc(lpPrevWndFunc, Handle, Msg, WParam, LParam);
end;
function ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean;
function ClientToScreen(Handle : HWND; var P : TPoint) : Boolean;
Begin
Result := WidgetSet.ClientToScreen(Handle, P);
end;
@ -236,6 +236,11 @@ begin
WidgetSet.EnterCriticalSection(CritSection);
end;
function EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
begin
Result := Widgetset.EnumDisplayMonitors(hdc, lprcClip, lpfnEnum, dwData);
end;
function EnumFontFamilies(DC: HDC; Family: Pchar;
EnumFontFamProc: FontEnumProc; LParam:Lparam):longint;
begin
@ -389,6 +394,11 @@ begin
Result := WidgetSet.GetKeyState(nVirtKey);
end;
function GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
begin
Result := Widgetset.GetMonitorInfo(hMonitor, lpmi);
end;
function GetObject(GDIObject: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer;
begin
Result := WidgetSet.GetObject(GDIObject, BufSize, Buf);

4
lcl/include/winapih.inc
View File

@ -47,7 +47,7 @@ function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSr
function CallNextHookEx(hhk : HHOOK; ncode : Integer; WParam: WParam; LParam: LParam) : Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; WParam: WParam; LParam: LParam): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function CharLowerBuff --> independent
function ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClientToScreen(Handle : HWND; var P : TPoint) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CombineRgn(Dest, Src1, Src2 : HRGN; fnCombineMode : Longint) : Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -90,6 +90,7 @@ function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; {$IFD
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure EnterCriticalSection(var CritSection: TCriticalSection); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function EnumFontFamilies(DC: HDC; Family: Pchar; EnumFontFamProc: FontEnumProc; LParam:Lparam):longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function EnumFontFamiliesEx(DC: HDC; lpLogFont:PLogFont; Callback: FontEnumExProc; Lparam:LParam; Flags: dword): longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -124,6 +125,7 @@ function GetFocus: HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetFontLanguageInfo(DC: HDC): DWord; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetForegroundWindow: HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetKeyState(nVirtKey: Integer): Smallint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetObject(GDIObject: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetPaletteEntries(Palette: HPALETTE; StartIndex, NumEntries: UINT;
var PaletteEntries): UINT; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}

29
lcl/interfaces/gtk2/gtk2winapi.inc
View File

@ -17,7 +17,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, *
@ -352,6 +352,15 @@ begin
result := Inherited EndPaint(Handle, PS);
end;
function TGtk2WidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect;
lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
var
i: integer;
begin
for i := 0 to gdk_screen_get_n_monitors(gdk_screen_get_default) - 1 do
lpfnEnum(i, 0, nil, dwData);
end;
{------------------------------------------------------------------------------
Function: ExtTextOut
Params: none
@ -490,6 +499,24 @@ begin
Result := True;
end;
function TGtk2WidgetSet.GetMonitorInfo(Monitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
var
MonitorRect: TGdkRectangle;
begin
Result := (lpmi <> nil) and (lpmi^.cbSize >= SizeOf(TMonitorInfo));
if not Result then Exit;
gdk_screen_get_monitor_geometry(gdk_screen_get_default, Monitor, @MonitorRect);
with MonitorRect do
lpmi^.rcMonitor := Bounds(x, y, width, height);
// there is no way to determine workarea in gtk
lpmi^.rcWork := lpmi^.rcMonitor;
// gtk uses zero position for primary monitor
if Monitor = 0 then
lpmi^.dwFlags := MONITORINFOF_PRIMARY
else
lpmi^.dwFlags := 0;
end;
{------------------------------------------------------------------------------
function TGtk2WidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar;
Count: Integer; var Size: TSize): Boolean;

4
lcl/interfaces/gtk2/gtk2winapih.inc
View File

@ -21,7 +21,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, *
@ -40,9 +40,11 @@ function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;
function DestroyIcon(Handle: HICON): Boolean; override;
function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; override;
function EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool; override;
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
function GetCursorPos(var lpPoint: TPoint ): Boolean; override;
function GetMonitorInfo(Monitor: HMONITOR; lpmi: PMonitorInfo): Boolean; override;
function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; override;
function SetCursorPos(X, Y: Integer): Boolean; override;

2
lcl/interfaces/gtk2/gtk2wsextctrls.pp
View File

@ -30,7 +30,7 @@ interface
uses
// libs
Math, GLib2, Gtk2, Gdk2, Gdk2Pixbuf, Gtk2Int, GtkProc, GtkDef,
Math, GLib2, Gtk2, Gtk2Ext, Gdk2, Gdk2Pixbuf, Gtk2Int, GtkProc, GtkDef,
// LCL
LCLProc, ExtCtrls, Classes, Controls, SysUtils, LCLType,
// widgetset

39
lcl/interfaces/qt/qtwinapi.inc
View File

@ -1324,6 +1324,18 @@ begin
System.EnterCriticalsection(ACritSec^);
end;
function TQtWidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect;
lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
var
i: integer;
Desktop: QDesktopWidgetH;
begin
Desktop := QApplication_desktop();
for i := 0 to QDesktopWidget_numScreens(Desktop) - 1 do
lpfnEnum(HMONITOR(QDesktopWidget_screen(Desktop, i)), 0, nil, dwData);
Result := True;
end;
{------------------------------------------------------------------------------
Function: EnumFontFamiliesEx
@ -2227,6 +2239,33 @@ begin
end;
end;
function TQtWidgetSet.GetMonitorInfo(Monitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
var
Desktop: QDesktopWidgetH;
i: integer;
Screen: QWidgetH;
begin
Result := (lpmi <> nil) and (lpmi^.cbSize >= SizeOf(TMonitorInfo));
if not Result then Exit;
Result := False;
Desktop := QApplication_desktop();
for i := 0 to QDesktopWidget_numScreens(Desktop) - 1 do
begin
Screen := QDesktopWidget_screen(Desktop, i);
if HMONITOR(Screen) = Monitor then
begin
QDesktopWidget_screenGeometry(Desktop, @lpmi^.rcMonitor, i);
QDesktopWidget_availableGeometry(Desktop, @lpmi^.rcWork, i);
if QDesktopWidget_primaryScreen(Desktop) = i then
lpmi^.dwFlags := MONITORINFOF_PRIMARY
else
lpmi^.dwFlags := 0;
Result := True;
break;
end;
end;
end;
{------------------------------------------------------------------------------
Method: TQtWidgetSet.GetDeviceSize
Params: none

2
lcl/interfaces/qt/qtwinapih.inc
View File

@ -78,6 +78,7 @@ function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; overr
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; override;
function EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer; override;
procedure EnterCriticalSection(var CritSection: TCriticalSection); override;
function EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool; override;
function EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint; override;
function ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer; override;
function ExtCreatePen(dwPenStyle, dwWidth: DWord; const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN; override;
@ -107,6 +108,7 @@ function GetDeviceSize(DC: HDC; var P: TPoint): Boolean; Override;
function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; Override;
function GetFocus: HWND; override;
function GetKeyState(nVirtKey: Integer): Smallint; override;
function GetMonitorInfo(Monitor: HMONITOR; lpmi: PMonitorInfo): Boolean; override;
function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; override;
function GetParent(Handle : HWND): HWND; override;
function GetProp(Handle : hwnd; Str : PChar): Pointer; override;

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

@ -384,6 +384,9 @@ const
var
AlphaBlend: function(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;
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;
const
// ComCtlVersions
@ -437,7 +440,6 @@ function GetOpenFileName(_para1:LPOPENFILENAME):WINBOOL; stdcall; external 'comd
function GetSaveFileName(_para1:LPOPENFILENAME):WINBOOL; stdcall; external 'comdlg32' name 'GetSaveFileNameA';
function GetFileVersion(FileName: string): dword;
{$endif}
implementation
@ -445,6 +447,10 @@ implementation
uses
Win32Proc;
const
xPRIMARY_MONITOR = $12340042;
{$PACKRECORDS NORMAL}
{$ifdef VER2_0}
@ -885,6 +891,77 @@ begin
end;
end;
function _EnumDisplayMonitors(hdcOptionalForPainting: HDC;
lprcEnumMonitorsThatIntersect: PRect;
lpfnEnumProc: MonitorEnumProc;
dwData: LPARAM): LongBool; stdcall;
var
rcLimit, rcClip: TRect;
ptOrg: TPoint;
Cb: Integer;
begin
// from MultiMon.h
rcLimit.left := 0;
rcLimit.top := 0;
rcLimit.right := GetSystemMetrics(SM_CXSCREEN);
rcLimit.bottom := GetSystemMetrics(SM_CYSCREEN);
if (hdcOptionalForPainting <> 0) then
begin
Cb := GetClipBox(hdcOptionalForPainting, @rcClip);
if not GetDCOrgEx(hdcOptionalForPainting, @ptOrg) then
Exit(False);
OffsetRect(rcLimit, -ptOrg.x, -ptOrg.y);
if (IntersectRect(rcLimit, rcLimit, rcClip) and
((lprcEnumMonitorsThatIntersect = nil) or
IntersectRect(rcLimit, rcLimit, lprcEnumMonitorsThatIntersect^))) then
begin
if Cb = NULLREGION then
Exit(True)
else
if Cb = ERROR then
Exit(False);
end
end
else
if ((lprcEnumMonitorsThatIntersect <> nil) and
not IntersectRect(rcLimit, rcLimit, lprcEnumMonitorsThatIntersect^)) then
Exit(True);
Result := lpfnEnumProc(
xPRIMARY_MONITOR,
hdcOptionalForPainting,
@rcLimit,
dwData);
end;
function _GetMonitorInfo(hMonitor: HMONITOR; lpMonitorInfo: PMonitorInfo): Boolean; stdcall;
var
rcWork: TRect;
begin
// from MultiMon.h
if ((hMonitor = xPRIMARY_MONITOR) and
(lpMonitorInfo <> nil) and
(lpMonitorInfo^.cbSize >= sizeof(TMonitorInfo)) and
SystemParametersInfo(SPI_GETWORKAREA, 0, @rcWork, 0)) then
begin
lpMonitorInfo^.rcMonitor.left := 0;
lpMonitorInfo^.rcMonitor.top := 0;
lpMonitorInfo^.rcMonitor.right := GetSystemMetrics(SM_CXSCREEN);
lpMonitorInfo^.rcMonitor.bottom := GetSystemMetrics(SM_CYSCREEN);
lpMonitorInfo^.rcWork := rcWork;
lpMonitorInfo^.dwFlags := MONITORINFOF_PRIMARY;
if (lpMonitorInfo^.cbSize >= sizeof(TMonitorInfoEx)) then
PMonitorInfoEx(lpMonitorInfo)^.szDevice := 'DISPLAY';
Exit(True);
end;
Result := False;
end;
const
msimg32lib = 'msimg32.dll';
@ -930,6 +1007,23 @@ begin
Pointer(GetComboboxInfo) := p
else
Pointer(GetComboboxInfo) := @_GetComboboxInfo;
p := GetProcAddress(user32handle, 'EnumDisplayMonitors');
if p <> nil then
Pointer(EnumDisplayMonitors) := p
else
Pointer(EnumDisplayMonitors) := @_EnumDisplayMonitors;
{$IFDEF WindowsUnicodeSupport}
if UnicodeEnabledOS then
p := GetProcAddress(user32handle, 'GetMonitorInfoW')
else
p := GetProcAddress(user32handle, 'GetMonitorInfoA');
{$ELSE}
p := GetProcAddress(user32handle, 'GetMonitorInfoA');
{$ENDIF}
if p <> nil then
Pointer(GetMonitorInfo) := p
else
Pointer(GetMonitorInfo) := @_GetMonitorInfo;
end;
end;

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

@ -34,8 +34,8 @@
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
Const
BOOL_TEXT: Array[Boolean] Of String = ('False', 'True');
const
BOOL_TEXT: array[Boolean] of string = ('False', 'True');
//##apiwiz##sps## // Do not remove
@ -1340,6 +1340,11 @@ begin
Result := Integer(Windows.EndPaint(Handle, @PS));
end;
function TWin32WidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
begin
Result := Win32Extra.EnumDisplayMonitors(hdc, lprcClip, lpfnEnum, dwData);
end;
function TWin32WidgetSet.EnumFontFamilies(DC: HDC; Family: Pchar;
EnumFontFamProc: FontEnumProc; LParam: Lparam): longint;
begin
@ -1950,6 +1955,11 @@ begin
Result := Windows.GetKeyState(nVirtKey);
end;
function TWin32WidgetSet.GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
begin
Result := Win32Extra.GetMonitorInfo(hMonitor, lpmi);
end;
{------------------------------------------------------------------------------
Method: GetObject
Params: GDIObj - handle to graphics object of interest

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

@ -76,6 +76,7 @@ function EmptyClipBoard: Boolean;
function EnableScrollBar(Wnd: HWND; WSBFlags, WArrows: Cardinal): Boolean; override;
function EnableWindow(HWnd: HWND; BEnable: Boolean): Boolean; override;
function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; override;
function EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool; override;
function EnumFontFamilies(DC: HDC; Family:Pchar; EnumFontFamProc: FontEnumProc; LParam:Lparam):longint; override;
function EnumFontFamiliesEx(DC:HDC; lpLogFont:PLogFont; Callback: FontEnumExProc; LParam:Lparam; flags:dword):longint; override;
function ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer; override;
@ -108,6 +109,7 @@ function GetBitmapBits(Bitmap: HBITMAP; Count: Longint; Bits: Pointer): Longint
function GetFocus: HWND; override;
function GetForegroundWindow: HWND; override;
function GetKeyState(NVirtKey: Integer): SmallInt; override;
function GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean; override;
function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; override;
function GetParent(Handle: HWND): HWND; override;
function GetProp(Handle: HWND; Str: PChar): Pointer; override;

31
lcl/lcltype.pp
View File

@ -95,6 +95,7 @@ type
HBITMAP = type THandle;
HPALETTE = type THandle;
HBRUSH = type THandle;
HMONITOR = type THandle;
Bool = LongBool;
Short = SmallInt;
@ -124,8 +125,8 @@ type
HMENU = Windows.HMENU;
HBITMAP = Windows.HBITMAP;
HPALETTE = Windows.HPALETTE;
HBRUSH = Windows.HBRUSH;
HMONITOR = Windows.HANDLE; // define as Windows.HMONITOR when fpc have it
WPARAM = Windows.WPARAM;
LPARAM = Windows.LPARAM;
@ -859,6 +860,31 @@ type
Initialized: boolean;
end;
{ monitor support }
const
MONITORINFOF_PRIMARY = $00000001;
CCHDEVICENAME = 32;
type
tagMonitorInfo = record
cbSize: DWord;
rcMonitor: TRect;
rcWork: TRect;
dwFlags: DWord;
end;
PMonitorInfo = ^TMonitorInfo;
TMonitorInfo = tagMonitorInfo;
tagMonitorInfoEx = record
cbSize: DWord;
rcMonitor: TRect;
rcWork: TRect;
dwFlags: DWord;
szDevice: array[0..CCHDEVICENAME - 1] of Char;
end;
PMonitorInfoEx = ^TMonitorInfoEx;
TMonitorInfoEx = tagMonitorInfoEx;
{painting stuff}
PDrawItemStruct = ^TDrawItemStruct;
@ -2158,6 +2184,9 @@ type
FontEnumExProc = function (var ELogFont: TEnumLogFontEx; var Metric: TNewTextMetricEx;
FontType: Longint; Data:LParam):Longint; stdcall;
MonitorEnumProc = function(hMonitor: HMONITOR; hdcMonitor: HDC; lprcMonitor: PRect;
dwData: LPARAM): LongBool; stdcall;
PWndClassExA = ^TWndClassExA;
PWndClassExW = ^TWndClassExW;
PWndClassEx = PWndClassExA;