تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
مساعدة في تغيير حجم الفورم حسب دقة عرض الشاشة
#2
وعليكم السلام ورحمة الله وبركاته :

لا يوجد كود قياسي لذلك ولكن هناك أكواد تقرب لك الأمر كثيراً وتجعله مقبولاً إلى حد كبير مع أغلب الشاشات
وأهمها الكود الذي شارك به هنا المبرمج (Ahmed_Mansoor) وهو :

من قائمة (Projects)  قم بانشاء (Add Class Module)
اجعل اسم الكلاس (xResizer)
ثم انسخ فيه الكود التالي : 
كود :
Option Explicit
Private nFormHeight      As Integer
Private nFormWidth       As Integer
Private nNumOfControls   As Integer
Private nTop()           As Integer
Private nLeft()          As Integer
Private nHeight()        As Integer
Private nWidth()         As Integer
Private nFontSize()      As Integer
Private nRightMargin()   As Integer
Private bFirstTime       As Boolean

Sub Init(frm As Form, Optional nWindState As Variant)
 
  Dim I          As Integer
  Dim bWinMax    As Boolean
 
  bWinMax = Not IsMissing(nWindState)
 
  nFormHeight = frm.Height
  nFormWidth = frm.Width
  nNumOfControls = frm.Controls.Count - 1
  bFirstTime = True
  ReDim nTop(nNumOfControls)
  ReDim nLeft(nNumOfControls)
  ReDim nHeight(nNumOfControls)
  ReDim nWidth(nNumOfControls)
  ReDim nFontSize(nNumOfControls)
 
  ReDim nRightMargin(nNumOfControls)
  On Error Resume Next
  For I = 0 To nNumOfControls
     If TypeOf frm.Controls(I) Is Line Then
        nTop(I) = frm.Controls(I).Y1
        nLeft(I) = frm.Controls(I).X1
        nHeight(I) = frm.Controls(I).Y2
        nWidth(I) = frm.Controls(I).X2
     Else
        nTop(I) = frm.Controls(I).Top
        nLeft(I) = frm.Controls(I).Left
        nHeight(I) = frm.Controls(I).Height
        nWidth(I) = frm.Controls(I).Width
        nFontSize(I) = frm.FontSize
        nRightMargin(I) = frm.Controls(I).RightMargin
     End If
  Next
 
  If bWinMax Or frm.WindowState = 2 Then ' maxim
     frm.Height = Screen.Height
     frm.Width = Screen.Width
  Else
     frm.Height = frm.Height * Screen.Height / 7290
     frm.Width = frm.Width * Screen.Width / 9690
  End If
 
  bFirstTime = True
 
End Sub

Sub FormResize(frm As Form)
 
  Dim I             As Integer
  Dim nCaptionSize  As Integer
  Dim dRatioX       As Double
  Dim dRatioY       As Double
  Dim nSaveRedraw   As Long
 
  On Error Resume Next
  nSaveRedraw = frm.AutoRedraw
 
  frm.AutoRedraw = True
 
  If bFirstTime Then
     bFirstTime = False
     Exit Sub
  End If
 
  If frm.Height < nFormHeight / 2 Then frm.Height = nFormHeight / 2
 
  If frm.Width < nFormWidth / 2 Then frm.Width = nFormWidth / 2
  nCaptionSize = 400
  dRatioY = 1# * (nFormHeight - nCaptionSize) / (frm.Height - nCaptionSize)
  dRatioX = 1# * nFormWidth / frm.Width
  On Error Resume Next ' for comboboxes, timeres and other nonsizible controls
 
  For I = 0 To nNumOfControls
     If TypeOf frm.Controls(I) Is Line Then
        frm.Controls(I).Y1 = Int(nTop(I) / dRatioY)
        frm.Controls(I).X1 = Int(nLeft(I) / dRatioX)
        frm.Controls(I).Y2 = Int(nHeight(I) / dRatioY)
        frm.Controls(I).X2 = Int(nWidth(I) / dRatioX)
     Else
        frm.Controls(I).Top = Int(nTop(I) / dRatioY)
        frm.Controls(I).Left = Int(nLeft(I) / dRatioX)
        frm.Controls(I).Height = Int(nHeight(I) / dRatioY)
        frm.Controls(I).Width = Int(nWidth(I) / dRatioX)
        frm.Controls(I).FontSize = Int(nFontSize(I) / dRatioX) + Int(nFontSize(I) / dRatioX) Mod 2
        frm.Controls(I).RightMargin = Int(nRightMargin(I) / dRatioY)
     End If
  Next
 
  frm.AutoRedraw = nSaveRedraw
 
End Sub


في كل نافذة تريد أن تتغير حجمها بحسب إعدادت الشاشات التي تستخدمها 
أستخدم الكود التالي : 

كود :
Private R1 As New xResizer

Private Sub Form_Load()
   R1.Init Me
End Sub

Private Sub Form_Resize()
   R1.FormResize Me
End Sub
قال صلى الله عليه وسلم: 
«كلمتان خفيفتان على اللسان 
ثقيلتان في الميزان،حبيبتان إلى الرحمن: 
سبحان الله وبحمده، سبحان الله العظيم».
الرد }}}
تم الشكر بواسطة:


الردود في هذا الموضوع
RE: مساعدة في تغيير حجم الفورم حسب دقة عرض الشاشة - بواسطة Taha Okla - 28-03-23, 04:52 PM


التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم