View Issue Details

IDProjectCategoryView StatusLast Update
0019379PatchesLCLpublic2020-01-12 17:18
Reporterwovan.bugger Assigned ToFelipe Monteiro de Carvalho  
PrioritynormalSeverityfeatureReproducibilityalways
Status resolvedResolutionfixed 
Product Version0.9.31 (SVN) 
Summary0019379: TScreen - missing properties (delphi compat.)
DescriptionI added some missing properties to TScreen implementation 4 win32 + workaround 4 other widgets (i don't know if they have same capabilities).

!May be a call to

    SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);

should be placed somewhere else into "winapih.inc" or wherever is most satisfies your conception.
Additional InformationTScreen = class ()
+
 private
    function GetDesktopLeft: Integer;
    function GetDesktopRect: TRect;
    function GetDesktopTop: Integer;
    function GetWorkAreaHeight: Integer;
    function GetWorkAreaLeft: Integer;
    function GetWorkAreaRect: TRect;
    function GetWorkAreaTop: Integer;
    function GetWorkAreaWidth: Integer;
  public
    property DesktopLeft: Integer read GetDesktopLeft;
    property DesktopTop: Integer read GetDesktopTop;
    property DesktopRect: TRect read GetDesktopRect;
    property WorkAreaRect: TRect read GetWorkAreaRect;
    property WorkAreaHeight: Integer read GetWorkAreaHeight;
    property WorkAreaLeft: Integer read GetWorkAreaLeft;
    property WorkAreaTop: Integer read GetWorkAreaTop;
    property WorkAreaWidth: Integer read GetWorkAreaWidth;

implementation
+
function TScreen.GetDesktopLeft: Integer;
begin
  {$IFDEF WINDOWS}
    Result := GetSystemMetrics(SM_XVIRTUALSCREEN);
  {$ELSE}
    Result:=0;
  {$ENDIF}
end;

function TScreen.GetDesktopRect: TRect;
begin
  Result := Bounds(DesktopLeft, DesktopTop, DesktopWidth, DesktopHeight);
end;

function TScreen.GetDesktopTop: Integer;
begin
  {$IFDEF WINDOWS}
    Result := GetSystemMetrics(SM_YVIRTUALSCREEN);
  {$ELSE}
    Result:=0;
  {$ENDIF}
end;

function TScreen.GetWorkAreaHeight: Integer;
begin
  with WorkAreaRect do Result := Bottom - Top;
end;

function TScreen.GetWorkAreaLeft: Integer;
begin
  Result := WorkAreaRect.Left;
end;

function TScreen.GetWorkAreaRect: TRect;
begin
  {$IFDEF WINDOWS}
    SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
  {$ELSE}
    Result:=DesktopRect;
  {$ENDIF}
end;

function TScreen.GetWorkAreaTop: Integer;
begin
  Result := WorkAreaRect.Top;
end;

function TScreen.GetWorkAreaWidth: Integer;
begin
  with WorkAreaRect do Result := Right - Left;
end;

TagsNo tags attached.
Fixed in Revision31339
LazTarget-
WidgetsetWin32/Win64
Attached Files

Activities

wovan.bugger

2011-05-27 05:27

reporter   ~0048633

Add this code please

Felipe Monteiro de Carvalho

2011-05-27 15:51

developer   ~0048649

Please create a proper patch against svn lazarus. There are instructions here: http://wiki.freepascal.org/Creating_A_Patch

Felipe Monteiro de Carvalho

2011-05-27 15:54

developer   ~0048650

Ah, and your code needs improvements before it can be applied. Acording to the Lazarus design you need to add platform-dependent code in a different way.

You don't need:

  {$IFDEF WINDOWS}
     Result := GetSystemMetrics(SM_XVIRTUALSCREEN);
   {$ELSE}
     Result:=0;
   {$ENDIF}

You can simply use:

Result := LCLIntf.GetSystemMetrics(SM_XVIRTUALSCREEN);

There is also LCLIntf.SystemParametersInfo

Felipe Monteiro de Carvalho

2011-05-27 15:55

developer   ~0048651

It can be instructive to read this page: http://wiki.freepascal.org/LCL_Internals

2011-05-27 20:43

 

TScreen_NEW_Properties.patch (3,903 bytes)   
Index: lcl/forms.pp
===================================================================
--- lcl/forms.pp	(revision 30933)
+++ lcl/forms.pp	(working copy)
@@ -943,8 +943,11 @@
     function GetCustomFormsZOrdered(Index: Integer): TCustomForm;
     function GetDataModuleCount: Integer;
     function GetDataModules(AIndex: Integer): TDataModule;
+    function GetDesktopLeft: Integer;
+    function GetDesktopTop: Integer;
     function GetDesktopHeight: Integer;
     function GetDesktopWidth: Integer;
+    function GetDesktopRect: TRect;
     function GetFonts : TStrings;
     function GetFormCount: Integer;
     function GetForms(IIndex: Integer): TForm;
@@ -973,6 +976,11 @@
     procedure DoRemoveDataModule(DataModule: TDataModule);
     procedure NotifyScreenFormHandler(HandlerType: TScreenNotification;
                                       Form: TCustomForm);
+    function GetWorkAreaHeight: Integer;
+    function GetWorkAreaLeft: Integer;
+    function GetWorkAreaRect: TRect;
+    function GetWorkAreaTop: Integer;
+    function GetWorkAreaWidth: Integer;
   protected
     function GetHintFont: TFont; virtual;
     function GetIconFont: TFont; virtual;
@@ -1033,8 +1041,11 @@
     property CustomFormZOrderCount: Integer read GetCustomFormZOrderCount;
     property CustomFormsZOrdered[Index: Integer]: TCustomForm
                                read GetCustomFormsZOrdered; // lower index means on top
+    property DesktopLeft: Integer read GetDesktopLeft;
+    property DesktopTop: Integer read GetDesktopTop;
     property DesktopHeight: Integer read GetDesktopHeight;
     property DesktopWidth: Integer read GetDesktopWidth;
+    property DesktopRect: TRect read GetDesktopRect;
     property FocusedForm: TCustomForm read FFocusedForm;
     property FormCount: Integer read GetFormCount;
     property Forms[Index: Integer]: TForm read GetForms;
@@ -1053,6 +1064,11 @@
     property PixelsPerInch: integer read FPixelsPerInch;
     property PrimaryMonitor: TMonitor read GetPrimaryMonitor;
     property Width: Integer read GetWidth;
+    property WorkAreaRect: TRect read GetWorkAreaRect;
+    property WorkAreaHeight: Integer read GetWorkAreaHeight;
+    property WorkAreaLeft: Integer read GetWorkAreaLeft;
+    property WorkAreaTop: Integer read GetWorkAreaTop;
+    property WorkAreaWidth: Integer read GetWorkAreaWidth;
     property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange
                                                  write FOnActiveControlChange;
     property OnActiveFormChange: TNotifyEvent read FOnActiveFormChange
Index: lcl/include/screen.inc
===================================================================
--- lcl/include/screen.inc	(revision 30933)
+++ lcl/include/screen.inc	(working copy)
@@ -644,6 +644,51 @@
   Result := TDataModule(FDataModuleList.Items[AIndex]);
 end;
 
+function TScreen.GetDesktopLeft: Integer;
+begin
+  Result := GetSystemMetrics(SM_XVIRTUALSCREEN);  
+end;
+
+function TScreen.GetDesktopRect: TRect;
+begin
+  Result := Bounds(DesktopLeft, DesktopTop, DesktopWidth, DesktopHeight);
+end;
+
+function TScreen.GetDesktopTop: Integer;
+begin
+  Result := GetSystemMetrics(SM_YVIRTUALSCREEN);  
+end;
+
+function TScreen.GetWorkAreaHeight: Integer;
+begin
+  with WorkAreaRect do Result := Bottom - Top;
+end;
+
+function TScreen.GetWorkAreaLeft: Integer;
+begin
+  Result := WorkAreaRect.Left;
+end;
+
+function TScreen.GetWorkAreaRect: TRect;
+begin
+  {$IFDEF WINDOWS}
+    SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
+  {$ELSE}
+    Result:=DesktopRect;
+  {$ENDIF}
+end;
+
+function TScreen.GetWorkAreaTop: Integer;
+begin
+  Result := WorkAreaRect.Top;
+end;
+
+function TScreen.GetWorkAreaWidth: Integer;
+begin
+  with WorkAreaRect do Result := Right - Left;
+end;
+
+
 function TScreen.GetDesktopHeight: Integer;
 begin
   Result := GetSystemMetrics(SM_CYVIRTUALSCREEN);
