Delphi screen dimensions differ on two apps on same machine...how to resolve? - delphi-xe

I have two applications that use some of the same forms. I noticed that these forms were displaying differently when I ran the applications. I put this code at the top of the project source:
var f: TextFile;
s: String;
{$R *.res}
begin
s := TPath.GetFileNameWithoutExtension(Application.ExeName);
AssignFile(f, s + '-screen.txt');
Rewrite(f);
Writeln (f, s + '.Desktop TLHW: ' + IntToStr(screen.DesktopTop) + ', ' +
IntToStr(screen.DesktopLeft) + ', ' +
IntToStr(screen.DesktopHeight) + ', ' +
IntToStr(screen.DesktopWidth));
CloseFile (f);
aDAM2-screen.txt showed: aDAM2.Desktop TLHW: 0, 0, 720, 1280
aDAM3-screen.txt showed: aDAM3.Desktop TLHW: 0, 0, 1080, 1920
I don't understand how this happens and am at a loss to resolve this, especially given that the TScreen properties are read-only.

The likely explanation is that one program is subject to DPI virtualization, the other is not. The system has 150% font scaling specified.
The true resolution is 1920 by 1080, and aDAM3 is reporting that, because it is not subject to DPI virtualization.
On the other hand aDAM2 is subject to DPI virtualization, and so reports virtualized dimensions, which are the true dimensions divided by 1.5. That is 1280 by 720.

Related

How to get real display resolution in Delphi 7 regardless of scale factor?

I have some problems with getting screen resolution in Delphi 7 when scale is more that 125%.
Code I used for testing:
procedure TForm1.Button1Click(Sender: TObject);
var
MonId: integer;
Mon: TMonitor;
AllMonitorsWidth, AllMonitorsHeight: integer;
begin
Memo1.Clear;
Memo1.Lines.Append(Format('Number of monitors: %d', [Screen.MonitorCount]));
for MonId := 0 to Screen.MonitorCount - 1 do
begin
Mon := Screen.Monitors[MonId];
With Memo1.Lines do
begin
Append('');
Append(Format('-------- Monitor #%d --------', [mon.MonitorNum]));
Append(Format('Resolution: %dpx x %dpx', [Mon.Width, Mon.Height]));
Append(Format('X-offset: %dpx', [Mon.Left]));
Append(Format('Y-offset: %dpx', [Mon.Top]));
end;
end;
AllMonitorsWidth := GetSystemMetrics(SM_CXVIRTUALSCREEN);
AllMonitorsHeight := GetSystemMetrics(SM_CYVIRTUALSCREEN);
With Memo1.Lines do
begin
Append('');
Append('-------- All monitors --------');
Append(Format('Resolution: %dpx x %dpx', [AllMonitorsWidth, AllMonitorsHeight]));
Append(Format('PPI: %d', [Screen.PixelsPerInch]));
end;
end;
For example, I run this test on notebook with 1366x768 display and Windows 7. Results:
100% (96 ppi):
125% (120 ppi):
150% (144 ppi):
200% (192 ppi)
As you can see on 150% and 200% scale program detects wrong DPI=96 and resolution also incorect.
I think in modern versions of Delphi there are may be fixed. But is there any solution for Delphi 7 without upgrade to newer version?
Moreover there may be more than one display and with different DPIs. So I need to correct get resolution for each of them.

How to detect whether Windows 10 buffer wrapping mode is currently enabled in the console

