diff --git a/lcl/forms.pp b/lcl/forms.pp index 893a3c2408..09015b9d5d 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -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} diff --git a/lcl/include/intfbasewinapi.inc b/lcl/include/intfbasewinapi.inc index e949485b4c..abfda90eee 100644 --- a/lcl/include/intfbasewinapi.inc +++ b/lcl/include/intfbasewinapi.inc @@ -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 diff --git a/lcl/include/screen.inc b/lcl/include/screen.inc index f264e8877b..43faabb799 100644 --- a/lcl/include/screen.inc +++ b/lcl/include/screen.inc @@ -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 diff --git a/lcl/include/winapi.inc b/lcl/include/winapi.inc index c21430a6ba..e3f36e274b 100644 --- a/lcl/include/winapi.inc +++ b/lcl/include/winapi.inc @@ -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); diff --git a/lcl/include/winapih.inc b/lcl/include/winapih.inc index 5c67002df0..a8bb0d7df2 100644 --- a/lcl/include/winapih.inc +++ b/lcl/include/winapih.inc @@ -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} diff --git a/lcl/interfaces/gtk2/gtk2winapi.inc b/lcl/interfaces/gtk2/gtk2winapi.inc index 5e4e1d05d2..b9e35e8962 100644 --- a/lcl/interfaces/gtk2/gtk2winapi.inc +++ b/lcl/interfaces/gtk2/gtk2winapi.inc @@ -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; diff --git a/lcl/interfaces/gtk2/gtk2winapih.inc b/lcl/interfaces/gtk2/gtk2winapih.inc index ae0b1ea95c..11fe547ac6 100644 --- a/lcl/interfaces/gtk2/gtk2winapih.inc +++ b/lcl/interfaces/gtk2/gtk2winapih.inc @@ -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; diff --git a/lcl/interfaces/gtk2/gtk2wsextctrls.pp b/lcl/interfaces/gtk2/gtk2wsextctrls.pp index 8f969e75f6..f382755ff1 100644 --- a/lcl/interfaces/gtk2/gtk2wsextctrls.pp +++ b/lcl/interfaces/gtk2/gtk2wsextctrls.pp @@ -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 diff --git a/lcl/interfaces/qt/qtwinapi.inc b/lcl/interfaces/qt/qtwinapi.inc index 6ce9ff1eff..07580bc09d 100644 --- a/lcl/interfaces/qt/qtwinapi.inc +++ b/lcl/interfaces/qt/qtwinapi.inc @@ -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 diff --git a/lcl/interfaces/qt/qtwinapih.inc b/lcl/interfaces/qt/qtwinapih.inc index 8b69feb571..a9f9aab718 100644 --- a/lcl/interfaces/qt/qtwinapih.inc +++ b/lcl/interfaces/qt/qtwinapih.inc @@ -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; diff --git a/lcl/interfaces/win32/win32extra.pas b/lcl/interfaces/win32/win32extra.pas index c5a95c5042..5073e80c5d 100644 --- a/lcl/interfaces/win32/win32extra.pas +++ b/lcl/interfaces/win32/win32extra.pas @@ -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; diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index f885d15817..2522ee1174 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -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 diff --git a/lcl/interfaces/win32/win32winapih.inc b/lcl/interfaces/win32/win32winapih.inc index 0b5558a765..9ea8d15cc0 100644 --- a/lcl/interfaces/win32/win32winapih.inc +++ b/lcl/interfaces/win32/win32winapih.inc @@ -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; diff --git a/lcl/lcltype.pp b/lcl/lcltype.pp index 25232cc1fb..2f4c391442 100644 --- a/lcl/lcltype.pp +++ b/lcl/lcltype.pp @@ -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;