Windows Forms with High DPI

Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Tracer("Form1_Load")
StartTo_Write_Into_TextBox1 = True
AddHandler Application.Idle, AddressOf Application_Idle
End Sub
Public Sub New()
Application.EnableVisualStyles()
Tracer($"=========== New in ================")
' 設計工具需要此呼叫。
InitializeComponent()
' 在 InitializeComponent() 呼叫之後加入所有初始設定。
Me.TextBox1 = New System.Windows.Forms.TextBox()
Me.TextBox1.SuspendLayout()
Me.SuspendLayout()
Me.TextBox1.BackColor = System.Drawing.Color.LightSteelBlue
Me.TextBox1.ForeColor = System.Drawing.Color.Black
Me.TextBox1.Multiline = True
Me.TextBox1.ScrollBars = ScrollBars.Vertical
Me.TextBox1.Name = "TextBox1"
Me.TextBox1.TabIndex = 0
Me.TextBox1.Dock = System.Windows.Forms.DockStyle.Fill
Dim CX As Single = GetSystemMetricsForDpi(SM_CXSCREEN, DeviceDpi)
Dim CY As Single = GetSystemMetricsForDpi(SM_CYSCREEN, DeviceDpi)
OriginalDpi = DeviceDpi
Me.TextBox1.Font = Create_Font(initial_Font_Size)
Me.StartPosition = FormStartPosition.Manual
Me.Location = New Point(CInt(2), CInt(CY / 9))
Me.Size = New System.Drawing.Size(CInt(CX / 2), CInt(3 * CY / 5))
Me.Controls.Add(Me.TextBox1)
Me.ResumeLayout()
Me.TextBox1.ResumeLayout()
Tracer("============== New out =============")
End Sub
Private Sub Form1_HandleCreated(sender As Object, e As EventArgs) Handles Me.HandleCreated
Tracer("Form1_HandleCreated")
PreviousDpi = DeviceDpi
Dpi = DeviceDpi
Form1_Location = Me.Location
Form1_Size = Me.Size
End Sub
Sub Application_Idle(sender As Object, e As EventArgs)
RemoveHandler Application.Idle, AddressOf Application_Idle
Tracer("============= Application_Idle =================")
Dim StartInfo As New ProcessStartInfo("Rundll32.exe", "shell32,Control_RunDLL desk.cpl")
Process.Start(StartInfo)
End Sub
Private Sub Form1_HandleDestroyed(sender As Object, e As EventArgs) Handles Me.HandleDestroyed
Tracer("Form1_HandleDestroyed")
Show_TracedEvents_By_MSedge()
End Sub
Private Sub Form1_Resize(sender As Object, e As EventArgs) Handles Me.Resize
Tracer("Form1_Resize")
End Sub
Private Sub Form1_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
Tracer("Form1_SizeChanged")
Form1_Size = Me.Size
End Sub
Private Sub Form1_Move(sender As Object, e As EventArgs) Handles Me.Move
Tracer("Form1_Move")
End Sub
Private Sub Form1_LocationChanged(sender As Object, e As EventArgs) Handles Me.LocationChanged
Tracer("Form1_LocationChanged")
Form1_Location = Me.Location
End Sub
Private Sub Form1_Layout(sender As Object, e As LayoutEventArgs) Handles Me.Layout
Tracer("Form1_Layout")
If Dpi <> PreviousDpi Then DpiChange()
End Sub
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM_GETDPISCALEDSIZE
PreviousDpi = Dpi
Tracer($"WM_GETDPISCALEDSIZE-----------Dpi={m.WParam.ToInt32}")
Dpi = m.WParam.ToInt32
Case WM_DPICHANGED
Tracer($"WM_DPICHANGED----------Dpi={m.WParam.ToInt32 And &HFFFF}")
'PreviousDpi = Dpi
'Dpi = m.WParam.ToInt32 And &HFFFF
Case WM_DPICHANGED_BEFOREPARENT
Tracer("WM_DPICHANGED_BEFOREPARENT------------------------")
Case WM_DPICHANGED_AFTERPARENT
Tracer("WM_DPICHANGED_AFTERPARENT--------------------------")
End Select
MyBase.WndProc(m)
End Sub
Private Sub TextBox1_FontChanged(sender As Object, e As EventArgs) Handles TextBox1.FontChanged
Tracer("TextBox1_FontChanged")
End Sub
Private Sub TextBox1_Move(sender As Object, e As EventArgs) Handles TextBox1.Move
Tracer("TextBox1_Move")
End Sub
Private Sub TextBox1_LocationChanged(sender As Object, e As EventArgs) Handles TextBox1.LocationChanged
Tracer("TextBox1_LocationChanged")
End Sub
Private Sub TextBox1_Resize(sender As Object, e As EventArgs) Handles TextBox1.Resize
Tracer("TextBox1_Resize")
End Sub
Private Sub TextBox1_SizeChanged(sender As Object, e As EventArgs) Handles TextBox1.SizeChanged
Tracer("TextBox1_SizeChanged")
End Sub
Private Sub TextBox1_Layout(sender As Object, e As LayoutEventArgs) Handles TextBox1.Layout
Tracer("TextBox1_Layout")
End Sub
Private Sub Form1_StyleChanged(sender As Object, e As EventArgs) Handles Me.StyleChanged
Tracer("Form1_StyleChanged")
End Sub
Private Sub Form1_AutoSizeChanged(sender As Object, e As EventArgs) Handles Me.AutoSizeChanged
Tracer("Form1_AutoSizeChanged")
End Sub
Private Sub Form1_BindingContextChanged(sender As Object, e As EventArgs) Handles Me.BindingContextChanged
Tracer("Form1_BindingContextChanged")
End Sub
Private Sub Form1_ChangeUICues(sender As Object, e As UICuesEventArgs) Handles Me.ChangeUICues
Tracer("Form1_ChangeUICues")
End Sub
Private Sub Form1_Activated(sender As Object, e As EventArgs) Handles Me.Activated
Tracer("Form1_Activated")
End Sub
Private Sub Form1_Deactivate(sender As Object, e As EventArgs) Handles Me.Deactivate
Tracer("Form1_Deactivate")
End Sub
Private Sub Form1_Closed(sender As Object, e As EventArgs) Handles Me.Closed
Tracer("Form1_Closed")
End Sub
Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
Tracer("Form1_FormClosed")
End Sub
Private Sub Form1_Closing(sender As Object, e As System.ComponentModel.CancelEventArgs) Handles Me.Closing
Tracer("Form1_Closing")
End Sub
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
Tracer("Form1_FormClosing")
End Sub
Private Sub TextBox1_Enter(sender As Object, e As EventArgs) Handles TextBox1.Enter
Tracer("TextBox1_Enter")
End Sub
Private Sub TextBox1_Leave(sender As Object, e As EventArgs) Handles TextBox1.Leave
Tracer("TextBox1_Leave")
End Sub
Private Sub Form1_MarginChanged(sender As Object, e As EventArgs) Handles Me.MarginChanged
Tracer("Form1_MarginChanged")
End Sub
Private Sub Form1_PaddingChanged(sender As Object, e As EventArgs) Handles Me.PaddingChanged
Tracer("Form1_PaddingChanged")
End Sub
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
Static FourTimes As Int32 = 4
If FourTimes = 0 Then Exit Sub
FourTimes -= 1
Tracer($"Form1_Paint ({FourTimes})")
End Sub
Private Sub Form1_Validated(sender As Object, e As EventArgs) Handles Me.Validated
Tracer("Form1_Validated")
End Sub
Private Sub Form1_CausesValidationChanged(sender As Object, e As EventArgs) Handles Me.CausesValidationChanged
Tracer("Form1_CausesValidationChanged")
End Sub
Private Sub Form1_VisibleChanged(sender As Object, e As EventArgs) Handles Me.VisibleChanged
Tracer("Form1_VisibleChanged")
End Sub
Private Sub Form1_LostFocus(sender As Object, e As EventArgs) Handles Me.LostFocus
Tracer("Form1_LostFocus")
End Sub
Private Sub Form1_DpiChanged(sender As Object, e As DpiChangedEventArgs) Handles Me.DpiChanged
Tracer($"Form1_DpiChanged---->NewDpi={e.DeviceDpiNew} oldDpi={e.DeviceDpiOld} ")
End Sub
Private Sub Form1_DpiChangedAfterParent(sender As Object, e As EventArgs) Handles Me.DpiChangedAfterParent
Tracer("Form1_DpiChangedAfterParent-----------------")
End Sub
Private Sub Form1_DpiChangedBeforeParent(sender As Object, e As EventArgs) Handles Me.DpiChangedBeforeParent
Tracer("Form1_DpiChangedBeforeParent------------------")
End Sub
Private Sub Form1_DragDrop(sender As Object, e As DragEventArgs) Handles Me.DragDrop
Tracer("Form1_DragDrop")
End Sub
Private Sub Form1_SystemColorsChanged(sender As Object, e As EventArgs) Handles Me.SystemColorsChanged
Tracer("Form1_SystemColorsChanged")
End Sub
Private Sub Form1_TabIndexChanged(sender As Object, e As EventArgs) Handles Me.TabIndexChanged
Tracer("Form1_TabIndexChanged")
End Sub
Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown
Tracer("Form1_Shown")
End Sub
Private Sub Form1_TextChanged(sender As Object, e As EventArgs) Handles Me.TextChanged
Tracer("Form1_TextChanged")
End Sub
Private Sub Form1_QueryContinueDrag(sender As Object, e As QueryContinueDragEventArgs) Handles Me.QueryContinueDrag
Tracer("Form1_QueryContinueDrag")
End Sub
Private Sub Form1_ResizeBegin(sender As Object, e As EventArgs) Handles Me.ResizeBegin
Tracer("Form1_ResizeBegin")
End Sub
Private Sub Form1_Enter(sender As Object, e As EventArgs) Handles Me.Enter
Tracer("Form1_Enter")
End Sub
Private Sub Form1_Leave(sender As Object, e As EventArgs) Handles Me.Leave
Tracer("Form1_Leave")
End Sub
Private Sub Form1_Scroll(sender As Object, e As ScrollEventArgs) Handles Me.Scroll
Tracer("Form1_Scroll")
End Sub
Private Sub Form1_RegionChanged(sender As Object, e As EventArgs) Handles Me.RegionChanged
Tracer("Form1_RegionChanged")
End Sub
Private Sub Form1_MdiChildActivate(sender As Object, e As EventArgs) Handles Me.MdiChildActivate
Tracer("Form1_MdiChildActivate")
End Sub
Private Sub Form1_RightToLeftLayoutChanged(sender As Object, e As EventArgs) Handles Me.RightToLeftLayoutChanged
Tracer("Form1_RightToLeftLayoutChanged")
End Sub
Private Sub Form1_BackColorChanged(sender As Object, e As EventArgs) Handles Me.BackColorChanged
Tracer("Form1_BackColorChanged")
End Sub
Private Sub Form1_Click(sender As Object, e As EventArgs) Handles Me.Click
Tracer("Form1_Click")
End Sub
Private Sub Form1_ControlAdded(sender As Object, e As ControlEventArgs) Handles Me.ControlAdded
Tracer("Form1_ControlAdded")
End Sub
Private Sub Form1_ControlRemoved(sender As Object, e As ControlEventArgs) Handles Me.ControlRemoved
Tracer("Form1_ControlRemoved")
End Sub
Private Sub Form1_GotFocus(sender As Object, e As EventArgs) Handles Me.GotFocus
Tracer("Form1_GotFocus")
End Sub
Private Sub Form1_FontChanged(sender As Object, e As EventArgs) Handles Me.FontChanged
Tracer("Form1_FontChanged")
End Sub
Private Sub Form1_Validating(sender As Object, e As System.ComponentModel.CancelEventArgs) Handles Me.Validating
Tracer("Form1_Validating")
End Sub
Private Sub Form1_Invalidated(sender As Object, e As InvalidateEventArgs) Handles Me.Invalidated
Tracer("Form1_Invalidated")
End Sub
Private Sub Form1_TabStopChanged(sender As Object, e As EventArgs) Handles Me.TabStopChanged
Tracer("Form1_TabStopChanged")
End Sub
Private Sub Form1_RightToLeftChanged(sender As Object, e As EventArgs) Handles Me.RightToLeftChanged
Tracer("Form1_RightToLeftChanged")
End Sub
Private Sub Form1_DockChanged(sender As Object, e As EventArgs) Handles Me.DockChanged
Tracer("Form1_DockChanged")
End Sub
#If TRACE Then
#Region "Mouse event"
Private Sub Form1_MouseCaptureChanged(sender As Object, e As EventArgs) Handles Me.MouseCaptureChanged
Tracer("Form1_MouseCaptureChanged")
End Sub
Private Sub Form1_MouseEnter(sender As Object, e As EventArgs) Handles Me.MouseEnter
Tracer("Form1_MouseEnter")
End Sub
Private Sub Form1_MouseLeave(sender As Object, e As EventArgs) Handles Me.MouseLeave
Tracer("Form1_MouseLeave")
End Sub
Private Sub Form1_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
Tracer("Form1_MouseWheel")
End Sub
Private Sub Form1_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick
Tracer("Form1_MouseClick")
End Sub
Private Sub TextBox1_MouseEnter(sender As Object, e As EventArgs) Handles TextBox1.MouseEnter
Tracer("TextBox1_MouseEnter")
End Sub
Private Sub TextBox1_MouseLeave(sender As Object, e As EventArgs) Handles TextBox1.MouseLeave
Tracer("TextBox1_MouseLeave")
End Sub
Private Sub TextBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles TextBox1.MouseUp
Tracer("TextBox1_MouseUp")
End Sub
Private Sub TextBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles TextBox1.MouseDown
Tracer("TextBox1_MouseDown")
End Sub
Private Sub TextBox1_MouseClick(sender As Object, e As MouseEventArgs) Handles TextBox1.MouseClick
Tracer("TextBox1_MouseClick")
End Sub
Private Sub TextBox1_MouseHover(sender As Object, e As EventArgs) Handles TextBox1.MouseHover
Static ThreeTimes As Int32 = 3
If ThreeTimes = 0 Then Exit Sub
ThreeTimes -= 1
Tracer($"TextBox1_MouseHover({ThreeTimes})")
End Sub
Private Sub Form1_MouseHover(sender As Object, e As EventArgs) Handles Me.MouseHover
Tracer("Form1_MouseHover")
End Sub
#End Region
#Region "No use"
Private Sub Form1_MenuComplete(sender As Object, e As EventArgs) Handles Me.MenuComplete
Tracer("Form1_MenuComplete")
End Sub
Private Sub Form1_MenuStart(sender As Object, e As EventArgs) Handles Me.MenuStart
Tracer("Form1_MenuStart")
End Sub
Private Sub Form1_GiveFeedback(sender As Object, e As GiveFeedbackEventArgs) Handles Me.GiveFeedback
Tracer("Form1_GiveFeedback")
End Sub
Private Sub Form1_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd
Tracer("Form1_ResizeEnd")
End Sub
Private Sub Form1_ImeModeChanged(sender As Object, e As EventArgs) Handles Me.ImeModeChanged
Tracer("Form1_ImeModeChanged")
End Sub
Private Sub TextBox1_RegionChanged(sender As Object, e As EventArgs) Handles TextBox1.RegionChanged
Tracer("TextBox1_RegionChanged")
End Sub
#End Region
#End If
Friend WithEvents TextBox1 As TextBox
End Class
Module MyModule1
Public Dpi, PreviousDpi, OriginalDpi As Single
Public Const initial_Font_Size = 12.0!
Public Form1_Location As Point
Public Form1_Size As Size
Class CreateOneObject
Sub New(ByRef Event_Traces2 As Text.StringBuilder)
Event_Traces2 = New Text.StringBuilder
End Sub
End Class
Public Event_Traces As Text.StringBuilder
Public StartTo_Write_Into_TextBox1 As Boolean
Sub Tracer(str2 As String)
Static RunOnlyOnce As New CreateOneObject(Event_Traces)
Event_Traces.AppendLine(str2)
If StartTo_Write_Into_TextBox1 Then
If Form1.TextBox1.TextLength = 0 Then
Form1.TextBox1.Text = Event_Traces.ToString
Else
Form1.TextBox1.AppendText(str2 & vbNewLine)
End If
End If
End Sub
Sub DpiChange()
Try
Dim Font_Scaling As Single = Dpi / OriginalDpi
Form1.TextBox1.Font.Dispose()
Form1.TextBox1.Font = Create_Font(initial_Font_Size * Font_Scaling)
Dim Pos_Scaling As Single = Dpi / PreviousDpi
SetWindowPos(Form1.Handle, Form1.Handle,
CInt(Form1_Location.X * Pos_Scaling),
CInt(Form1_Location.Y * Pos_Scaling),
CInt(Form1_Size.Width * Pos_Scaling),
CInt(Form1_Size.Height * Pos_Scaling),
SWP_NOACTIVATE Or SWP_NOZORDER)
PreviousDpi = Dpi
Catch ex As Exception
MsgBox($"DpiChange error {ex.Message}")
End Try
End Sub
Public ReadOnly FontFamilyNames() As String = {
"SimSun", "MingLiU", "Courier New", "Cascadia Mono"}
Function Create_Font(fontsize As Single) As Font
For Each name As String In FontFamilyNames
Try
Dim [FontFamily] As FontFamily
[FontFamily] = New Drawing.FontFamily(name)
If [FontFamily] IsNot Nothing Then
Return New Drawing.Font([FontFamily], fontsize,
FontStyle.Regular, GraphicsUnit.Point, CType(0, Byte))
End If
Catch ex As Exception
End Try
Next
Throw New Exception("Font not found ---cheninnjer")
End Function
Sub Show_TracedEvents_By_MSedge()
Dim HtmlFilePath As String = IO.Path.Combine(IO.Path.GetTempPath, "Trace.html")
Using HtmlFile As New IO.StreamWriter(HtmlFilePath)
Event_Traces.Replace(vbNewLine, $"</li>{vbNewLine}<li>").Insert(0, "<li>").Length -= 4
HtmlFile.Write(
$"<!DocType html>
<html>
<head>
<title> Event tracers </title>
<style>
ol {{
color:black;
font-size:large;
background-color:yellow;
font-weight:600;
}}
</style>
</head>
<body>
<h2> List of event traces</h2>
<ol>
{Event_Traces}
</ol>
</body>
</html>")
End Using
Dim StartInfo As New ProcessStartInfo("msedge.exe", HtmlFilePath) With {.Verb = "open",
.WorkingDirectory = IO.Path.Combine(Environment.GetEnvironmentVariable("ProgramFiles(x86)"),
"\Microsoft\Edge\Application"), .UseShellExecute = True}
Process.Start(StartInfo)
End Sub
Declare Unicode Function GetSystemMetricsForDpi Lib "User32" (
_In_int_nIndex As Int32,
_In_UINT_dpi As Int32) As Int32
Declare Unicode Function SetWindowPos Lib "User32" (
_In_HWND_hWnd As IntPtr,
_In_opt_HWND_hWndInsertAfter As IntPtr,
_In_int_X As Int32,
_In_int_Y As Int32,
_In_int_cx As Int32,
_In_int_cy As Int32,
_In_UINT_uFlags As UInt32) As Boolean
Public Const SM_CXSCREEN As Int32 = 0
Public Const SM_CYSCREEN As Int32 = 1
Public Const WM_DPICHANGED As UInt32 = &H2E0
Public Const WM_DPICHANGED_BEFOREPARENT As UInt32 = &H2E2
Public Const WM_DPICHANGED_AFTERPARENT As UInt32 = &H2E3
Public Const WM_GETDPISCALEDSIZE As UInt32 = &H2E4
Public Const SWP_NOSIZE As UInt32 = &H1
Public Const SWP_NOMOVE As UInt32 = &H2
Public Const SWP_NOZORDER As UInt32 = &H4
Public Const SWP_NOREDRAW As UInt32 = &H8
Public Const SWP_NOACTIVATE As UInt32 = &H10
Public Const SWP_FRAMECHANGED As UInt32 = &H20 '/* The frame changed: send WM_NCCALCSIZE */
Public Const SWP_SHOWWINDOW As UInt32 = &H40
Public Const SWP_HIDEWINDOW As UInt32 = &H80
Public Const SWP_NOCOPYBITS As UInt32 = &H100
Public Const SWP_NOOWNERZORDER As UInt32 = &H200 '/* Don't do owner Z ordering */
Public Const SWP_NOSENDCHANGING As UInt32 = &H400 '/* Don't send WM_WINDOWPOSCHANGING */
Public Const SWP_DEFERERASE As UInt32 = &H2000
Public Const SWP_ASYNCWINDOWPOS As UInt32 = &H4000
Public Const SWP_DRAWFRAME As UInt32 = SWP_FRAMECHANGED
Public Const SWP_NOREPOSITION As UInt32 = SWP_NOOWNERZORDER
End Module