هل هو 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
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
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
هل هو 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
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
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
هل هو 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
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
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
03-06-17, 08:43 PM (آخر تعديل لهذه المشاركة : 03-06-17, 08:45 PM {2} بواسطة anes.)
(03-06-17, 07:36 PM)khaled12345 كتب :
(03-06-17, 06:24 PM)anes كتب : [quote pid='100436' dateline='1496442541']
السلام عليكم اخي الحبيب
هل يجوز اجراء نفس الخطوات مع فيجوال بيسك 2010
ام هذا الكلاس خاص فقط بالفيجوال بيسك 2017
لاني حاولت مع الفيجوال بيسك 2010 للاسف ما مشي الحال
فبرجاء النصيحة
مع الشكر الجزيل
تفظل اخي هذا معمول بالفيجول 10
اخي الحبيب المرفق ايضا 2017
هي هي اللي فاتت
[/quote]
اخي الكريم
اولا لا يوجد مشكل لو شغلنا الكود على اي نسخة
ثانيا المشروع الذي ارسلته لك معمول بالنسخة 10 عندما كنت مثبتها على الجهاز
ثالثا اظن الخطء من عندك ليس في المثال
ارجو ان تتقبل انتقادي وشكرا
(03-06-17, 06:24 PM)anes كتب : [quote pid='100436' dateline='1496442541']
السلام عليكم اخي الحبيب
هل يجوز اجراء نفس الخطوات مع فيجوال بيسك 2010
ام هذا الكلاس خاص فقط بالفيجوال بيسك 2017
لاني حاولت مع الفيجوال بيسك 2010 للاسف ما مشي الحال
فبرجاء النصيحة
مع الشكر الجزيل
تفظل اخي هذا معمول بالفيجول 10
اخي الحبيب المرفق ايضا 2017
هي هي اللي فاتت
اخي الكريم
اولا لا يوجد مشكل لو شغلنا الكود على اي نسخة
ثانيا المشروع الذي ارسلته لك معمول بالنسخة 10 عندما كنت مثبتها على الجهاز
ثالثا اظن الخطء من عندك ليس في المثال
ارجو ان تتقبل انتقادي وشكرا
[/quote]