تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
مشكلة اختلاف شكل عرض المشروع من جهاز الي جهاز اخر
#6
(02-06-17, 05:00 AM)khaled12345 كتب :
(02-06-17, 04:51 AM)anes كتب :
(02-06-17, 04:03 AM)khaled12345 كتب :
(02-06-17, 03:48 AM)anes كتب :
(02-06-17, 03:15 AM)khaled12345 كتب : Smile Smile Smile Smile

تفظل اخي اتمنى يكون مناسب

مشكور اخي الحبيب

بس علشان الامر يكون مفهوم عندي

هل هو class   يجن ان اضيفة للمشروع دون عمل اعي شيء في الادوات او الفورم

مع الشكر لحضرتك
نعم اخي اظف للمشروع كلاس وسميه مثلا كما بالمشروع ResizeControls
 وهذا هو الكود الخاص بالكلاص
كود :
Public Class ResizeControls

   Dim RatioTable As New Hashtable

   Private WindowHeight As Single
   Private WindowWidth As Single
   Private HeightRatio As Single
   Private WidthRatio As Single

   Private _Container As New Control

   Private Shared m_FormWidth As Long                          'Original form width.
   Private Shared m_FormHeight As Long

   Public Property Container() As Control
       Get
           Return _Container
       End Get
       Set(ByVal Ctrl As Control)
           _Container = Ctrl
           FullRatioTable()
       End Set

   End Property

   Private Structure SizeRatio
       Dim TopRatio As Single
       Dim LeftRatio As Single
       Dim HeightRatio As Single
       Dim WidthRatio As Single
   End Structure

   Private Sub FullRatioTable()
       WindowHeight = _Container.Height
       WindowWidth = _Container.Width
       RatioTable = New Hashtable
       AddChildrenToTable(_Container)

   End Sub

   Private Sub AddChildrenToTable(ByRef ChildContainer As Control)
       Dim R As New SizeRatio

       For Each C As Control In ChildContainer.Controls
           With C
               R.TopRatio = CSng(.Top / WindowHeight)
               R.LeftRatio = CSng(.Left / WindowWidth)
               R.HeightRatio = CSng(.Height / WindowHeight)
               R.WidthRatio = CSng(.Width / WindowWidth)
               RatioTable(.Name) = R
               If .HasChildren Then
                   AddChildrenToTable(C)
               End If
           End With
       Next

   End Sub

   Public Sub ResizeControls()


       HeightRatio = CSng(_Container.Height / WindowHeight)
       WidthRatio = CSng(_Container.Width / WindowWidth)

       WindowHeight = _Container.Height
       WindowWidth = _Container.Width

       ResizeChildren(_Container)



   End Sub

   Private Sub ResizeChildren(ByRef ChildContainer As Control)

       Dim R As New SizeRatio
       For Each C As Control In ChildContainer.Controls
           With C
               R = CType(RatioTable(.Name), SizeRatio)
               .Top = CInt(WindowHeight * R.TopRatio)
               .Left = CInt(WindowWidth * R.LeftRatio)
               .Height = CInt(WindowHeight * R.HeightRatio)
               .Width = CInt(WindowWidth * R.WidthRatio)

               If .HasChildren Then
                   ResizeChildren(C)

               End If

           End With


           Select Case True
               Case TypeOf C Is ListBox
                   Dim L As New ListBox
                   L = CType(C, ListBox)
                   L.IntegralHeight = False
           End Select

           ResizeControlFont(C, WidthRatio, HeightRatio)

       Next





   End Sub

   Public Shared Sub SubResize(ByVal F As Form, ByVal percentW As Single, ByVal percentH As Single)

       Dim FormHeight As Long
       Dim FormWidth As Long
       Dim HeightChange As Single, WidthChange As Single


       FormHeight = Int((Screen.PrimaryScreen.WorkingArea.Height) * (percentH / 100))
       FormWidth = Int((Screen.PrimaryScreen.WorkingArea.Width) * (percentW / 100))

       With F
           .Height = FormHeight
           .Width = FormWidth

           HeightChange = .ClientSize.Height / m_FormHeight
           WidthChange = .ClientSize.Width / m_FormWidth


       End With


   End Sub



   Private Sub ResizeControlFont(ByRef Ctrl As Control, ByVal RatioW As Single, ByVal RatioH As Single)

       Dim FSize As Single = Ctrl.Font.Size
       Dim FStyle As FontStyle = Ctrl.Font.Style
       Dim FNome As String = Ctrl.Font.Name
       Dim NewSize As Single = FSize

       NewSize = CSng(FSize * Math.Sqrt(RatioW * RatioH))
       Dim NFont As New Font(FNome, CSng(NewSize), FStyle)
       Ctrl.Font = NFont

   End Sub

End Class

وفي الفورم اضف التالي

في الحدث Form1_Load
كود :
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
       ResizeControls.SubResize(Me, 50, 70)
       Me.StartPosition = FormStartPosition.CenterScreen
       Me.CenterToScreen()
       Me.WindowState = FormWindowState.Normal
   End Sub

وفي الحدث Form1_HandleCreated
اضف
كود :
 R.Container = Me


وفي الحدث Form1_Resize
كود :
  Me.StartPosition = FormStartPosition.CenterScreen

       R.ResizeControls()


كدا برنامجك انشاء الله تمام اخي
Big Grin Big Grin Big Grin Big Grin



مشكووووور اخي الحبيب

كدا تمام

وربنا يجزاك كل الخير يارب


Smile Smile Smile Smile



==========================================================================

السلام عليكم اخي الحبيب

هل يجوز اجراء نفس الخطوات مع فيجوال بيسك 2010

ام هذا الكلاس خاص فقط بالفيجوال بيسك 2017

لاني حاولت مع الفيجوال بيسك 2010 للاسف ما مشي الحال

فبرجاء النصيحة

مع الشكر الجزيل
الرد }}}
تم الشكر بواسطة: asemshahen5 , asemshahen5 , ابو انس , ابو انس


الردود في هذا الموضوع
RE: مشكلة اختلاف شكل عرض المشروع من جهاز الي جهاز اخر - بواسطة khaled12345 - 03-06-17, 02:29 AM


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


يقوم بقرائة الموضوع: