Unable to make app DPI aware - this is not a duplicate - dpi

I cannot make my application DPI-aware.
In app.manifest I uncommented:
<application xmlns="urn:schemas-microsoft-com:asm.v3">
<windowsSettings>
<dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true</dpiAware>
</windowsSettings>
</application>
In App.config I added:
<appSettings>
<add key="EnableWindowsFormsHighDpiAutoResizing" value="true" />
</appSettings>
I am following the questions and responses in
Make vb.net application DPI aware
and
https://www.telerik.com/blogs/winforms-scaling-at-large-dpi-settings-is-it-even-possible-
My application has a single form with a single user control. On each I tried running the app with the AutoScaleMode to each of the various settings: None, Dpi, Font, Inherit (they default to Font). I am using a single monitor which is factory original on my laptop.
In every case, e.graphics.dpix and e.graphics.dpiy (where e is PaintEventArgs) is 96.0. It should be 128.0 = 1920 pixels / 15 inches and 128.0 = 1080 / 8.4375 inches.
What am I missing?

Here's a partial solution.
For painting to the screen, set Graphics.PageUnit = GraphicsUnit.Point (the default is GraphicsUnit.Display).
(I haven't figured out how to AutoSize the UserControl that I'm painting without kludging DPI.)
For printing, use Graphics.PageUnit = GraphicsUnit.Pixel.
' printing
dim gs as Drawing2D.GraphicsState = e.Graphics.Save
Try
e.Graphics.PageUnit = GraphicsUnit.Pixel
dim DpiX as Single = e.Graphics.DpiX
dim DpiY as Single = e.Graphics.DpiY
DoPrinting(e.Graphics, DpiX, DpiY) ' this is where you implement the code to draw your page
Catch ex as Exception
Finally
e.Graphics.Restore(gs)
End Try
' painting to screen
dim gs as Drawing2D.GraphicsState = e.Graphics.Point
Try
e.Graphics.PageUnit = GraphicsUnit.Pixel
dim DpiX as Single = 128.0! ' your value may vary; to find out, divide
dim DpiY as Single = 128.0! ' physical size of screen by screen resolution
DoPrinting(e.Graphics, DpiX, DpiY) ' this is where you implement the code to paint to screen
Catch ex as Exception
Finally
e.Graphics.Restore(gs)
End Try

Related

Resizing and positioning Excel windows correctly on a specific monitor

On opening Excel I want to programmatically create a new window of the workbook, similar to the View Menu -> New Window command in Excel.
Then I want to position and resize these windows to 60% and 40% of the screen resolution respectively and and they should be arranged side by side on a horizontal monitor in a dual monitor system.
The other monitor could either be vertical or horizontal.
All this works well when the horizonal monitor is the primary monitor but if its the secondary monitor.
The first window is not resized properly by width. and so there is an unused area left at the right end of the monitor as shown in the picture.
The resize code that I use is as under
Sub Resize()
Dim mainWindow As Window
Dim secondWindow As Window
'Recalculate new widths and positions
Dim mainWindowWidth As Double
Dim secondWindowWidth As Double
mainWindowWidth = 0.6 * screenWidthPoints
secondWindowWidth = 0.4 * screenWidthPoints
'Assign window variables
If Not IsNull(ActiveWorkbook.Windows(1)) Then
Set mainWindow = ActiveWorkbook.Windows(1)
'switch to normal state before setting width, else will throw error if the window state is maximized and then try to set width
mainWindow.WindowState = xlNormal
mainWindow.Left = horzMonPoints.Left
mainWindow.Top = horzMonPoints.Top
mainWindow.Width = mainWindowWidth
End If
If Not IsNull(ActiveWorkbook.Windows(2)) Then
Set secondWindow = ActiveWorkbook.Windows(2)
secondWindow.Top = mainWindow.Top
secondWindow.Width = secondWindowWidth
secondWindow.Left = mainWindow.Left + mainWindow.Width
secondWindow.Height = mainWindow.Height
End If End Sub
The code to calculate number of monitors and monitor widths and heights, I used windows API calls in VBA.
From this link.

Change visible property sometimes change the center position of the view (possible bug?)

