none
שינוי גודל פונט תואם רזולוציה VB.NET , WINDOWS FORM RRS feed

  • שאלה

  • שלום,

    אני כותבת ב- VB.NET ב- WINDOWS FORM

    ואני יוצרת טופס ראשי שמתפרס על כל המסך,שבנוי עבור רזולוצייה 1920 על 1080 

    ואני רוצה שהוא יתאים לכל הרזולוציות.

    אז עשיתי פונקצייה שעוברת על כל הפקדים בטופס ומשנה להם את הגודל באופו יחסי.

    הבעייה היא שאכן הכל מסתדר יפה פרט לגודל של הכתב. בייחוד כאשר אני רוצה להתאים את הטופס למסך שמוגדר לאורך. (כגון 1080 על 1920)

    אני מצרפת את הפונקציות:

    הפונקצייה שכתובה בקטע קוד השני היא העיקרית. 

    ' הפונקצייה מקבלת את הגודל המקורי ואת הגודל שאליו רוצים לשנות וכן את 
    ' הטפס שאותו רוצים לשנות     
    
    Public Shared Sub ResizeResolutionAll(ByRef f As Form, Xres As Double, Yres As Double, ByRef newResH As Integer, ByRef newResW As Integer)
            Try
    
    
                SyncLock lock
    
                    If newResH = 1080 And newResW = 1920 Then
    
                    Else
    
                        Dim screenWidth As Integer = newResW 'Screen.PrimaryScreen.Bounds.Width
                        Dim screenHeight As Integer = newResH 'Screen.PrimaryScreen.Bounds.Height
    
    
    
                        Dim sW As Double = screenWidth / Xres
                        Dim sH As Double = screenHeight / Yres
    
                        For Each item As Control In f.Controls
    
                            changeAnchor(item, sH, sW)
    
                        Next
    
                        f.Size = New Size(newResW, newResH)
    
                    End If
    
                End SyncLock
    
            Catch ex As Exception
    
            End Try
        End Sub

    וכעת זו הפונקציה שמשנה בפועל:

      Public Shared Sub changeAnchor(ByRef control As Control, ByVal SFX As Single, ByVal SFY As Single)
    
            Dim s As Size = New Size(control.Width, control.Height)
    
            control.Left = control.Left * SFY
            control.Top = control.Top * SFX
            control.Width = control.Width * SFY
            control.Height = control.Height * SFX
    
    
            If IsContainer(control) = False Then
    
                    control.Font = New Font(control.Font.FontFamily, control.Font.Size * ((SFX + SFY) / 2), control.Font.Style)
                
            End If
    
    
            If (control.Controls.Count > 0) Then
                passControl(control, SFX, SFY)
            End If
    
        End Sub

     Private Shared Sub passControl(ByRef c As Control, ByVal SFX As Single, ByVal SFY As Single)
    
            For Each control As Control In c.Controls
    
                changeAnchor(control, SFX, SFY)
            Next
    
        End Sub
    
       Private Shared Function IsContainer(control As Control) As Boolean
    
            If control.GetType.BaseType = GetType(UserControl) Or control.GetType = GetType(Panel) Then
                Return True
            End If
            Return False
        End Function
    אודה לעזרתכם.


    • נערך על-ידי bracha sos יום שני 25 מרץ 2019 18:51
    יום שני 25 מרץ 2019 14:06

תשובות

  • שלום,

    התשובה  היא כזו:

      
    ' new resolution
    
    dim screenWidth =768
    dim  screenHeight  = 1024
    
    
    
    ' original resolution
    dim  Xres = 1920 ' 'Width
    dim Yres=1080  ' Height
    
    
    'Relativity
    Dim SFY As Double = screenWidth / Xres
    Dim SFX As Double = screenHeight / Yres

    control.Font = New Font(control.Font.FontFamily, control.Font.Size * ((SFX * SFY)), control.Font.Style)


    • סומן כתשובה על-ידי bracha sos יום חמישי 28 מרץ 2019 07:01
    יום חמישי 28 מרץ 2019 07:00