تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[VB.NET] كيفية تنفيذ كود فى حدث معين على اى فورم فى المشروع ؟
#5
تم تعديل كلاس الثيم وكلاس ResizeControls ودمجهم مع بعض، أي قم بحذف كلاس ResizeControls لأنه مضمن في نفس هذا الكود.

وهو يعمل حسب المطلوب في هذا الموضوع، أي لن تحتاج وضع أي كود في الفورم،
كود :
#Region " Imports "

Imports System.Drawing.Drawing2D

#End Region

'|------DO-NOT-REMOVE------|
'
' Creator: HazelDev
' Site   : HazelDev.com
' Created: 12.Sep.2014
' Changed: 26.Sep.2014
' Version: 1.0.0
'
'|------DO-NOT-REMOVE------|

Namespace MG_THEM

#Region " RoundRectangle "

    Module RoundRectangle
        Public Function RoundRect(ByVal Rectangle As Rectangle, ByVal Curve As Integer) As GraphicsPath
            Dim P As GraphicsPath = New GraphicsPath()
            Dim ArcRectangleWidth As Integer = Curve * 2
            P.AddArc(New Rectangle(Rectangle.X, Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), -180, 90)
            P.AddArc(New Rectangle(Rectangle.Width - ArcRectangleWidth + Rectangle.X, Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), -90, 90)
            P.AddArc(New Rectangle(Rectangle.Width - ArcRectangleWidth + Rectangle.X, Rectangle.Height - ArcRectangleWidth + Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), 0, 90)
            P.AddArc(New Rectangle(Rectangle.X, Rectangle.Height - ArcRectangleWidth + Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), 90, 90)
            P.AddLine(New Point(Rectangle.X, Rectangle.Height - ArcRectangleWidth + Rectangle.Y), New Point(Rectangle.X, Curve + Rectangle.Y))
            Return P
        End Function
    End Module

#End Region

#Region " ThemeContainer "

    Class MG_THEM_ThemeContainer
        Inherits ContainerControl
#Region " Enums "

        Enum MouseState As Byte
            None = 0
            Over = 1
            Down = 2
            Block = 3
        End Enum

#End Region
#Region " Variables "

        Private HeaderRect As Rectangle
        Protected State As MouseState
        Private MoveHeight As Integer
        Private MouseP As Point = New Point(0, 0)
        Private Cap As Boolean = False
        Private HasShown As Boolean

#End Region
#Region " Properties "

        Private _Sizable As Boolean = True
        Property Sizable() As Boolean
            Get
                Return _Sizable
            End Get
            Set(ByVal value As Boolean)
                _Sizable = value
            End Set
        End Property

        Private _SmartBounds As Boolean = True
        Property SmartBounds() As Boolean
            Get
                Return _SmartBounds
            End Get
            Set(ByVal value As Boolean)
                _SmartBounds = value
            End Set
        End Property

        Private _RoundCorners As Boolean = True
        Property RoundCorners() As Boolean
            Get
                Return _RoundCorners
            End Get
            Set(ByVal value As Boolean)
                _RoundCorners = value
                Invalidate()
            End Set
        End Property

        Private _IsParentForm As Boolean
        Protected ReadOnly Property IsParentForm As Boolean
            Get
                Return _IsParentForm
            End Get
        End Property

        Protected ReadOnly Property IsParentMdi As Boolean
            Get
                If Parent Is Nothing Then Return False
                Return Parent.Parent IsNot Nothing
            End Get
        End Property

        Private _ControlMode As Boolean
        Protected Property ControlMode() As Boolean
            Get
                Return _ControlMode
            End Get
            Set(ByVal v As Boolean)
                _ControlMode = v
                Invalidate()
            End Set
        End Property

        Private _StartPosition As FormStartPosition
        Property StartPosition As FormStartPosition
            Get
                If _IsParentForm AndAlso Not _ControlMode Then Return ParentForm.StartPosition Else Return _StartPosition
            End Get
            Set(ByVal value As FormStartPosition)
                _StartPosition = value

                If _IsParentForm AndAlso Not _ControlMode Then
                    ParentForm.StartPosition = value

                    Dim R As New ResizeControls() With {.Container = Parent.FindForm}

                End If
            End Set
        End Property