TScreen_NEW_Properties.patch (3,903 bytes)   

wovan.bugger

2011-05-27 20:46

reporter   ~0048659

ok, I've attached the patch (see above) TScreen_NEW_Properties.patch

LCLIntf.SystemParametersInfo - doesn't work at least on mac, so I left this part untouched.

Felipe Monteiro de Carvalho

2011-05-29 08:28

developer   ~0048697

Hello,

Please change that part too.

The LCL is structured so that you should implement platform-dependent code in the widgetsets, not in the LCL. The LCL just calls LCLIntf.SystemParametersInfo and if it doesn't work, then you need to fix that call in the following file:

lazarus/lcl/interfaces/carbon/carbonwinapi.pas (or similar name)

And similarly for each widgetset.

Also, what does DesktopRect and WorkArea mean exactly? DesktopRect is the rectangle around all monitors? WorkArea is the current monitor minus taskbar?

2011-06-19 16:59

 

TScreen_NEW_Properties_v2.patch (11,989 bytes)   
Index: lcl/forms.pp
===================================================================
--- lcl/forms.pp	(revision 31285)
+++ lcl/forms.pp	(working copy)
@@ -943,8 +943,11 @@
     function GetCustomFormsZOrdered(Index: Integer): TCustomForm;
     function GetDataModuleCount: Integer;
     function GetDataModules(AIndex: Integer): TDataModule;
+    function GetDesktopLeft: Integer;
+    function GetDesktopTop: Integer;
     function GetDesktopHeight: Integer;
     function GetDesktopWidth: Integer;
+    function GetDesktopRect: TRect;
     function GetFonts : TStrings;
     function GetFormCount: Integer;
     function GetForms(IIndex: Integer): TForm;
@@ -973,6 +976,11 @@
     procedure DoRemoveDataModule(DataModule: TDataModule);
     procedure NotifyScreenFormHandler(HandlerType: TScreenNotification;
                                       Form: TCustomForm);
+    function GetWorkAreaHeight: Integer;
+    function GetWorkAreaLeft: Integer;
+    function GetWorkAreaRect: TRect;
+    function GetWorkAreaTop: Integer;
+    function GetWorkAreaWidth: Integer;
   protected
     function GetHintFont: TFont; virtual;
     function GetIconFont: TFont; virtual;
@@ -1033,8 +1041,12 @@
     property CustomFormZOrderCount: Integer read GetCustomFormZOrderCount;
     property CustomFormsZOrdered[Index: Integer]: TCustomForm
                                read GetCustomFormsZOrdered; // lower index means on top
+    property DesktopLeft: Integer read GetDesktopLeft;
+    property DesktopTop: Integer read GetDesktopTop;
+
     property DesktopHeight: Integer read GetDesktopHeight;
     property DesktopWidth: Integer read GetDesktopWidth;
+    property DesktopRect: TRect read GetDesktopRect;
     property FocusedForm: TCustomForm read FFocusedForm;
     property FormCount: Integer read GetFormCount;
     property Forms[Index: Integer]: TForm read GetForms;
@@ -1053,6 +1065,11 @@
     property PixelsPerInch: integer read FPixelsPerInch;
     property PrimaryMonitor: TMonitor read GetPrimaryMonitor;
     property Width: Integer read GetWidth;
+    property WorkAreaRect: TRect read GetWorkAreaRect;
+    property WorkAreaHeight: Integer read GetWorkAreaHeight;
+    property WorkAreaLeft: Integer read GetWorkAreaLeft;
+    property WorkAreaTop: Integer read GetWorkAreaTop;
+    property WorkAreaWidth: Integer read GetWorkAreaWidth;
     property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange
                                                  write FOnActiveControlChange;
     property OnActiveFormChange: TNotifyEvent read FOnActiveFormChange
Index: lcl/include/screen.inc
===================================================================
--- lcl/include/screen.inc	(revision 31285)
+++ lcl/include/screen.inc	(working copy)
@@ -654,6 +654,48 @@
   Result := GetSystemMetrics(SM_CXVIRTUALSCREEN);
 end;
 
