最近有个网友问我屏幕自适应的问题,即如果屏幕的分辨率改变了,窗体也能适应屏幕的大小,不至于有些控件不能显示。其实代码还是很简单的,我不喜欢讲很多的原理啊什么的,直接上代码。所有代码可直接复制测试。方便后来人参考吧
- <pre name="code" class="vb">'**********************************************
- '作者:章鱼哥,QQ:3107073263 群:309816713
- '如有疑问或好的建议请联系我,大家一起进步
- '**********************************************
- Imports System.Windows.Forms
- Public Class Form1
- Dim Ini_Screen_Width As Integer = 1366 '开发时屏幕宽度
- Dim Ini_Screen_Height As Integer = 768 '开发时屏幕高度
- Dim Scale_X As Double '屏幕缩放比例
- Dim scale_Y As Double '屏幕缩放比例
- Private Sub Form1_Load(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles MyBase.Load
- Dim Screen_Width As Integer = Screen.PrimaryScreen.Bounds.Width '当前屏幕的宽
- Dim Screen_Height As Integer = Screen.PrimaryScreen.Bounds.Height '当前屏幕的高
- '计算当前屏幕与开发时的屏幕的缩放比例
- Scale_X = Screen_Width / Ini_Screen_Width
- scale_Y = Screen_Height / Ini_Screen_Height
- ' MsgBox(Screen_Width & "*" & Screen_Height)
- '如果缩放比例为1,则不进行下面的操作
- If Scale_X = 1 And scale_Y = 1 Then
- Exit Sub
- End If
- '更新控件的大小
- Resize_Control()
- End Sub
- Private Sub Resize_Control()
- Me.Width = Me.Width * Scale_X
- Me.Height = Me.Height * scale_Y
- For Each cont As Control In Me.Controls
- UpdateControl(cont)
- Next
- End Sub
- Private Sub UpdateControl(ByVal Contr As Control)
- If Contr.Controls.Count > 0 Then
- For Each con As Control In Contr.Controls
- UpdateControl(con)
- With con
- .Width *= Scale_X '宽度
- .Height *= scale_Y '高度
- .Location = New Point(.Location.X * Scale_X,.Location.Y * scale_Y) '更新位置
- .Font = New Font(.Font.Name,.Font.Size * (Scale_X + scale_Y) / 2) '更新字体
- End With
- Next
- End If
- End Sub
- End Class