#End Region
#Region " EventArgs "

        Protected NotOverridable Overrides Sub OnParentChanged(ByVal e As EventArgs)
            MyBase.OnParentChanged(e)

            If Parent Is Nothing Then Return
            _IsParentForm = TypeOf Parent Is Form

            If Not _ControlMode Then
                InitializeMessages()

                If _IsParentForm Then
                    Me.ParentForm.FormBorderStyle = FormBorderStyle.None
                    Me.ParentForm.TransparencyKey = Color.Fuchsia
                    StartPosition = FormStartPosition.CenterScreen
                    If Not DesignMode Then
                        AddHandler ParentForm.Shown, AddressOf FormShown
                    End If
                End If
                Parent.BackColor = BackColor
                'Parent.MinimumSize = New Size(261, 65)

            End If
        End Sub

        Protected NotOverridable Overrides Sub OnSizeChanged(ByVal e As EventArgs)
            MyBase.OnSizeChanged(e)
            If Not _ControlMode Then HeaderRect = New Rectangle(0, 0, Width - 14, MoveHeight - 7)
            Invalidate()
        End Sub

        Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
            MyBase.OnMouseDown(e)
            Focus()
            If e.Button = MouseButtons.Left Then SetState(MouseState.Down)
            If Not (_IsParentForm AndAlso ParentForm.WindowState = FormWindowState.Maximized OrElse _ControlMode) Then
                If HeaderRect.Contains(e.Location) Then
                    Capture = False
                    WM_LMBUTTONDOWN = True
                    DefWndProc(Messages(0))
                ElseIf _Sizable AndAlso Not Previous = 0 Then
                    Capture = False
                    WM_LMBUTTONDOWN = True
                    DefWndProc(Messages(Previous))
                End If
            End If
        End Sub

        Protected Overrides Sub OnMouseUp(ByVal e As System.Windows.Forms.MouseEventArgs)
            MyBase.OnMouseUp(e)
            Cap = False
        End Sub

        Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
            MyBase.OnMouseMove(e)
            If Not (_IsParentForm AndAlso ParentForm.WindowState = FormWindowState.Maximized) Then
                If _Sizable AndAlso Not _ControlMode Then InvalidateMouse()
            End If
            If Cap Then
                Parent.Location = MousePosition - MouseP
            End If
        End Sub

        Protected Overrides Sub OnInvalidated(ByVal e As System.Windows.Forms.InvalidateEventArgs)
            MyBase.OnInvalidated(e)
            ParentForm.Text = Text
        End Sub

        Protected Overrides Sub OnPaintBackground(e As PaintEventArgs)
            MyBase.OnPaintBackground(e)
        End Sub

        Protected Overrides Sub OnTextChanged(ByVal e As System.EventArgs)
            MyBase.OnTextChanged(e)
            Invalidate()
        End Sub

        Private Sub FormShown(ByVal sender As Object, ByVal e As EventArgs)
            If _ControlMode OrElse HasShown Then Return

            If _StartPosition = FormStartPosition.CenterParent OrElse _StartPosition = FormStartPosition.CenterScreen Then
                Dim SB As Rectangle = Screen.PrimaryScreen.Bounds
                Dim CB As Rectangle = ParentForm.Bounds
                ParentForm.Location = New Point(SB.Width \ 2 - CB.Width \ 2, SB.Height \ 2 - CB.Width \ 2)
            End If
            HasShown = True
        End Sub

#End Region
#Region " Mouse & Size "

        Private Sub SetState(ByVal current As MouseState)
            State = current
            Invalidate()
        End Sub

        Private GetIndexPoint As Point
        Private B1x, B2x, B3, B4 As Boolean
        Private Function GetIndex() As Integer
            GetIndexPoint = PointToClient(MousePosition)
            B1x = GetIndexPoint.X < 7
            B2x = GetIndexPoint.X > Width - 7
            B3 = GetIndexPoint.Y < 7
            B4 = GetIndexPoint.Y > Height - 7

            If B1x AndAlso B3 Then Return 4
            If B1x AndAlso B4 Then Return 7
            If B2x AndAlso B3 Then Return 5
            If B2x AndAlso B4 Then Return 8
            If B1x Then Return 1
            If B2x Then Return 2
            If B3 Then Return 3
            If B4 Then Return 6
            Return 0
        End Function

        Private Current, Previous As Integer
        Private Sub InvalidateMouse()
            Current = GetIndex()
            If Current = Previous Then Return

            Previous = Current
            Select Case Previous
                Case 0
                    Cursor = Cursors.Default
                Case 6
                    Cursor = Cursors.SizeNS
                Case 8
                    Cursor = Cursors.SizeNWSE
                Case 7
                    Cursor = Cursors.SizeNESW
            End Select
        End Sub

        Private Messages(8) As Message
        Private Sub InitializeMessages()
            Messages(0) = Message.Create(Parent.Handle, 161, New IntPtr(2), IntPtr.Zero)
            For I As Integer = 1 To 8
                Messages(I) = Message.Create(Parent.Handle, 161, New IntPtr(I + 9), IntPtr.Zero)
            Next
        End Sub

        Private Sub CorrectBounds(ByVal bounds As Rectangle)
            If Parent.Width > bounds.Width Then Parent.Width = bounds.Width
            If Parent.Height > bounds.Height Then Parent.Height = bounds.Height

            Dim X As Integer = Parent.Location.X
            Dim Y As Integer = Parent.Location.Y

            If X < bounds.X Then X = bounds.X
            If Y < bounds.Y Then Y = bounds.Y

            Dim Width As Integer = bounds.X + bounds.Width
            Dim Height As Integer = bounds.Y + bounds.Height

            If X + Parent.Width > Width Then X = Width - Parent.Width
            If Y + Parent.Height > Height Then Y = Height - Parent.Height

            Parent.Location = New Point(X, Y)
        End Sub

        Private WM_LMBUTTONDOWN As Boolean
        Protected Overrides Sub WndProc(ByRef m As Message)
            MyBase.WndProc(m)

            If WM_LMBUTTONDOWN AndAlso m.Msg = 513 Then
                WM_LMBUTTONDOWN = False

                SetState(MouseState.Over)
                If Not _SmartBounds Then Return

                If IsParentMdi Then
                    CorrectBounds(New Rectangle(Point.Empty, Parent.Parent.Size))
                Else
                    CorrectBounds(Screen.FromControl(Parent).WorkingArea)
                End If
            End If
        End Sub

#End Region
        Protected Overrides Sub CreateHandle()
            MyBase.CreateHandle()
        End Sub
        Sub New()
            SetStyle(DirectCast(139270, ControlStyles), True)
            BackColor = Color.FromArgb(32, 41, 50)
            Padding = New Padding(10, 70, 10, 9)
            DoubleBuffered = True
            Dock = DockStyle.Fill
            MoveHeight = 66
            Font = New Font("Segoe UI", 9)

        End Sub

        Protected Overrides Sub OnPaint(e As PaintEventArgs)
            MyBase.OnPaint(e)
            Dim G As Graphics = e.Graphics

            G.Clear(Color.FromArgb(32, 41, 50))
            G.FillRectangle(New SolidBrush(Color.FromArgb(181, 41, 42)), New Rectangle(0, 0, Width, 60))
            If _RoundCorners = True Then
                ' Draw Left upper corner
                G.FillRectangle(Brushes.Fuchsia, 0, 0, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 1, 0, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 2, 0, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 3, 0, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 0, 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 0, 2, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 0, 3, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 1, 1, 1, 1)

                G.FillRectangle(New SolidBrush(Color.FromArgb(181, 41, 42)), 1, 3, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(181, 41, 42)), 1, 2, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(181, 41, 42)), 2, 1, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(181, 41, 42)), 3, 1, 1, 1)

                ' Draw right upper corner
                G.FillRectangle(Brushes.Fuchsia, Width - 1, 0, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 2, 0, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 3, 0, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 4, 0, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 1, 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 1, 2, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 1, 3, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 2, 1, 1, 1)

                G.FillRectangle(New SolidBrush(Color.FromArgb(181, 41, 42)), Width - 2, 3, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(181, 41, 42)), Width - 2, 2, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(181, 41, 42)), Width - 3, 1, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(181, 41, 42)), Width - 4, 1, 1, 1)

                ' Draw Left bottom corner
                G.FillRectangle(Brushes.Fuchsia, 0, Height - 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 0, Height - 2, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 0, Height - 3, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 0, Height - 4, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 1, Height - 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 2, Height - 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 3, Height - 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 1, Height - 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, 1, Height - 2, 1, 1)

                G.FillRectangle(New SolidBrush(Color.FromArgb(32, 41, 50)), 1, Height - 3, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(32, 41, 50)), 1, Height - 4, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(32, 41, 50)), 3, Height - 2, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(32, 41, 50)), 2, Height - 2, 1, 1)

                ' Draw right bottom corner
                G.FillRectangle(Brushes.Fuchsia, Width - 1, Height, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 2, Height, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 3, Height, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 4, Height, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 1, Height - 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 1, Height - 2, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 1, Height - 3, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 2, Height - 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 3, Height - 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 4, Height - 1, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 1, Height - 4, 1, 1)
                G.FillRectangle(Brushes.Fuchsia, Width - 2, Height - 2, 1, 1)

                G.FillRectangle(New SolidBrush(Color.FromArgb(32, 41, 50)), Width - 2, Height - 3, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(32, 41, 50)), Width - 2, Height - 4, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(32, 41, 50)), Width - 4, Height - 2, 1, 1)
                G.FillRectangle(New SolidBrush(Color.FromArgb(32, 41, 50)), Width - 3, Height - 2, 1, 1)
            End If

            G.DrawString(Text, New Font("Microsoft Sans Serif", 12, FontStyle.Bold), New SolidBrush(Color.FromArgb(255, 254, 255)), New Rectangle(20, 20, Width - 1, Height), New StringFormat() With {.Alignment = StringAlignment.Near, .LineAlignment = StringAlignment.Near})
        End Sub
    End Class

#End Region
#Region " ControlBox "

    Class MG_THEM_ControlBox
        Inherits Control

#Region " Enums "

        Enum ButtonHoverState
            Minimize
            Maximize
            Close
            None
        End Enum

#End Region
#Region " Variables "

        Private ButtonHState As ButtonHoverState = ButtonHoverState.None

#End Region
#Region " Properties "

        Private _EnableMaximize As Boolean = True
        Property EnableMaximizeButton() As Boolean
            Get
                Return _EnableMaximize
            End Get
            Set(ByVal value As Boolean)
                _EnableMaximize = value
                Invalidate()
            End Set
        End Property

        Private _EnableMinimize As Boolean = True
        Property EnableMinimizeButton() As Boolean
            Get
                Return _EnableMinimize
            End Get
            Set(ByVal value As Boolean)
                _EnableMinimize = value
                Invalidate()
            End Set
        End Property

        Private _EnableHoverHighlight As Boolean = False
        Property EnableHoverHighlight() As Boolean
            Get
                Return _EnableHoverHighlight
            End Get
            Set(ByVal value As Boolean)
                _EnableHoverHighlight = value
                Invalidate()
            End Set
        End Property

#End Region
#Region " EventArgs "

        Protected Overrides Sub OnResize(ByVal e As EventArgs)
            MyBase.OnResize(e)
            Size = New Size(100, 25)
        End Sub

        Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)
            MyBase.OnMouseMove(e)
            Dim X As Integer = e.Location.X
            Dim Y As Integer = e.Location.Y
            If Y > 0 AndAlso Y < (Height - 2) Then
                If X > 0 AndAlso X < 34 Then
                    ButtonHState = ButtonHoverState.Minimize
                ElseIf X > 33 AndAlso X < 65 Then
                    ButtonHState = ButtonHoverState.Maximize
                ElseIf X > 64 AndAlso X < Width Then
                    ButtonHState = ButtonHoverState.Close
                Else
                    ButtonHState = ButtonHoverState.None
                End If
            Else
                ButtonHState = ButtonHoverState.None
            End If
            Invalidate()
        End Sub

        Protected Overrides Sub OnMouseUp(ByVal e As MouseEventArgs)
            MyBase.OnMouseDown(e)
            Select Case ButtonHState
                Case ButtonHoverState.Close
                    Parent.FindForm().Close()
                Case ButtonHoverState.Minimize
                    If _EnableMinimize = True Then
                        Parent.FindForm().WindowState = FormWindowState.Minimized
                    End If
                Case ButtonHoverState.Maximize
                    If _EnableMaximize = True Then
                        If Parent.FindForm().WindowState = FormWindowState.Normal Then
                            Parent.FindForm().WindowState = FormWindowState.Maximized
                        Else
                            Parent.FindForm().WindowState = FormWindowState.Normal
                        End If
                    End If
            End Select
        End Sub
        Protected Overrides Sub OnMouseLeave(ByVal e As EventArgs)
            MyBase.OnMouseLeave(e)
            ButtonHState = ButtonHoverState.None : Invalidate()
        End Sub

        Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
            MyBase.OnMouseDown(e)
            Focus()
        End Sub

