vb.net 控件(包括字体)随窗体按比例缩放

    技术2025-02-14  13

    Public Class frmDl

        Dim x As Single = 0

        Dim y As Single = 0

     

        Private Sub frmDl_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

            x = Me.Width

            y = Me.Height

            setTag(Me)

        End Sub

        '递归取控件的原始大小和位置,用tag来纪录

        Private Sub setTag(ByVal obj As Object)

            For Each con As Control In obj.Controls

                con.Tag = con.Width & ":" & con.Height & ":" & con.Left & ":" & con.Top & ":" & con.Font.Size

                '如果是容器控件,则递归继续纪录

                If con.Controls.Count > 0 Then

                    setTag(con)

                End If

            Next

        End Sub

        '递归重新设定控件的大小和位置

        Private Sub setControls(ByVal newx As Single, ByVal newy As Single, ByVal obj As Object)

            For Each con As Control In obj.Controls

                con.AutoSize = False

                Dim mytag() As String = con.Tag.ToString.Split(":")

                con.Width = mytag(0) * newx

                con.Height = mytag(1) * newy

                con.Left = mytag(2) * newx

                con.Top = mytag(3) * newy

                '计算字体缩放比例,缩放字体

                Dim currentSize As Single = (mytag(1) * newy * mytag(4)) / mytag(1)

                con.Font = New Font(con.Font.Name, currentSize, _

                    con.Font.Style, con.Font.Unit)

                '如果是容器控件,则递归继续缩放

                If con.Controls.Count > 0 Then

                    setControls(newx, newy, con)

                End If

            Next

        End Sub

     

        Private Sub frmDl_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize

            '得到现在窗体的大小,然后根据原始大小计算缩放比例

            Dim newx As Single = Me.Width / x

            Dim newy As Single = Me.Height / y

            setControls(newx, newy, Me)

        End Sub

    End Class

     

    最新回复(0)