+function TScreen.GetDesktopLeft: Integer;
+begin
+  Result := GetSystemMetrics(SM_XVIRTUALSCREEN);  
+end;
+
+function TScreen.GetDesktopRect: TRect;
+begin
+  Result := Bounds(DesktopLeft, DesktopTop, DesktopWidth, DesktopHeight);
+end;
+
+function TScreen.GetDesktopTop: Integer;
+begin
+  Result := GetSystemMetrics(SM_YVIRTUALSCREEN);  
+end;
+
+function TScreen.GetWorkAreaLeft: Integer;
+begin
+  Result := WorkAreaRect.Left;
+end;
+
+function TScreen.GetWorkAreaRect: TRect;
+begin
+  SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
+end;
+
+function TScreen.GetWorkAreaTop: Integer;
+begin
+  Result := WorkAreaRect.Top;
+end;
+
+function TScreen.GetWorkAreaHeight: Integer;
+begin
+  with WorkAreaRect do Result := Bottom - Top;
+end;
+
+function TScreen.GetWorkAreaWidth: Integer;
+begin
+  with WorkAreaRect do Result := Right - Left;
+end;
+
+
+
 {------------------------------------------------------------------------------
   Function: TScreen.AddForm
   Params:   FForm: The form to be added
Index: lcl/interfaces/carbon/carbonwinapi.inc
===================================================================
--- lcl/interfaces/carbon/carbonwinapi.inc	(revision 31285)
+++ lcl/interfaces/carbon/carbonwinapi.inc	(working copy)
@@ -3616,6 +3616,25 @@
     TCarbonBitmap(Mask), XMask, YMask, Rop);
 end;
 
+function TCarbonWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
+  pvParam: Pointer; fWinIni: DWord): LongBool;
+begin
+  Result:=False;
+  Case uiAction of
+    SPI_GETWORKAREA: begin
+      with TRect(pvParam^) do
+      begin
+        Top:=    GetSystemMetrics(SM_YVIRTUALSCREEN);
+        Left:=   GetSystemMetrics(SM_XVIRTUALSCREEN);
+        Bottom:= GetSystemMetrics(SM_CYVIRTUALSCREEN);
+        Right:=  GetSystemMetrics(SM_CXVIRTUALSCREEN);
+      end;
+      Result:=True;
+    end;
+  end;
+end;
+
+
 {------------------------------------------------------------------------------
   Method:  TextOut
   Params:  DC    - Handle of the device context
Index: lcl/interfaces/carbon/carbonwinapih.inc
===================================================================
--- lcl/interfaces/carbon/carbonwinapih.inc	(revision 31285)
+++ lcl/interfaces/carbon/carbonwinapih.inc	(working copy)
@@ -217,7 +217,7 @@
 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
 function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
 function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
-
+function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
 function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
 function UpdateWindow(Handle: HWND): Boolean; override;
 function WindowFromPoint(Point : TPoint) : HWND; override;
Index: lcl/interfaces/gtk2/gtk2winapi.inc
===================================================================
--- lcl/interfaces/gtk2/gtk2winapi.inc	(revision 31285)
+++ lcl/interfaces/gtk2/gtk2winapi.inc	(working copy)
@@ -9106,6 +9106,24 @@
                           Rop);
 end;
 
+function TGtk2WidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
+  pvParam: Pointer; fWinIni: DWord): LongBool;
+begin
+  Result:=False;
+   Case uiAction of
+     SPI_GETWORKAREA: begin
+       with TRect(pvParam^) do
+       begin
+         Top:=    GetSystemMetrics(SM_YVIRTUALSCREEN);
+         Left:=   GetSystemMetrics(SM_XVIRTUALSCREEN);
+         Bottom:= GetSystemMetrics(SM_CYVIRTUALSCREEN);
+         Right:=  GetSystemMetrics(SM_CXVIRTUALSCREEN);
+       end;
+       Result:=True;
+     end;
+   end;
+end;
+
 {------------------------------------------------------------------------------
   Function: TextOut
   Params: DC:
Index: lcl/interfaces/gtk2/gtk2winapih.inc
===================================================================
--- lcl/interfaces/gtk2/gtk2winapih.inc	(revision 31285)
+++ lcl/interfaces/gtk2/gtk2winapih.inc	(working copy)
@@ -231,7 +231,7 @@
 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
 function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
 function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
-
+function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
 function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
 
 function UpdateWindow(Handle: HWND): Boolean; override;
Index: lcl/interfaces/gtk/gtkwinapi.inc
===================================================================
--- lcl/interfaces/gtk/gtkwinapi.inc	(revision 31285)
+++ lcl/interfaces/gtk/gtkwinapi.inc	(working copy)
@@ -9776,6 +9776,25 @@
                           Rop);
 end;
 
