Imports System.IO Imports System.Text.RegularExpressions Module SuperAdaptive ''' ''' 详细解释请看说明文档,对齐位置请填写Left或者Center或者Right,严格大小写! ''' ''' ''' ''' 如果是否,则只操作一级容器和所有控件! ''' ''' Function 窗体坐标记录文件生成(窗体名字 As Form, 是否对所有容器操作 As Boolean, 对齐位置 As String, Optional 容器内对齐位置 As String = Nothing) Dim 现在的屏幕宽 As Integer = SystemInformation.PrimaryMonitorSize.Width Dim 现在的屏幕高 As Integer = SystemInformation.PrimaryMonitorSize.Height Dim g_path As String Dim a_path As String g_path = Application.StartupPath & "\Location" a_path = Application.StartupPath & "\Location\" & 窗体名字.Name If Directory.Exists(g_path) = True And Directory.Exists(a_path) = True Then Else Directory.CreateDirectory(g_path) Directory.CreateDirectory(a_path) End If If Not System.IO.File.Exists(Application.StartupPath & "\Location\" & 窗体名字.Name & "\" & 窗体名字.Name & ".config") Then System.IO.File.Create(Application.StartupPath & "\Location\" & 窗体名字.Name & "\" & 窗体名字.Name & ".config").Dispose() Dim 控件名称 As String Dim 位置信息 As String Dim 控件大小 As String Dim 字体 As String For Each con As Control In 窗体名字.Controls If 对齐位置 = "Center" Then 位置信息 = 位置信息 & vbCrLf & con.Location.X + con.Width / 2 & "," & con.Location.Y + con.Height / 2 End If If 对齐位置 = "Left" Then 位置信息 = 位置信息 & vbCrLf & con.Location.X & "," & con.Location.Y End If If 对齐位置 = "Right" Then 位置信息 = 位置信息 & vbCrLf & con.Location.X + con.Width & "," & con.Location.Y End If 控件大小 = 控件大小 & vbCrLf & con.Width & "," & con.Height 控件名称 = 控件名称 & vbCrLf & con.Name Try 字体 = 字体 & vbCrLf & con.Font.Name & "," & con.Font.Size & "," & con.Font.Bold Catch 字体 = 字体 & vbCrLf & "nothing,nothing,nothing|" End Try If 是否对所有容器操作 = True Then Dim 容器数组(6) As String 容器数组(0) = "Panel" 容器数组(1) = "GroupBox" 容器数组(2) = "TabControl" 容器数组(3) = "SplitContainer" 容器数组(4) = "FlowLayoutPanel" 容器数组(5) = "TableLayoutPanel" 容器数组(6) = "TabPage" For i = 0 To 6 If TypeName(con) = 容器数组(i) Then If 容器内对齐位置 = Nothing Then 容器坐标记录文件生成(窗体名字, 窗体名字, con, 对齐位置) Else 容器坐标记录文件生成(窗体名字, 窗体名字, con, 容器内对齐位置) End If End If Next End If Next File.WriteAllText(Application.StartupPath & "\Location\" & 窗体名字.Name & "\" & 窗体名字.Name & ".config", "dll作者:2022级川北医学院麻醉学系5班罗子甯" & vbCrLf & "意见及更新建议:" & "1426887@qq.com" & vbCrLf & "对齐方式:" & 对齐位置 & vbCrLf & "smds:" & 屏幕宽 & vbCrLf & "smds:" & 屏幕高 & vbCrLf & "smds:" & 位置信息 & vbCrLf & "smds:" & 控件名称 & vbCrLf & "smds:" & 字体 & vbCrLf & "smds:" & 窗体名字.Width & vbCrLf & "smds:" & 窗体名字.Height & vbCrLf & "smds:" & 控件大小) End If End Function Function 容器坐标记录文件生成(主窗体名 As Form, 父容器名 As Control, 容器 As Control, 对齐位置 As String) If Not System.IO.File.Exists(Application.StartupPath & "\Location\" & 主窗体名.Name & "\" & 父容器名.Name & 容器.Name & ".config") Then System.IO.File.Create(Application.StartupPath & "\Location\" & 主窗体名.Name & "\" & 父容器名.Name & 容器.Name & ".config").Dispose() Dim 控件名称 As String Dim 位置信息 As String Dim 控件大小 As String Dim 字体 As String For Each con As Control In 容器.Controls If 对齐位置 = "Center" Then 位置信息 = 位置信息 & vbCrLf & con.Location.X + con.Width / 2 & "," & con.Location.Y + con.Height / 2 End If If 对齐位置 = "Left" Then 位置信息 = 位置信息 & vbCrLf & con.Location.X & "," & con.Location.Y End If If 对齐位置 = "Right" Then 位置信息 = 位置信息 & vbCrLf & con.Location.X + con.Width & "," & con.Location.Y End If 控件大小 = 控件大小 & vbCrLf & con.Width & "," & con.Height 控件名称 = 控件名称 & vbCrLf & con.Name Try 字体 = 字体 & vbCrLf & con.Font.Name & "," & con.Font.Size & "," & con.Font.Bold Catch 字体 = 字体 & vbCrLf & "nothing,nothing,nothing|" End Try Dim 容器数组(6) As String 容器数组(0) = "Panel" 容器数组(1) = "GroupBox" 容器数组(2) = "TabControl" 容器数组(3) = "SplitContainer" 容器数组(4) = "FlowLayoutPanel" 容器数组(5) = "TableLayoutPanel" 容器数组(6) = "TabPage" For i = 0 To 6 If TypeName(con) = 容器数组(i) Then 容器坐标记录文件生成(主窗体名, 容器, con, 对齐位置) End If Next Next File.WriteAllText(Application.StartupPath & "\Location\" & 主窗体名.Name & "\" & 父容器名.Name & 容器.Name & ".config", "dll作者:2022级川北医学院麻醉学系5班罗子甯" & vbCrLf & "意见及更新建议:" & "1426887@qq.com" & vbCrLf & "对齐方式:" & 对齐位置 & vbCrLf & "smds:" & 屏幕宽 & vbCrLf & "smds:" & 屏幕高 & vbCrLf & "smds:" & 位置信息 & vbCrLf & "smds:" & 控件名称 & vbCrLf & "smds:" & 字体 & vbCrLf & "smds:" & 容器.Width & vbCrLf & "smds:" & 容器.Height & vbCrLf & "smds:" & 控件大小) End If End Function Function 窗体坐标记录文件分析(窗体名字 As Form, 是否对所有容器进行操作 As Boolean, Optional SMDS字体修正专用 As Boolean = False) Dim 现在的屏幕宽 As Integer = SystemInformation.PrimaryMonitorSize.Width Dim 现在的屏幕高 As Integer = SystemInformation.PrimaryMonitorSize.Height Dim 内存储存数组容量 As Integer = 0 Dim 内存存储数组(内存储存数组容量) As String Dim 内存储存数组分割器容量 As Integer = 0 Dim 内存存储数组分割器(内存储存数组分割器容量) As Integer If System.IO.File.Exists(Application.StartupPath & "\Location\" & 窗体名字.Name & "\" & 窗体名字.Name & ".config") Then Dim 阅读器 As New StreamReader(Application.StartupPath & "\Location\" & 窗体名字.Name & "\" & 窗体名字.Name & ".config") Dim textcontain As String '先读取一行文件 textcontain = 阅读器.ReadLine() Do While Not IsNothing(textcontain) 内存存储数组(内存储存数组容量) = textcontain 内存储存数组容量 = 内存储存数组容量 + 1 ReDim Preserve 内存存储数组(内存储存数组容量) If Mid(内存存储数组(内存储存数组容量 - 1), 1, 5) = "smds:" Then 内存存储数组分割器(内存储存数组分割器容量) = 内存储存数组容量 - 1 内存储存数组分割器容量 = 内存储存数组分割器容量 + 1 ReDim Preserve 内存存储数组分割器(内存储存数组分割器容量) End If '3,4'5'12'19'26'27'28 textcontain = 阅读器.ReadLine() Loop 阅读器.Close() If 是否对所有容器进行操作 = True Then For Each con As Control In 窗体名字.Controls Dim 容器数组(6) As String 容器数组(0) = "Panel" 容器数组(1) = "GroupBox" 容器数组(2) = "TabControl" 容器数组(3) = "SplitContainer" 容器数组(4) = "FlowLayoutPanel" 容器数组(5) = "TableLayoutPanel" 容器数组(6) = "TabPage" '对二级容器控件进行操作 For i = 0 To 6 If TypeName(con) = 容器数组(i) Then 容器坐标记录文件分析(窗体名字, 窗体名字, con, True) End If Next Next '仅对一级容器进行窗体自适应 '第一步,取出原来的屏幕宽度和原来的屏幕高度 Dim 原来的屏幕宽 As Integer = Mid(内存存储数组(3), 6) Dim 原来的屏幕高 As Integer = Mid(内存存储数组(4), 6) '第二步,取出要求的对齐方式 Dim 对齐方式 As String = Mid(内存存储数组(2), 6) '第三步,取出坐标,控件,字体,大小信息 '确定坐标的总数目 首先我们来获取第三个smds的index--内存存储数组分割器(2)-5 第四个smds的位置--内存存储数组分割器(3)-12 '坐标的总数目就是 内存存储数组分割器(3)-内存存储数组分割器(2) - 1 Dim 原来坐标(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的坐标 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来坐标(i) = 内存存储数组(内存存储数组分割器(2) + i) Next Dim 原来控件名字(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的控件名字 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来控件名字(i) = 内存存储数组(内存存储数组分割器(3) + i) Next Dim 原来字体(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的字体数据 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来字体(i) = 内存存储数组(内存存储数组分割器(4) + i) Next Dim 原来控件大小(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的大小数据 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来控件大小(i) = 内存存储数组(内存存储数组分割器(7) + i) Next '第四步,获取窗体原来大小 Dim 原来的窗体宽度 As Integer = Mid(内存存储数组(内存存储数组分割器(5)), 6) Dim 原来的窗体高度 As Integer = Mid(内存存储数组(内存存储数组分割器(6)), 6) '至此该文件所有信息已抽离完毕,开始进行分析 '这里表示窗体与整个电脑原来的锁定比例 Dim 宽比例 = 原来的窗体宽度 / 原来的屏幕宽 Dim 高比例 = 原来的窗体高度 / 原来的屏幕高 '利用此比例让我们设定现在窗体的大小 窗体名字.Width = 现在的屏幕宽 * 宽比例 窗体名字.Height = 现在的屏幕高 * 高比例 Dim 原来的控件宽度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件高度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件坐标x(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件坐标y(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件宽度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件高度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件坐标x(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件坐标y(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer '下面开始安顿控件,首先是取出容易处理的宽和高,以及我们要用的坐标,还有我们的字体信息 For I = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 Dim 缓存数组1() = Split(原来控件大小(I), ",") Dim 缓存数组2() = Split(原来坐标(I), ",") 原来的控件宽度(I) = 缓存数组1(0) 原来的控件高度(I) = 缓存数组1(1) 原来的控件坐标x(I) = 缓存数组2(0) 原来的控件坐标y(I) = 缓存数组2(1) '接着我们计算出现在的这些东西 现在的控件宽度(I) = 原来的控件宽度(I) * 窗体名字.Width / 原来的窗体宽度 现在的控件高度(I) = 原来的控件高度(I) * 窗体名字.Height / 原来的窗体高度 现在的控件坐标x(I) = 原来的控件坐标x(I) * 现在的屏幕宽 / 原来的屏幕宽 现在的控件坐标y(I) = 原来的控件坐标y(I) * 现在的屏幕高 / 原来的屏幕高 Next '完毕,让我们开始写入! '首先设定和对齐方式Location属性无关的大小,和字体 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 '设定大小 窗体名字.Controls(原来控件名字(i)).Size = New Size(现在的控件宽度(i), 现在的控件高度(i)) Dim 字体具体信息() As String = Split(原来字体(i), ",") If 字体具体信息(2) = True Then 窗体名字.Controls(原来控件名字(i)).Font = New Font(字体具体信息(0), CSng(字体具体信息(1)) * 现在的屏幕高 / 原来的屏幕高, FontStyle.Bold, GraphicsUnit.Pixel) Else 窗体名字.Controls(原来控件名字(i)).Font = New Font(字体具体信息(0), CSng(字体具体信息(1)) * 现在的屏幕高 / 原来的屏幕高, GraphicsUnit.Pixel) End If '大小设定完毕,接下来处理我们的对齐方式,怎么对齐就怎么把它还回去 If 对齐方式 = "Left" Then 窗体名字.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i), 现在的控件坐标y(i)) End If If 对齐方式 = "Center" Then 窗体名字.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i) - 现在的控件宽度(i) / 2, 现在的控件坐标y(i) - 现在的控件高度(i) / 2) End If If 对齐方式 = "Right" Then 窗体名字.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i) - 现在的控件宽度(i), 现在的控件坐标y(i)) End If '搞定。 Next If SMDS字体修正专用 = True Then 文字统一风格 = New Font("华文细黑", CSng(18 * 现在的屏幕高 / 原来的屏幕高), GraphicsUnit.Pixel) 按钮统一风格 = New Font("华文细黑", CSng(15 * 现在的屏幕高 / 原来的屏幕高), GraphicsUnit.Pixel) 文字统一风格加倍 = New Font("华文细黑", 文字统一风格.Size * 2, GraphicsUnit.Pixel) 文字统一风格12 = New Font("华文细黑", 文字统一风格.Size * 12 / 9, GraphicsUnit.Pixel) 文字统一风格10 = New Font("华文细黑", 文字统一风格.Size * 10 / 9, GraphicsUnit.Pixel) 文字统一风格6 = New Font("华文细黑", 文字统一风格.Size * 6 / 9, GraphicsUnit.Pixel) 文字统一风格14 = New Font("华文细黑", 文字统一风格.Size * 14 / 9, GraphicsUnit.Pixel) 过时提醒风格 = New Font("黑体", 文字统一风格.Size * 14 / 18, GraphicsUnit.Pixel) 流转视图大文字统一风格 = New Font("华文细黑", 文字统一风格.Size * 2, GraphicsUnit.Pixel) 系统信息x专用 = New Font("华文细黑", 文字统一风格.Size * 2, GraphicsUnit.Pixel) 系统信息x专用2 = New Font("Verdana", 文字统一风格.Size * 2, GraphicsUnit.Pixel) End If Else '仅对一级容器进行窗体自适应 '第一步,取出原来的屏幕宽度和原来的屏幕高度 Dim 原来的屏幕宽 As Integer = Mid(内存存储数组(3), 6) Dim 原来的屏幕高 As Integer = Mid(内存存储数组(4), 6) '第二步,取出要求的对齐方式 Dim 对齐方式 As String = Mid(内存存储数组(2), 6) '第三步,取出坐标,控件,字体,大小信息 '确定坐标的总数目 首先我们来获取第三个smds的index--内存存储数组分割器(2)-5 第四个smds的位置--内存存储数组分割器(3)-12 '坐标的总数目就是 内存存储数组分割器(3)-内存存储数组分割器(2) - 1 Dim 原来坐标(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的坐标 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来坐标(i) = 内存存储数组(内存存储数组分割器(2) + i) Next Dim 原来控件名字(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的控件名字 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来控件名字(i) = 内存存储数组(内存存储数组分割器(3) + i) Next Dim 原来字体(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的字体数据 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来字体(i) = 内存存储数组(内存存储数组分割器(4) + i) Next Dim 原来控件大小(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的大小数据 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来控件大小(i) = 内存存储数组(内存存储数组分割器(7) + i) Next '第四步,获取窗体原来大小 Dim 原来的窗体宽度 As Integer = Mid(内存存储数组(内存存储数组分割器(5)), 6) Dim 原来的窗体高度 As Integer = Mid(内存存储数组(内存存储数组分割器(6)), 6) '至此该文件所有信息已抽离完毕,开始进行分析 '这里表示窗体与整个电脑原来的锁定比例 Dim 宽比例 = 原来的窗体宽度 / 原来的屏幕宽 Dim 高比例 = 原来的窗体高度 / 原来的屏幕高 '利用此比例让我们设定现在窗体的大小 窗体名字.Width = 现在的屏幕宽 * 宽比例 窗体名字.Height = 现在的屏幕高 * 高比例 Dim 原来的控件宽度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件高度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件坐标x(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件坐标y(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件宽度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件高度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件坐标x(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件坐标y(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer '下面开始安顿控件,首先是取出容易处理的宽和高,以及我们要用的坐标,还有我们的字体信息 For I = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 Dim 缓存数组1() = Split(原来控件大小(I), ",") Dim 缓存数组2() = Split(原来坐标(I), ",") 原来的控件宽度(I) = 缓存数组1(0) 原来的控件高度(I) = 缓存数组1(1) 原来的控件坐标x(I) = 缓存数组2(0) 原来的控件坐标y(I) = 缓存数组2(1) '接着我们计算出现在的这些东西 现在的控件宽度(I) = 原来的控件宽度(I) * 窗体名字.Width / 原来的窗体宽度 现在的控件高度(I) = 原来的控件高度(I) * 窗体名字.Height / 原来的窗体高度 现在的控件坐标x(I) = 原来的控件坐标x(I) * 现在的屏幕宽 / 原来的屏幕宽 现在的控件坐标y(I) = 原来的控件坐标y(I) * 现在的屏幕高 / 原来的屏幕高 Next '完毕,让我们开始写入! '首先设定和对齐方式Location属性无关的大小,和字体 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 '设定大小 窗体名字.Controls(原来控件名字(i)).Size = New Size(现在的控件宽度(i), 现在的控件高度(i)) Dim 字体具体信息() As String = Split(原来字体(i), ",") If 字体具体信息(2) = True Then 窗体名字.Controls(原来控件名字(i)).Font = New Font(字体具体信息(0), CSng(字体具体信息(1)) * 现在的屏幕高 / 原来的屏幕高, FontStyle.Bold, GraphicsUnit.Pixel) Else 窗体名字.Controls(原来控件名字(i)).Font = New Font(字体具体信息(0), CSng(字体具体信息(1)) * 现在的屏幕高 / 原来的屏幕高, GraphicsUnit.Pixel) End If '大小设定完毕,接下来处理我们的对齐方式,怎么对齐就怎么把它还回去 If 对齐方式 = "Left" Then 窗体名字.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i), 现在的控件坐标y(i)) End If If 对齐方式 = "Center" Then 窗体名字.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i) - 现在的控件宽度(i) / 2, 现在的控件坐标y(i) - 现在的控件高度(i) / 2) End If If 对齐方式 = "Right" Then 窗体名字.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i) - 现在的控件宽度(i), 现在的控件坐标y(i)) End If '搞定。 Next If SMDS字体修正专用 = True Then 文字统一风格 = New Font("华文细黑", CSng(18 * 现在的屏幕高 / 原来的屏幕高), GraphicsUnit.Pixel) 按钮统一风格 = New Font("华文细黑", CSng(15 * 现在的屏幕高 / 原来的屏幕高), GraphicsUnit.Pixel) 文字统一风格加倍 = New Font("华文细黑", 文字统一风格.Size * 2, GraphicsUnit.Pixel) 文字统一风格12 = New Font("华文细黑", 文字统一风格.Size * 12 / 9, GraphicsUnit.Pixel) 文字统一风格10 = New Font("华文细黑", 文字统一风格.Size * 10 / 9, GraphicsUnit.Pixel) 文字统一风格6 = New Font("华文细黑", 文字统一风格.Size * 6 / 9, GraphicsUnit.Pixel) 文字统一风格14 = New Font("华文细黑", 文字统一风格.Size * 14 / 9, GraphicsUnit.Pixel) 过时提醒风格 = New Font("黑体", 文字统一风格.Size * 14 / 18, GraphicsUnit.Pixel) 流转视图大文字统一风格 = New Font("华文细黑", 文字统一风格.Size * 2, GraphicsUnit.Pixel) 系统信息x专用 = New Font("华文细黑", 文字统一风格.Size * 2, GraphicsUnit.Pixel) 系统信息x专用2 = New Font("Verdana", 文字统一风格.Size * 2, GraphicsUnit.Pixel) End If End If Else MsgBox("坐标文件缺失!") End If End Function Function 容器坐标记录文件分析(主窗体名 As Form, 父容器名 As Control, 容器 As Control, 是否对所有容器进行操作 As Boolean) '父容器名 =tabcon 容器 tabpage1 Dim 现在的屏幕宽 As Integer = SystemInformation.PrimaryMonitorSize.Width Dim 现在的屏幕高 As Integer = SystemInformation.PrimaryMonitorSize.Height Dim 内存储存数组容量 As Integer = 0 Dim 内存存储数组(内存储存数组容量) As String Dim 内存储存数组分割器容量 As Integer = 0 Dim 内存存储数组分割器(内存储存数组分割器容量) As Integer If System.IO.File.Exists(Application.StartupPath & "\Location\" & 主窗体名.Name & "\" & 父容器名.Name & 容器.Name & ".config") Then Dim 阅读器 As New StreamReader(Application.StartupPath & "\Location\" & 主窗体名.Name & "\" & 父容器名.Name & 容器.Name & ".config") Dim textcontain As String '先读取一行文件 textcontain = 阅读器.ReadLine() Do While Not IsNothing(textcontain) 内存存储数组(内存储存数组容量) = textcontain 内存储存数组容量 = 内存储存数组容量 + 1 ReDim Preserve 内存存储数组(内存储存数组容量) If Mid(内存存储数组(内存储存数组容量 - 1), 1, 5) = "smds:" Then 内存存储数组分割器(内存储存数组分割器容量) = 内存储存数组容量 - 1 内存储存数组分割器容量 = 内存储存数组分割器容量 + 1 ReDim Preserve 内存存储数组分割器(内存储存数组分割器容量) End If '3,4'5'12'19'26'27'28 textcontain = 阅读器.ReadLine() Loop 阅读器.Close() If 是否对所有容器进行操作 = True Then For Each con As Control In 容器.Controls Dim 容器数组(6) As String 容器数组(0) = "Panel" 容器数组(1) = "GroupBox" 容器数组(2) = "TabControl" 容器数组(3) = "SplitContainer" 容器数组(4) = "FlowLayoutPanel" 容器数组(5) = "TableLayoutPanel" 容器数组(6) = "TabPage" '对二级容器控件进行操作 For i = 0 To 6 If TypeName(con) = 容器数组(i) Then 容器坐标记录文件分析(主窗体名, 容器, con, True) End If Next Next '仅对一级容器进行窗体自适应 '第一步,取出原来的屏幕宽度和原来的屏幕高度 Dim 原来的屏幕宽 As Integer = Mid(内存存储数组(3), 6) Dim 原来的屏幕高 As Integer = Mid(内存存储数组(4), 6) '第二步,取出要求的对齐方式 Dim 对齐方式 As String = Mid(内存存储数组(2), 6) '第三步,取出坐标,控件,字体,大小信息 '确定坐标的总数目 首先我们来获取第三个smds的index--内存存储数组分割器(2)-5 第四个smds的位置--内存存储数组分割器(3)-12 '坐标的总数目就是 内存存储数组分割器(3)-内存存储数组分割器(2) - 1 Dim 原来坐标(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的坐标 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来坐标(i) = 内存存储数组(内存存储数组分割器(2) + i) Next Dim 原来控件名字(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的控件名字 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来控件名字(i) = 内存存储数组(内存存储数组分割器(3) + i) Next Dim 原来字体(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的字体数据 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来字体(i) = 内存存储数组(内存存储数组分割器(4) + i) Next Dim 原来控件大小(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的大小数据 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来控件大小(i) = 内存存储数组(内存存储数组分割器(7) + i) Next '第四步,获取窗体原来大小 Dim 原来的窗体宽度 As Integer = Mid(内存存储数组(内存存储数组分割器(5)), 6) Dim 原来的窗体高度 As Integer = Mid(内存存储数组(内存存储数组分割器(6)), 6) '至此该文件所有信息已抽离完毕,开始进行分析 '这里表示窗体与整个电脑原来的锁定比例 Dim 宽比例 = 原来的窗体宽度 / 原来的屏幕宽 Dim 高比例 = 原来的窗体高度 / 原来的屏幕高 '利用此比例让我们设定现在窗体的大小 容器.Width = 现在的屏幕宽 * 宽比例 容器.Height = 现在的屏幕高 * 高比例 'MsgBox("当前屏幕宽度为" & 现在的屏幕宽 & "当前屏幕高度为" & 现在的屏幕高 & "因此现在的宽放缩比为" & 宽比例 & "因此现在的高放缩比为" & 高比例) Dim 原来的控件宽度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件高度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件坐标x(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件坐标y(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件宽度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件高度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件坐标x(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件坐标y(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer '下面开始安顿控件,首先是取出容易处理的宽和高,以及我们要用的坐标,还有我们的字体信息 For I = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 Dim 缓存数组1() = Split(原来控件大小(I), ",") Dim 缓存数组2() = Split(原来坐标(I), ",") 原来的控件宽度(I) = 缓存数组1(0) 原来的控件高度(I) = 缓存数组1(1) 原来的控件坐标x(I) = 缓存数组2(0) 原来的控件坐标y(I) = 缓存数组2(1) '接着我们计算出现在的这些东西 现在的控件宽度(I) = 原来的控件宽度(I) * 容器.Width / 原来的窗体宽度 现在的控件高度(I) = 原来的控件高度(I) * 容器.Height / 原来的窗体高度 现在的控件坐标x(I) = 原来的控件坐标x(I) * 现在的屏幕宽 / 原来的屏幕宽 现在的控件坐标y(I) = 原来的控件坐标y(I) * 现在的屏幕高 / 原来的屏幕高 Next '完毕,让我们开始写入! '首先设定和对齐方式Location属性无关的大小,和字体 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 '设定大小 容器.Controls(原来控件名字(i)).Size = New Size(现在的控件宽度(i), 现在的控件高度(i)) Dim 字体具体信息() As String = Split(原来字体(i), ",") If 字体具体信息(2) = True Then 容器.Controls(原来控件名字(i)).Font = New Font(字体具体信息(0), CSng(字体具体信息(1)) * 现在的屏幕高 / 原来的屏幕高, FontStyle.Bold, GraphicsUnit.Pixel) Else 容器.Controls(原来控件名字(i)).Font = New Font(字体具体信息(0), CSng(字体具体信息(1)) * 现在的屏幕高 / 原来的屏幕高, GraphicsUnit.Pixel) End If '大小设定完毕,接下来处理我们的对齐方式,怎么对齐就怎么把它还回去 If 对齐方式 = "Left" Then 容器.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i), 现在的控件坐标y(i)) End If If 对齐方式 = "Center" Then 容器.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i) - 现在的控件宽度(i) / 2, 现在的控件坐标y(i) - 现在的控件高度(i) / 2) End If If 对齐方式 = "Right" Then 容器.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i) - 现在的控件宽度(i), 现在的控件坐标y(i)) End If '搞定。 Next Else '仅对一级容器进行窗体自适应 '第一步,取出原来的屏幕宽度和原来的屏幕高度 Dim 原来的屏幕宽 As Integer = Mid(内存存储数组(3), 6) Dim 原来的屏幕高 As Integer = Mid(内存存储数组(4), 6) '第二步,取出要求的对齐方式 Dim 对齐方式 As String = Mid(内存存储数组(2), 6) '第三步,取出坐标,控件,字体,大小信息 '确定坐标的总数目 首先我们来获取第三个smds的index--内存存储数组分割器(2)-5 第四个smds的位置--内存存储数组分割器(3)-12 '坐标的总数目就是 内存存储数组分割器(3)-内存存储数组分割器(2) - 1 Dim 原来坐标(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的坐标 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来坐标(i) = 内存存储数组(内存存储数组分割器(2) + i) Next Dim 原来控件名字(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的控件名字 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来控件名字(i) = 内存存储数组(内存存储数组分割器(3) + i) Next Dim 原来字体(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的字体数据 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来字体(i) = 内存存储数组(内存存储数组分割器(4) + i) Next Dim 原来控件大小(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As String '开始存入我们的大小数据 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 原来控件大小(i) = 内存存储数组(内存存储数组分割器(7) + i) Next '第四步,获取窗体原来大小 Dim 原来的窗体宽度 As Integer = Mid(内存存储数组(内存存储数组分割器(5)), 6) Dim 原来的窗体高度 As Integer = Mid(内存存储数组(内存存储数组分割器(6)), 6) '至此该文件所有信息已抽离完毕,开始进行分析 '这里表示窗体与整个电脑原来的锁定比例 Dim 宽比例 = 原来的窗体宽度 / 原来的屏幕宽 Dim 高比例 = 原来的窗体高度 / 原来的屏幕高 '利用此比例让我们设定现在窗体的大小 容器.Width = 现在的屏幕宽 * 宽比例 容器.Height = 现在的屏幕高 * 高比例 'MsgBox("当前屏幕宽度为" & 现在的屏幕宽 & "当前屏幕高度为" & 现在的屏幕高 & "因此现在的宽放缩比为" & 宽比例 & "因此现在的高放缩比为" & 高比例) Dim 原来的控件宽度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件高度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件坐标x(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 原来的控件坐标y(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件宽度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件高度(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件坐标x(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer Dim 现在的控件坐标y(内存存储数组分割器(3) - 内存存储数组分割器(2) - 1) As Integer '下面开始安顿控件,首先是取出容易处理的宽和高,以及我们要用的坐标,还有我们的字体信息 For I = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 Dim 缓存数组1() = Split(原来控件大小(I), ",") Dim 缓存数组2() = Split(原来坐标(I), ",") 原来的控件宽度(I) = 缓存数组1(0) 原来的控件高度(I) = 缓存数组1(1) 原来的控件坐标x(I) = 缓存数组2(0) 原来的控件坐标y(I) = 缓存数组2(1) '接着我们计算出现在的这些东西 现在的控件宽度(I) = 原来的控件宽度(I) * 容器.Width / 原来的窗体宽度 现在的控件高度(I) = 原来的控件高度(I) * 容器.Height / 原来的窗体高度 现在的控件坐标x(I) = 原来的控件坐标x(I) * 现在的屏幕宽 / 原来的屏幕宽 现在的控件坐标y(I) = 原来的控件坐标y(I) * 现在的屏幕高 / 原来的屏幕高 Next '完毕,让我们开始写入! '首先设定和对齐方式Location属性无关的大小,和字体 For i = 1 To 内存存储数组分割器(3) - 内存存储数组分割器(2) - 1 '设定大小 容器.Controls(原来控件名字(i)).Size = New Size(现在的控件宽度(i), 现在的控件高度(i)) Dim 字体具体信息() As String = Split(原来字体(i), ",") If 字体具体信息(2) = True Then 容器.Controls(原来控件名字(i)).Font = New Font(字体具体信息(0), CSng(字体具体信息(1)) * 现在的屏幕高 / 原来的屏幕高, FontStyle.Bold, GraphicsUnit.Pixel) Else 容器.Controls(原来控件名字(i)).Font = New Font(字体具体信息(0), CSng(字体具体信息(1)) * 现在的屏幕高 / 原来的屏幕高, GraphicsUnit.Pixel) End If '大小设定完毕,接下来处理我们的对齐方式,怎么对齐就怎么把它还回去 If 对齐方式 = "Left" Then 容器.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i), 现在的控件坐标y(i)) End If If 对齐方式 = "Center" Then 容器.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i) - 现在的控件宽度(i) / 2, 现在的控件坐标y(i) - 现在的控件高度(i) / 2) End If If 对齐方式 = "Right" Then 容器.Controls(原来控件名字(i)).Location = New Point(现在的控件坐标x(i) - 现在的控件宽度(i), 现在的控件坐标y(i)) End If '搞定。 Next End If Else MsgBox("坐标文件缺失!") End If End Function End Module