#End Region

        Sub New()
            MyBase.New()
            DoubleBuffered = True
            Anchor = AnchorStyles.Top Or AnchorStyles.Right
        End Sub

        Protected Overrides Sub OnCreateControl()
            MyBase.OnCreateControl()
            Try
                Location = New Point(Parent.Width - 112, 15)
            Catch ex As Exception
            End Try
        End Sub

        Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
            MyBase.OnPaint(e)
            Dim G As Graphics = e.Graphics
            G.Clear(Color.FromArgb(181, 41, 42))

            If _EnableHoverHighlight = True Then
                Select Case ButtonHState
                    Case ButtonHoverState.None
                        G.Clear(Color.FromArgb(181, 41, 42))
                    Case ButtonHoverState.Minimize
                        If _EnableMinimize = True Then
                            G.FillRectangle(New SolidBrush(Color.FromArgb(156, 35, 35)), New Rectangle(3, 0, 30, Height))
                        End If
                    Case ButtonHoverState.Maximize
                        If _EnableMaximize = True Then
                            G.FillRectangle(New SolidBrush(Color.FromArgb(156, 35, 35)), New Rectangle(35, 0, 30, Height))
                        End If
                    Case ButtonHoverState.Close
                        G.FillRectangle(New SolidBrush(Color.FromArgb(156, 35, 35)), New Rectangle(66, 0, 35, Height))
                End Select
            End If

            'Close
            G.DrawString("r", New Font("Marlett", 12), New SolidBrush(Color.FromArgb(255, 254, 255)), New Point(Width - 16, 8), New StringFormat With {.Alignment = StringAlignment.Center})

            'Maximize
            Select Case Parent.FindForm().WindowState
                Case FormWindowState.Maximized
                    If _EnableMaximize = True Then
                        G.DrawString("2", New Font("Marlett", 12), New SolidBrush(Color.FromArgb(255, 254, 255)), New Point(51, 7), New StringFormat With {.Alignment = StringAlignment.Center})
                    Else
                        G.DrawString("2", New Font("Marlett", 12), New SolidBrush(Color.LightGray), New Point(51, 7), New StringFormat With {.Alignment = StringAlignment.Center})
                    End If
                Case FormWindowState.Normal
                    If _EnableMaximize = True Then
                        G.DrawString("1", New Font("Marlett", 12), New SolidBrush(Color.FromArgb(255, 254, 255)), New Point(51, 7), New StringFormat With {.Alignment = StringAlignment.Center})
                    Else
                        G.DrawString("1", New Font("Marlett", 12), New SolidBrush(Color.LightGray), New Point(51, 7), New StringFormat With {.Alignment = StringAlignment.Center})
                    End If
            End Select

            'Minimize
            If _EnableMinimize = True Then
                G.DrawString("0", New Font("Marlett", 12), New SolidBrush(Color.FromArgb(255, 254, 255)), New Point(20, 7), New StringFormat With {.Alignment = StringAlignment.Center})
            Else
                G.DrawString("0", New Font("Marlett", 12), New SolidBrush(Color.LightGray), New Point(20, 7), New StringFormat With {.Alignment = StringAlignment.Center})
            End If
        End Sub
    End Class

#End Region


    '===============================================================================================
#Region " 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()

                AddHandler Ctrl.Resize, AddressOf Ctrl_Resize

            End Set

        End Property

        Private Sub Ctrl_Resize(ByVal sender As Object, ByVal e As System.EventArgs)
            ResizeControls()
        End Sub

        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

#End Region

End Namespace
الرد }}}
تم الشكر بواسطة: الماجيك مسعد


الردود في هذا الموضوع
RE: كيفية تنفيذ كود فى حدث معين على اى فورم فى المشروع ؟ - بواسطة مساعدة - 19-02-17, 06:49 AM

المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  كيفية منع ظهور الأخطاء من إعدادات البيسيك mmaalmesry 2 859 29-08-25, 10:30 AM
آخر رد: mmaalmesry
  كيفية جلب أسماء الأعمدة بجدول من جداول sql heem1986 2 754 17-08-25, 09:15 PM
آخر رد: heem1986
  كيفية حفظ إعدادات البرنامج بحيث لا تتغير أحمد إبراهيم سعد 4 3,005 06-08-25, 06:34 PM
آخر رد: Taha Okla
  مساعدة في كيفية ترحيل البيانات من داتا قريدفيو إلى داتا قريدفيو في فيجوال بيسك ahmedfa71 13 2,266 09-07-25, 11:24 PM
آخر رد: أبو خالد الشكري
  [VB.NET] حفظ تنسيق الفورم ثم تطبيقة علي فورم اخر فيجوال بيسك abo ragab 7 1,240 09-07-25, 12:45 AM
آخر رد: abo ragab
  [VB.NET] استدعاء داتا كريت فيو من فورم اخر EMADW 1 422 16-04-25, 06:10 PM
آخر رد: مصمم هاوي
  [VB.NET] عدم ظهور فورم نهى على خليل 0 296 02-04-25, 02:59 PM
آخر رد: نهى على خليل
  مشكاه غريبه ظهرت لى فى فورم خالد كامل1 1 335 15-02-25, 02:11 PM
آخر رد: خالد كامل1
  اريد كود معين اثابكم الله خالد كامل1 1 461 04-02-25, 09:28 PM
آخر رد: aliday03
  طريقه تحويل اى قاعده بيانات الى ملف dll فى المشروع خالد كامل1 1 642 31-01-25, 10:21 PM
آخر رد: Kamil

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


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