+function TGTKWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
+  pvParam: Pointer; fWinIni: DWord): LongBool;
+begin
+  Result:=False;
+     Case uiAction of
+       SPI_GETWORKAREA: begin
+         with TRect(pvParam^) do
+         begin
+           Top:=    GetSystemMetrics(SM_YVIRTUALSCREEN);
+           Left:=   GetSystemMetrics(SM_XVIRTUALSCREEN);
+           Bottom:= GetSystemMetrics(SM_CYVIRTUALSCREEN);
+           Right:=  GetSystemMetrics(SM_CXVIRTUALSCREEN);
+         end;
+         Result:=True;
+       end;
+     end;
+end;
+
+
 {------------------------------------------------------------------------------
   Function: TextOut
   Params: DC:
Index: lcl/interfaces/gtk/gtkwinapih.inc
===================================================================
--- lcl/interfaces/gtk/gtkwinapih.inc	(revision 31285)
+++ lcl/interfaces/gtk/gtkwinapih.inc	(working copy)
@@ -215,7 +215,7 @@
 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
 function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
 function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
-
+function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
 function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
 
 function WindowFromPoint(APoint: TPoint): HWND; override;
Index: lcl/interfaces/qt/qtwinapi.inc
===================================================================
--- lcl/interfaces/qt/qtwinapi.inc	(revision 31285)
+++ lcl/interfaces/qt/qtwinapi.inc	(working copy)
@@ -5790,6 +5790,16 @@
 begin
   case uiAction of
     SPI_GETWHEELSCROLLLINES: PDword(pvPAram)^ := QApplication_wheelScrollLines;
+    SPI_GETWORKAREA: begin
+         with TRect(pvParam^) do
+         begin
+           Top:=    GetSystemMetrics(SM_YVIRTUALSCREEN);
+           Left:=   GetSystemMetrics(SM_XVIRTUALSCREEN);
+           Bottom:= GetSystemMetrics(SM_CYVIRTUALSCREEN);
+           Right:=  GetSystemMetrics(SM_CXVIRTUALSCREEN);
+         end;
+         Result:=True;
+       end;
   else
     Result := False;
   end
Index: lcl/interfaces/wince/wincewinapi.inc
===================================================================
--- lcl/interfaces/wince/wincewinapi.inc	(revision 31285)
+++ lcl/interfaces/wince/wincewinapi.inc	(working copy)
@@ -3534,6 +3534,12 @@
   Result := true;
 end;
 
+function TWinCEWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
+  pvParam: Pointer; fWinIni: DWord): LongBool;
+begin
+  Result := Windows.SystemParametersInfo(uiAction, uiParam, pvParam, fWinIni);
+end;
+
 {------------------------------------------------------------------------------
   Method:  TextOut
   Params: DC    - handle of device context
Index: lcl/interfaces/wince/wincewinapih.inc
===================================================================
--- lcl/interfaces/wince/wincewinapih.inc	(revision 31285)
+++ lcl/interfaces/wince/wincewinapih.inc	(working copy)
@@ -229,7 +229,7 @@
 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
 function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
 function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
-
+function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
 function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
 
 function UpdateWindow(Handle: HWND): Boolean;override;
TScreen_NEW_Properties_v2.patch (11,989 bytes)   

wovan.bugger

2011-06-19 17:04

reporter   ~0049206

Ок, I've attached a new patch TScreen_NEW_Properties_v2.patch .
it adds for: gtk, gtk2, qt, carbon, wince, win32

tested on Win32 and carbon but should work on others.

2011-06-21 15:23

 

TScreen_NEW_Properties_v3.patch (11,898 bytes)   
Index: lcl/forms.pp
===================================================================
--- lcl/forms.pp	(revision 31315)
+++ lcl/forms.pp	(working copy)
@@ -943,8 +943,11 @@
     function GetCustomFormsZOrdered(Index: Integer): TCustomForm;
     function GetDataModuleCount: Integer;
     function GetDataModules(AIndex: Integer): TDataModule;
+    function GetDesktopLeft: Integer;
+    function GetDesktopTop: Integer;
     function GetDesktopHeight: Integer;
     function GetDesktopWidth: Integer;
+    function GetDesktopRect: TRect;
     function GetFonts : TStrings;
     function GetFormCount: Integer;
     function GetForms(IIndex: Integer): TForm;
@@ -973,6 +976,11 @@
     procedure DoRemoveDataModule(DataModule: TDataModule);
     procedure NotifyScreenFormHandler(HandlerType: TScreenNotification;
                                       Form: TCustomForm);
+    function GetWorkAreaHeight: Integer;
+    function GetWorkAreaLeft: Integer;
+    function GetWorkAreaRect: TRect;
+    function GetWorkAreaTop: Integer;
+    function GetWorkAreaWidth: Integer;
   protected
     function GetHintFont: TFont; virtual;
     function GetIconFont: TFont; virtual;
@@ -1033,8 +1041,12 @@
     property CustomFormZOrderCount: Integer read GetCustomFormZOrderCount;
     property CustomFormsZOrdered[Index: Integer]: TCustomForm
                                read GetCustomFormsZOrdered; // lower index means on top
+    property DesktopLeft: Integer read GetDesktopLeft;
+    property DesktopTop: Integer read GetDesktopTop;
+
     property DesktopHeight: Integer read GetDesktopHeight;
     property DesktopWidth: Integer read GetDesktopWidth;
+    property DesktopRect: TRect read GetDesktopRect;
     property FocusedForm: TCustomForm read FFocusedForm;
     property FormCount: Integer read GetFormCount;
     property Forms[Index: Integer]: TForm read GetForms;
@@ -1053,6 +1065,11 @@
     property PixelsPerInch: integer read FPixelsPerInch;
     property PrimaryMonitor: TMonitor read GetPrimaryMonitor;
     property Width: Integer read GetWidth;
+    property WorkAreaRect: TRect read GetWorkAreaRect;
+    property WorkAreaHeight: Integer read GetWorkAreaHeight;
+    property WorkAreaLeft: Integer read GetWorkAreaLeft;
+    property WorkAreaTop: Integer read GetWorkAreaTop;
+    property WorkAreaWidth: Integer read GetWorkAreaWidth;
     property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange
                                                  write FOnActiveControlChange;
     property OnActiveFormChange: TNotifyEvent read FOnActiveFormChange
Index: lcl/include/screen.inc
===================================================================
--- lcl/include/screen.inc	(revision 31315)
+++ lcl/include/screen.inc	(working copy)
@@ -654,6 +654,48 @@
   Result := GetSystemMetrics(SM_CXVIRTUALSCREEN);
 end;
 
+function TScreen.GetDesktopLeft: Integer;
+begin
+  Result := GetSystemMetrics(SM_XVIRTUALSCREEN);  
+end;
+
+function TScreen.GetDesktopRect: TRect;
+begin
+  Result := Bounds(DesktopLeft, DesktopTop, DesktopWidth, DesktopHeight);
+end;
+
+function TScreen.GetDesktopTop: Integer;
+begin
+  Result := GetSystemMetrics(SM_YVIRTUALSCREEN);  
+end;
+
+function TScreen.GetWorkAreaLeft: Integer;
+begin
+  Result := WorkAreaRect.Left;
+end;
+
+function TScreen.GetWorkAreaRect: TRect;
+begin
+  SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
+end;
+
+function TScreen.GetWorkAreaTop: Integer;
+begin
+  Result := WorkAreaRect.Top;
+end;
+
+function TScreen.GetWorkAreaHeight: Integer;
+begin
+  with WorkAreaRect do Result := Bottom - Top;
+end;
+
+function TScreen.GetWorkAreaWidth: Integer;
+begin
+  with WorkAreaRect do Result := Right - Left;
+end;
+
+
+
 {------------------------------------------------------------------------------
   Function: TScreen.AddForm
   Params:   FForm: The form to be added
Index: lcl/interfaces/carbon/carbonwinapi.inc
===================================================================
--- lcl/interfaces/carbon/carbonwinapi.inc	(revision 31315)
+++ lcl/interfaces/carbon/carbonwinapi.inc	(working copy)
@@ -3616,6 +3616,21 @@
     TCarbonBitmap(Mask), XMask, YMask, Rop);
 end;
 
+function TCarbonWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
+  pvParam: Pointer; fWinIni: DWord): LongBool;
+begin
+  Result:=False;
+  Case uiAction of
+    SPI_GETWORKAREA: begin
+      TRect(pvParam^):=Bounds(GetSystemMetrics(SM_XVIRTUALSCREEN),
+                              GetSystemMetrics(SM_YVIRTUALSCREEN),
+                              GetSystemMetrics(SM_CXVIRTUALSCREEN),
+                              GetSystemMetrics(SM_CYVIRTUALSCREEN));
+      Result:=True;
+    end;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TextOut
   Params:  DC    - Handle of the device context
Index: lcl/interfaces/carbon/carbonwinapih.inc
===================================================================
--- lcl/interfaces/carbon/carbonwinapih.inc	(revision 31315)
+++ lcl/interfaces/carbon/carbonwinapih.inc	(working copy)
@@ -217,7 +217,7 @@
 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
 function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
 function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
-
+function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
 function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
 function UpdateWindow(Handle: HWND): Boolean; override;
 function WindowFromPoint(Point : TPoint) : HWND; override;
Index: lcl/interfaces/gtk2/gtk2winapi.inc
===================================================================
--- lcl/interfaces/gtk2/gtk2winapi.inc	(revision 31315)
+++ lcl/interfaces/gtk2/gtk2winapi.inc	(working copy)
@@ -9106,6 +9106,21 @@
                           Rop);
 end;
 
+function TGtk2WidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
+  pvParam: Pointer; fWinIni: DWord): LongBool;
+begin
+  Result:=False;
+  Case uiAction of
+    SPI_GETWORKAREA: begin
+      TRect(pvParam^):=Bounds(GetSystemMetrics(SM_XVIRTUALSCREEN),
+                              GetSystemMetrics(SM_YVIRTUALSCREEN),
+                              GetSystemMetrics(SM_CXVIRTUALSCREEN),
+                              GetSystemMetrics(SM_CYVIRTUALSCREEN));
+      Result:=True;
+    end;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Function: TextOut
   Params: DC:
Index: lcl/interfaces/gtk2/gtk2winapih.inc
===================================================================
--- lcl/interfaces/gtk2/gtk2winapih.inc	(revision 31315)
+++ lcl/interfaces/gtk2/gtk2winapih.inc	(working copy)
@@ -231,7 +231,7 @@
 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
 function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
 function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
-
+function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
 function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
 
 function UpdateWindow(Handle: HWND): Boolean; override;
Index: lcl/interfaces/gtk/gtkwinapi.inc
===================================================================
--- lcl/interfaces/gtk/gtkwinapi.inc	(revision 31315)
+++ lcl/interfaces/gtk/gtkwinapi.inc	(working copy)
@@ -9776,6 +9776,21 @@
                           Rop);
 end;
 
+function TGTKWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
+  pvParam: Pointer; fWinIni: DWord): LongBool;
+begin
+  Result:=False;
+  Case uiAction of
+    SPI_GETWORKAREA: begin
+      TRect(pvParam^):=Bounds(GetSystemMetrics(SM_XVIRTUALSCREEN),
+                              GetSystemMetrics(SM_YVIRTUALSCREEN),
+                              GetSystemMetrics(SM_CXVIRTUALSCREEN),
+                              GetSystemMetrics(SM_CYVIRTUALSCREEN));
+      Result:=True;
+    end;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Function: TextOut
   Params: DC:
Index: lcl/interfaces/gtk/gtkwinapih.inc
===================================================================
--- lcl/interfaces/gtk/gtkwinapih.inc	(revision 31315)
+++ lcl/interfaces/gtk/gtkwinapih.inc	(working copy)
@@ -215,7 +215,7 @@
 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
 function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
 function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
-
+function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
 function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
 
 function WindowFromPoint(APoint: TPoint): HWND; override;