Is there any way to detect whether a console app is running with Windows 10's new features enabled?
This MSDN page shows that HKEY_CURRENT_USER\Console\ForceV2, HKEY_CURRENT_USER\Console\LineWrap and HKEY_CURRENT_USER\Console\{name}\LineWrap control it, but besides that being less robust to parse, it may not be correct. If the user switches to or from legacy mode, the change won't take effect until the console relaunches.
If I develop the app, I can do the check at startup. There could have been a race condition though, which renders the registry check useless for any practical use. I am curious what the solution would be for third party console windows.
There seems to be no API for that, though I'd expect one to surface in some later SDK (maybe additional hyper-extended flags in GetConsoleMode).
Meanwhile, the following is a quick hack which attempts to detect the resize-wider capability of the new console, based on checking the ptMaxTrackSize.X value returned by GetMinMaxInfo.
The legacy console doesn't allow resizing the window wider than the screen buffer width, while the new one does. On the assumptions that (a) the console is running at full buffer width i.e. has no horizontal scrollbar, and (b) it's not already stretched to the full/max screen width, it's fairly straightforward to check whether the window allows itself to be resized wider (new console) or not (legacy console). Should be noted that assumption (a) could technically be avoided by manually converting the buffer width from characters to pixels, rather than relying on GetWindowRect, but assumption (b) is pretty much unavoidable.
This is the code (disclaimer: quick-and-dirty proof-of concept, no error checking etc).
int main()
{
// largest possible console size for given font and desktop
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
COORD cd = GetLargestConsoleWindowSize(hOut);
SHORT nScrMaxXch = cd.X,
nScrMaxYch = cd.Y;
// current and max console sizes for given screen buffer
CONSOLE_SCREEN_BUFFER_INFOEX csbix = { sizeof(csbix) };
GetConsoleScreenBufferInfoEx(hOut, &csbix);
SHORT nWndXch = csbix.srWindow.Right - csbix.srWindow.Left + 1,
nWndYch = csbix.srWindow.Bottom - csbix.srWindow.Top + 1;
SHORT nWndMaxXch = csbix.dwMaximumWindowSize.X,
nWndMaxYch = csbix.dwMaximumWindowSize.Y;
wprintf(L"chars: wnd-size %d %d, max-wnd-size %d %d, largest-size %d %d\n",
nWndXch, nWndYch, nWndMaxXch, nWndMaxYch, nScrMaxXch, nScrMaxYch);
// current window size
HWND hWnd = GetConsoleWindow();
RECT rc; GetWindowRect(hWnd, &rc);
LONG nWndXpx = rc.right - rc.left,
nWndYpx = rc.bottom - rc.top;
// max window tracking size
MINMAXINFO mmi = { 0 };
SendMessage(hWnd, WM_GETMINMAXINFO, 0, (LPARAM)&mmi);
LONG nWndMaxXpx = mmi.ptMaxTrackSize.x,
nWndMaxYpx = mmi.ptMaxTrackSize.y;
wprintf(L"pixels: wnd-size %lu %lu, max-tracking-size %lu %lu\n",
nWndXpx, nWndYpx, nWndMaxXpx, nWndMaxYpx);
if (nWndXch == nWndMaxXch // full buffer width, no h-scrollbar
&& nWndXch < nScrMaxXch // not already stretched to full screen width
&& nWndMaxXpx > nWndXpx) // allowed to resized wider
wprintf(L"\n...most likely a Win10 console with ForceV2 enabled\n");
return 0;
}
This is the output when run in a legacy console.
chars: wnd-size 80 25, max-wnd-size 80 71, largest-size 240 71
pixels: wnd-size 677 443, max-tracking-size 677 1179
This is the output when run in the new console.
chars: wnd-size 80 25, max-wnd-size 80 71, largest-size 239 71
pixels: wnd-size 677 443, max-tracking-size 1936 1186
...most likely a Win10 console with ForceV2 enabled

How to properly set the size of a ListView column according to its content?

