تكبير أو تصغير عناصر النموذج تلقائياً

[علي المصري]

عند فتح نموذج على الوضع Maximum ألاحظ عدم النتاسق في المحتويات على الشاشة - العناصر م=إما على اليمين أو على اليسار

وعند تعديل الارتساء الافقي والراسي يكون نفس الناتج

فهل من كود يصحح الأوضاع

اي يجع العناصر داخل النموذج في وضع متناسق

مرفق نموذج

ولقد بحثت فوجدت الكود التالي ولكني لم استطع التعامل معه

Option Compare Database

Option Explicit

Public Sub ResizeControls(Formular As Form, ByVal StartFormularbreite As Long, ByVal StartFormularhöhe As Long)

    Dim CHANGE_FACTOR As Double

    Dim CHANGE_CONTROL As Control


    If Not Formular.WindowWidth = 0 Then


	    CHANGE_FACTOR = Formular.WindowWidth / StartFormularbreite


	    If Not CHANGE_FACTOR = 1 Then


		    On Error Resume Next  '*** Nicht ganz die feine Art, ich weiß


		    If CHANGE_FACTOR > 1 Then

			    Formular.Section(0).Height = Formular.Section(0).Height * CHANGE_FACTOR

			    Formular.Section(1).Height = Formular.Section(1).Height * CHANGE_FACTOR

			    Formular.Section(2).Height = Formular.Section(2).Height * CHANGE_FACTOR

		    End If


		    For Each CHANGE_CONTROL In Formular.Controls


			    If CHANGE_CONTROL.ControlType = acSubform Then

				    Dim UFOBREITE As Integer

				    Dim UFOHÖHE As Integer

				    UFOBREITE = CHANGE_CONTROL.Width

				    UFOHÖHE = CHANGE_CONTROL.Height

				    CHANGE_CONTROL.Width = CHANGE_CONTROL.Width * CHANGE_FACTOR

				    CHANGE_CONTROL.Height = CHANGE_CONTROL.Height * CHANGE_FACTOR

				    CHANGE_CONTROL.Top = CHANGE_CONTROL.Top * CHANGE_FACTOR

				    CHANGE_CONTROL.Left = CHANGE_CONTROL.Left * CHANGE_FACTOR

				    ResizeControls CHANGE_CONTROL.Form, UFOBREITE, UFOHÖHE

			    Else

				    CHANGE_CONTROL.Width = CHANGE_CONTROL.Width * CHANGE_FACTOR

				    CHANGE_CONTROL.Height = CHANGE_CONTROL.Height * CHANGE_FACTOR

				    CHANGE_CONTROL.Top = CHANGE_CONTROL.Top * CHANGE_FACTOR

				    CHANGE_CONTROL.Left = CHANGE_CONTROL.Left * CHANGE_FACTOR

				    CHANGE_CONTROL.FontSize = CHANGE_CONTROL.FontSize * CHANGE_FACTOR

			    End If


		    Next


		    If CHANGE_FACTOR < 1 Then

			    Formular.Section(0).Height = Formular.Section(0).Height * CHANGE_FACTOR

			    Formular.Section(1).Height = Formular.Section(1).Height * CHANGE_FACTOR

			    Formular.Section(2).Height = Formular.Section(2).Height * CHANGE_FACTOR

		    End If


		    Formular.Repaint


		    On Error GoTo 0


	    End If


    End If

End Sub

Database41.rar

[علي المصري]

-----------------

تم تعديل أغسطس 7, 2012 بواسطه علي المصري