تكبير - تصغير النموذج بكافة عناصره

[مهند عبادي]

السلام عليكم

هذا الـ SUB قمت ببرمجته البارحة

أسلوب استخدامه :

اعمل وحدة نمطية جديدة والصق فيها الشفرة

ولاستخدامه استخدم الشفرة التالية (على سبيل المثال)

FormResize me , 1.2

أضعه هنا لكي يستفيد منه الأخوة ولكي تعطوني ملاحظاتكم عليه

Public Sub FormResize(ByRef F As Form, N As Single, Optional RForm As Boolean = True)
    On Error Resume Next
    Dim C As Control, S1 As String, S2 As String, k As String
    Dim R As Integer, I1 As Integer, I2 As Integer, g As Integer
    With F
        If RForm Then
            .InsideHeight = .InsideHeight * N
            .InsideWidth = .InsideWidth * N
        End If
        .Section(0).Height = .Section(0).Height * N
        .Section(1).Height = .Section(1).Height * N
        .Section(2).Height = .Section(2).Height * N
    End With
    For Each C In F
        C.Left = C.Left * N
        C.Top = C.Top * N
        C.Width = C.Width * N
        C.Height = C.Height * N
        C.FontSize = C.FontSize * N
        Select Case C.ControlType
            Case 112
                FormResize C.Form, N, False
            Case 110, 111
                g = C.ColumnCount - 1
                S1 = C.ColumnWidths
                I1 = 1
                S2 = ""
                For R = 0 To g
                    I2 = InStr(I1, S1, ";")
                    If I2 = 0 Then I2 = Len(S1) + 1
                    k = Str(Int(Val(Mid(S1, I1, I2 - I1)) * N)) & ";"
                    S2 = S2 + k
                    I1 = I2 + 1
                Next
                C.ColumnWidths = S2
        End Select
    Next
End Sub

تم تعديل مايو 10, 2004 بواسطه مهند عبادي

[محمد طاهر عرفه]

السلام عليكم

مثال جميل و مفيد

جزاك الله خيرا

لاحظت أنه لكي يعمل بصورة أفضل ، يجب أن تكون خاصة autoresize للنموذج غير مفعلة

و الا فانه مع التكبير و التصغير لعدة مرات متتالية تحدث مشكلة فى العرض ( مرات كثيرة )

أيضا يرجي اضافة التعامل مع صندوق الخيارات لكي يكون عاما option group أو ال Frame

مرفق المثال الذي جربت عليه

مع تحياتي و شكري (y)

formResize-mohanad.rar