I've 3 (loader, locker and debug view) hidden views (touchEnabled and visible set to false, and zIndex to 1) above the main view (zIndex = 2).
Each 'over' view has this method:
$.debugView.show = function() {
$.debugView.touchEnabled = $.debugView.visible = true;
$.debugView.zIndex = 3;
};
$.debugView.hide = function() {
$.debugView.touchEnabled = $.debugView.visible = false;
$.debugView.zIndex = 1;
};
This screen has the 3 'over' views hidden:
Now, I'm opening the 'debug view', but, SOMETIMES it seems like it changes the positions (as if the center it's on the top left corner instead of the center of the device).
Instead of the required result:
If I use the opacity instead of the visible property, it works properly.
This might be an SDK bug right?
<Alloy>
<Window>
<View id="content"/>
<View id="locker"/>
<View id="loader"/>
<View id="debugView"/>
</Window>
</Alloy>
All of these 4 views don't have width or height (so it uses the Ti.UI.FILL as default)
I have noticed this too with a completely different implementation. I had just one view that I included in a window.
Apparently the left and top calculations were not done properly if the elements is hidden.
What I did to solve the issue is to hardcode the left/top position by calculating the left position using this:
$.content.left = (Ti.Platform.displayCaps.platformWidth - 75) / 2;
Where in my case 75 is the width the element has, so that'll be bigger in your case. You can do the same for height.
Now, this is an iOS only solution. On Android you will need to take DPI into consideration calculating it.
I do think it is a bug, though this solution works perfectly for me. I recommend looking at JIRA and see if it is a known issue, and if not, raise it with a very specific explanation of the problem, preferably with a reproducible case delivered as an app. Classic would help most. And if it is not reproducible in classic it might be an alloy issue.

How do I make an Excel ActiveX label to be transparent ... at runtime?

I want to put a transparent label on top of a sheet in Excel, so that I can take advantage of the MouseMove event of the label to "draw cells" (aka change their fill color and so on) by mouse click / drag / etc. - since I can't do that on the cells per se.
Now everything works just fine, except that I can't make the label transparent at runtime (aka in VBA) ... while by doing exactly the same thing in Design Mode works as expected. Specifically, I have the code (more or less):
Dim MapLabel As OLEObject
On Error Resume Next
Sheet2.OLEObjects("MapLabel").Delete
Set MapLabel = Sheet2.OLEObjects.Add("Forms.Label.1")
MapLabel.name = "MapLabel"
MapLabel.Placement = xlMoveAndSize
MapLabel.Object.Caption = ""
' Problem line below
MapLabel.Object.BackStyle = fmBackStyleTransparent
' Problem line above
MapLabel.Left = Sheet2.cells(2, 6).Left
MapLabel.Top = Sheet2.cells(2, 6).Top
MapLabel.Width = Sheet2.cells(2,6).Width * 10
MapLabel.Height = Sheet2.cells(2,6).Height * 10
So, in words, I first delete the label named 'MapLabel', then recreate it (the above code goes into a "init" Sub). All the code lines except the one marked produce the desired result. The marked one does set the BackStyle property of the label to fmBackStyleTransparent ... but it doesn't actually make the label transparent. This is frustrating, because it's the same approach that works flawlessly at design time!
Do you have a solution to this? I read about solving similar problems by declaring the label as MsForms.Label or as Control, but the sheet object doesn't have those properties, plus, there are far more label properties which can be set using the OLEObject than with the help of MsForms.Label or Control.
All you need to do after this line:
MapLabel.Object.BackStyle = fmBackStyleTransparent
put this line:
ActiveSheet.Shapes(MapLabel.Name).Fill.Transparency = 1
I hope I helped.
P.S. If you need explanation i will edit my answer.
I had the same problem as you but in Word. The solution for me was to do the following:
In design mode:
Right click on the object
Navigate to Switch to automatic form/Image > Wrapping > In front of the text
Add an empty picture to your label

System.Drawing.Graphics.DpiX always return 96

I have vb.net winform app that has
AutoScaleMode = dpi
AutoScale = false
AutoSize = true
I've signed off after changing DPI setting.
I also tried restarting the machine.
Using g As Graphics = form.CreateGraphics()
Dim dpiX As Single = g.DpiX
dpiX is always 96 regardless of DPI setting. Anyone know what I am doing wrong?
I found solution. My app's manifest has to say it is dpiAware.
Because I am trying to detect high DPI and show a warning message box and not really trying to make my app dpi aware, I couldn't do that.
You can get dpi aware information from registry:
HKEY_CURRENT_USER\Control Panel\Desktop
LogPixels.
If you are using default, you won't have the key. Changing DPI setting will create one.
I ran into this problem and found that if you override the OnPaint(PaintEventArgs e) method of the form, and then get the Graphics object from the argument 'e' i.e. e.Graphics then the DpiX and DpiY value of this Graphics object is correct.
Unfortunately, the way windows handles DPI scaling is all over the place:
Using g As Graphics = form.CreateGraphics()
Dim dpiX As Single = g.DpiX
This code will only work if user has "Use Windows XP Style DPI Scaling" selected when setting custom DPI. Don't know if that option is even available in the new versions of Windows (8.x and 10) or if they've taken it out.
Your best bet would be to just read the registry:
Dim regUseDpiScaling As Integer
Try 'Use Try / Catch since the reg value may not exist if user using 96 DPI.
regUseDpiScaling = CInt(My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\DWM", "UseDpiScaling", Nothing)) ' if this returns 1, it means users is using modern DPI scaling.
Catch ex As Exception
regUseDpiScaling = 0 ' 0 means no DPI scaling or XP DPI scaling
End Try
If Not (regUseDpiScaling = 0) Then
boolUsesModernDPIScaling = True 'Means you haven't clicked "Use Windows XP Style DPI Scaling" while setting DPI in your system.
Else
boolUsesModernDPIScaling = False
MsgBox("2")
End If
Dim regAppliedDPI As Integer
Try
regAppliedDPI = CInt(My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics", "AppliedDPI", Nothing))
Catch ex As Exception
regAppliedDPI = 96
End Try
DPIratioX = regAppliedDPI / 96
DPIratioY = regAppliedDPI / 96
I found that having XP DPI scaling can result in different behavior, so it's good to have the program detect if it's being used.

In Excel, VBA - How can we lock resizing of a rectangle

I have an excel sheet that contains two rectangles and text in other cells.
I need to allow users to only edit the text in the rectangle. They should not be able to change the size of the object.
Applying lock on the rectangle locks the object as well as the text.
Does anyone know how I can achieve this?
Why not create two objects, one being a rectangle that is locked, and one being a text box that is not locked? This is really simplistic, but a possible answer.
Another idea would be to have the rectangle equal a set cell, and let them enter their text in the cell and it would transfer over even when the rectangle is locked.
As far as I am aware Excel does not accommodate Events for shapes and so there is no simple way of detecting a change in a shape size and then resizing the shape.
It is possible to emulate what you are asking for by using a workaround.
Imagine you have two rectangles on your spreadsheet called 'Rectangle 1 and 'Rectangle 2'. When a user finishes updating the text in any given box they must then click the spreadsheet to move out of 'edit' mode for the shape. You can detect this using the Workbook_SheetSelectionChange event.
The following module allows you to set the size of the rectangles as constants and will resize the rectangles accordingly:
Const Rect1Height As Integer = 50
Const Rect1Width As Integer = 200
Const Rect2Height As Integer = 50
Const Rect2Width As Integer = 200
Sub SetRectangleSize()
Dim Rect1 As Shape
Dim Rect2 As Shape
Set Rect1 = ActiveSheet.Shapes("Rectangle 1")
Set Rect2 = ActiveSheet.Shapes("Rectangle 2")
Rect1.Height = Rect1Height
Rect1.Width = Rect1Width
Rect2.Height = Rect1Height
Rect2.Width = Rect1Width
End Sub
Now all you need to do is to call this sub from a workbook level event:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
SetRectangleSize
End Sub
Each time a user updates the text in one of the rectangles they will click back on the spreadsheet and the event is fired, resulting in the rectangles being sized according to the constant height and width parameters that you have defined.

Resources