I have a number of list view controls (TListView) that are used to display data. All these list view are set to "Detail" mode and all have TImageList assigned to their "SmallIcons" properties.
I'm trying to set the width of these column based on their contents exactly in the same way as if the user double-clicked on the separator slider at the end of each of the column headers.
First, I tried to set the column width to "-1" and "-2" for auto-sizing them: not only did that fail to work perfectly (some columns containing local characters - I'm using D6 and that means ANSI strings - are too low) but it also made the display of the column extremely slow (up to 30 seconds to display a list view with 6 column and 150 items when it's instantaneous with fixed width).
I have tried to use GetTextExtent on each cell to obtain the expected width of the text, adding some margin (from 2 to 10 pixels) and the expand the width of the column if it is lower than the calculated text width. Special treatment is applied to the first column (Items.caption) to take into account the display of the icon (I add the width of the icon, plus margin, to the width of the cell's text).
That didn't work either: in many cases (for instance, displaying the date in "yyyy/mm/dd hh:nn:ss" format results in a text too large to fit in the column).
Thinking that the issue could come from the window theme engine, I've switched to use GetThemeTextExtent instead of GetTextExtent but obtained the same result.
The only thing that seems to work is to add an arbitrary large margin (20 pixels) to each column width but, of course, that produces columns that are larger than they should be.
So, is there any alternative strategy ? I don't need anything but something that will calculate the correct width once: when the list is first populated. The code behind "clicking the column separator" works just fine but I can't find how to trigger it by code (well, I guess I could send the double click messages to the header directly as a hack)
For clarification, here are the things I tried the following code:
(in call case, there is a call made to ListView.canvas.Font.Assign(ListView.font). It is not in theses functions because a single assignment is enough but the code loops on all non-autosized columns of the listview).
Edit
My initial attempt using Windows Theme API:
function _GetTextWidth1(AText: widestring; IsHeader: boolean = false): Integer;
var
ATheme: HTheme;
rValue: TRect;
iPartID: integer;
AWidetext: WideString;
const
LVP_GROUPHEADER = 6;
begin
// try to get text width using theme API
ZeroMemory(#rValue, SizeOf(rValue));
ATheme := OpenThemeData(ListView.Handle, 'LISTVIEW');
try
if not IsHeader then
iPartID := LVP_LISTITEM
else
iPartID := LVP_GROUPHEADER;
AWidetext := AText;
GetThemeTextExtent( ATheme,
ListView.Canvas.Handle,
iPartID,
LIS_NORMAL,
PWideChar(AWidetext),
-1,
DT_LEFT or DT_SINGLELINE or DT_CALCRECT,
nil,
rValue
);
finally // wrap up
CloseThemeData(ATheme);
end; // try/finally
result := rValue.Right;
end;
next attempt using DrawText/DrawTextW:
function _GetTextWidth2(AText: widestring; IsHeader: boolean = false): Integer;
var
rValue: TRect;
lFlags: Integer;
begin
// try to get text width using DrawText/DrawTextW
rValue := Rect(0, 0, 0, 0);
lFlags := DT_CALCRECT or DT_EXPANDTABS or DT_NOPREFIX or DT_LEFT or DT_EXTERNALLEADING;
DrawText(ListView.canvas.Handle, PChar(AText), Length(AText), rValue, lFlags);
//DrawTextW(ListView.canvas.Handle, PWideChar(AText), Length(AText), rValue, lFlags);
result := rValue.Right;
end;
Third attempt using delphi's TextWidth function
function _GetTextWidth3(AText: widestring; IsHeader: boolean = false): Integer;
begin
// try to get text width using delphi wrapped around GetTextExtentPoint32
result := ListView.canvas.TextWidth(Atext);
end;
In all cases, I add a margin to the resulting width: I tried values as high as 20 pixels. I also take into account the possibility that the view use icons (in which case I add the width of the icon plus the margin again to the first column).
You could use canvas.TextWidth method. But be sure to use TListView canvas (not other, i.e. TForm) and first assign a font to canvas from TListView.
For example:
var
s: integer;
begin
ListView1.AddItem('test example item', nil);
ListView1.canvas.Font.Assign(ListView1.font);
s := ListView1.canvas.TextWidth(ListView1.Items[0].Caption) + 10; //this "+10" is a small additional margin
if s > ListView1.Columns[0].Width then
ListView1.Columns[0].Width := s;
It works fine for me.

Reading screen's resolution with QTP

In the initialization of my script I would have to read the resolution of the screen so I know how to resize the browser's window size.
Any ideas?
Thanks in advance!
Here's some code that can get the resolution for either the primary monitor or all multiple monitors.
Additionally, the last function returns a boolean for whether you have multiple monitors or not.
'*******************************************************************
'TotalScreenWidth & TotalScreenHeight
'by Michael Innes
'October 2012
'Intended for getting the total resolution when you have multiple monitors
'Returns the width and the height (respectively) across all the screens.
Function TotalScreenWidth()
TotalScreenWidth = Window("regexpwndtitle:=Program Manager").GetROProperty("width")
End Function
Function TotalScreenHeight()
TotalScreenHeight = Window("regexpwndtitle:=Program Manager").GetROProperty("height")
End Function
'*******************************************************************
'ScreenWidth & ScreenHeight
'by Michael Innes
'October 2012
'Retrieves the width and height (respectively) of the primary screen (the screen that the taskbar is on)
'This only works if the taskbar is at the bottom of the screen
Function ScreenWidth()
ScreenWidth = Window("object class:=Shell_TrayWnd").GetROProperty("width")
End Function
Function ScreenHeight()
ScreenHeight = Window("object class:=Shell_TrayWnd").GetROProperty("height") + Window("object class:=Shell_TrayWnd").GetROProperty("y")
End Function
'*******************************************************************
'MultipleMonitors
'by Michael Innes
'October 2012
'Returns a boolean that determines if the computer has multiple monitors attached.
'This only works if the taskbar is at the bottom of the left-most screen.
'If the taskbar is on the right-most monitor, this function will incorrectly report the multiple monitors as being False.
Function MultipleMonitors()
MultipleMonitors = Eval((screenWidth <> TotalScreenWidth) OR (screenHeight <> TotalScreenHeight))
End Function
This is actually quite straight forward, find the desktop window and get its dimensions.
width = Window("text:=Program Manager").GetROProperty("width")
height = Window("text:=Program Manager").GetROProperty("height")
Print width & ", " & height
This works for single monitors, I haven't checked what happens when you have multiple monitors.

Delphi 2009 label problems in Windows7

i'm developing am aplication in delphi 2009.
in windows xp, this code works fine
X := 70;
Label1.Caption :=FloatToStr(X)+' %'; /// (70 %)
In Windows 7, same code generates a diferent label (% 70), the position of characters are changing, all operators are going to front.
Just so that the question has a coherent answer for any future visitors, the issue is the BiDiMode. The following screenshot shows a reproduction of the behaviour described in the question.
This was generated with the following DFM file.
object MyForm: TMyForm
object Label1: TLabel
Left = 8
Top = 8
Width = 23
Height = 13
BiDiMode = bdLeftToRight
Caption = '70 %'
ParentBiDiMode = False
end
object Label2: TLabel
Left = 5
Top = 24
Width = 23
Height = 13
BiDiMode = bdRightToLeft
Caption = '70 %'
ParentBiDiMode = False
end
end

Resources