Index: lcl/interfaces/qt/qtwinapi.inc
===================================================================
--- lcl/interfaces/qt/qtwinapi.inc	(revision 31315)
+++ lcl/interfaces/qt/qtwinapi.inc	(working copy)
@@ -5790,6 +5790,13 @@
 begin
   case uiAction of
     SPI_GETWHEELSCROLLLINES: PDword(pvPAram)^ := QApplication_wheelScrollLines;
+    SPI_GETWORKAREA: begin
+      TRect(pvParam^):=Bounds(GetSystemMetrics(SM_XVIRTUALSCREEN),
+                              GetSystemMetrics(SM_YVIRTUALSCREEN),
+                              GetSystemMetrics(SM_CXVIRTUALSCREEN),
+                              GetSystemMetrics(SM_CYVIRTUALSCREEN));
+      Result:=True;
+    end;
   else
     Result := False;
   end
Index: lcl/interfaces/wince/wincewinapi.inc
===================================================================
--- lcl/interfaces/wince/wincewinapi.inc	(revision 31315)
+++ lcl/interfaces/wince/wincewinapi.inc	(working copy)
@@ -3534,6 +3534,12 @@
   Result := true;
 end;
 
+function TWinCEWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
+  pvParam: Pointer; fWinIni: DWord): LongBool;
+begin
+  Result := Windows.SystemParametersInfo(uiAction, uiParam, pvParam, fWinIni);
+end;
+
 {------------------------------------------------------------------------------
   Method:  TextOut
   Params: DC    - handle of device context
Index: lcl/interfaces/wince/wincewinapih.inc
===================================================================
--- lcl/interfaces/wince/wincewinapih.inc	(revision 31315)
+++ lcl/interfaces/wince/wincewinapih.inc	(working copy)
@@ -229,7 +229,7 @@
 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
 function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
 function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
-
+function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;
 function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
 
 function UpdateWindow(Handle: HWND): Boolean;override;
TScreen_NEW_Properties_v3.patch (11,898 bytes)   

wovan.bugger

2011-06-21 15:25

reporter   ~0049262

while you're not applying the patch I've attached 3-rd version (some more cute code).

Please spend a minute to apply it (use this one "TScreen_NEW_Properties_v3.patch")

Felipe Monteiro de Carvalho

2011-06-22 23:04

developer   ~0049316

Thanks, applied with a minor spacing fix. In wincewinapih.inc and similar units, you killed the space between those APIs starting with S and other ones, I readded it. What is your full name? Is it already in the contributors list? If not, it needs to be added.

Issue History

Date Modified Username Field Change
2011-05-19 15:06 wovan.bugger New Issue
2011-05-19 15:06 wovan.bugger Widgetset => Win32/Win64
2011-05-27 05:27 wovan.bugger Note Added: 0048633
2011-05-27 15:51 Felipe Monteiro de Carvalho Note Added: 0048649
2011-05-27 15:54 Felipe Monteiro de Carvalho Note Added: 0048650
2011-05-27 15:55 Felipe Monteiro de Carvalho Note Added: 0048651
2011-05-27 15:55 Felipe Monteiro de Carvalho Status new => assigned
2011-05-27 15:55 Felipe Monteiro de Carvalho Assigned To => Felipe Monteiro de Carvalho
2011-05-27 16:07 Felipe Monteiro de Carvalho Project Lazarus => Patches
2011-05-27 20:43 wovan.bugger File Added: TScreen_NEW_Properties.patch
2011-05-27 20:46 wovan.bugger Note Added: 0048659
2011-05-29 08:28 Felipe Monteiro de Carvalho Note Added: 0048697
2011-06-19 16:59 wovan.bugger File Added: TScreen_NEW_Properties_v2.patch
2011-06-19 17:04 wovan.bugger Note Added: 0049206
2011-06-21 15:23 wovan.bugger File Added: TScreen_NEW_Properties_v3.patch
2011-06-21 15:25 wovan.bugger Note Added: 0049262
2011-06-22 23:04 Felipe Monteiro de Carvalho Fixed in Revision => 31339
2011-06-22 23:04 Felipe Monteiro de Carvalho LazTarget => -
2011-06-22 23:04 Felipe Monteiro de Carvalho Status assigned => resolved
2011-06-22 23:04 Felipe Monteiro de Carvalho Resolution open => fixed
2011-06-22 23:04 Felipe Monteiro de Carvalho Note Added: 0049316