الكود الصانع لكود تحجيم الأدوات مع تغير حجم الفورم

PHP كود :

Dim Is_FirstTime As Boolean
Dim First_Array() As String
Dim Second_Array() As String
Dim Finish_Array() As String
Dim zContainer As Object
Dim Ctrl As Control
Dim Is_ExitLoop As Boolean
Dim Is_Found As Boolean
Dim Counter As Integer
Dim Finish_Counter As Integer
Dim F As Integer
Dim I As Integer

If Dir$(App.Path & "\ReSizerCode.txt") <> "" Then
   Kill App.Path & "\ReSizerCode.txt"
   DoEvents
End If

F = FreeFile
DoEvents

Open App.Path & "\ReSizerCode.txt" For Append As #F
DoEvents

Is_FirstTime = True

Do While Is_ExitLoop = False

   If Is_FirstTime = True Then
   
      For Each Ctrl In Controls
    
          Set zContainer = Ctrl.Parent
       
          If zContainer.Name = Me.Name Then
             
             'تفعل هذا السطر فقط إذا كنت مستخدم أداة الدايلوق في برنامجك
             'If TypeOf Ctrl Is CommonDialog Then GoTo ComeHere1
             
             If TypeOf Ctrl Is Line Then
             
                Print #F, Ctrl.Name & ".X1 = Int((" & Me.Name & ".ScaleWidth / 100) * " & Int((Ctrl.X1 * 100) / Me.ScaleWidth) & ")"
             
                Print #F, Ctrl.Name & ".X2 = Int((" & Me.Name & ".ScaleWidth / 100) * " & Int((Ctrl.X2 * 100) / Me.ScaleWidth) & ")"
             
                Print #F, Ctrl.Name & ".Y1 = Int((" & Me.Name & ".ScaleHeight / 100) * " & Int((Ctrl.Y1 * 100) / Me.ScaleHeight) & ")"
             
                Print #F, Ctrl.Name & ".Y2 = Int((" & Me.Name & ".ScaleHeight / 100) * " & Int((Ctrl.Y2 * 100) / Me.ScaleHeight) & ")"
             
             Else
             
                Print #F, Ctrl.Name & ".Left = Int((" & Me.Name & ".ScaleWidth / 100) * " & Int((Ctrl.Left * 100) / Me.ScaleWidth) & ")"
             
                Print #F, Ctrl.Name & ".Top = Int((" & Me.Name & ".ScaleHeight / 100) * " & Int((Ctrl.Top * 100) / Me.ScaleHeight) & ")"
             
                Print #F, Ctrl.Name & ".Width = Int((" & Me.Name & ".ScaleWidth / 100) * " & Int((Ctrl.Width * 100) / Me.ScaleWidth) & ")"
             
                If Not TypeOf Ctrl Is ComboBox Then
                   Print #F, Ctrl.Name & ".Height = Int((" & Me.Name & ".ScaleHeight / 100) * " & Int((Ctrl.Height * 100) / Me.ScaleHeight) & ")"
                End If
                          
             End If
             
             Print #F, ""

'تفعل هذا السطر فقط إذا كنت مستخدم أداة الدايلوق في برنامجك
'ComeHere1:
             
             Counter = Counter + 1
       
             ReDim Preserve First_Array(1 To Counter) As String
       
             First_Array(Counter) = Ctrl.Name
             
             Finish_Counter = Finish_Counter + 1
             
             ReDim Preserve Finish_Array(1 To Finish_Counter) As String
             
             Finish_Array(Finish_Counter) = Ctrl.Name
             
          End If
          
      Next
      
      If Counter = Controls.Count Then
         
         Set zContainer = Nothing
         
         Is_ExitLoop = True
         
         Close #F
         DoEvents

         Exit Do
      
      Else
      
         Is_FirstTime = False
         
      End If
      
   Else
   
      Counter = 0

      For Each Ctrl In Controls
    
          For I = LBound(Finish_Array) To UBound(Finish_Array)
              If Ctrl.Name = Finish_Array(I) Then
                 GoTo ComeToHere
              End If
          Next
          
          Set zContainer = Ctrl.Parent
                           
          Is_Found = False
       
          For I = LBound(First_Array) To UBound(First_Array)
       
              If zContainer.Name = First_Array(I) Then
                 
                 'تفعل هذا السطر فقط إذا كنت مستخدم أداة الدايلوق في برنامجك
                 'If TypeOf Ctrl Is CommonDialog Then GoTo ComeHere2
                 
                 If TypeOf Ctrl Is Line Then
                 
                    Print #F, Ctrl.Name & ".X1 = Int((" & zContainer.Name & ".Width / 100) * " & Int((Ctrl.X1 * 100) / zContainer.Width) & ")"
             
                    Print #F, Ctrl.Name & ".X2 = Int((" & zContainer.Name & ".Width / 100) * " & Int((Ctrl.X2 * 100) / zContainer.Width) & ")"
             
                    Print #F, Ctrl.Name & ".Y1 = Int((" & zContainer.Name & ".Height / 100) * " & Int((Ctrl.Y1 * 100) / zContainer.Height) & ")"
             
                    Print #F, Ctrl.Name & ".Y2 = Int((" & zContainer.Name & ".Height / 100) * " & Int((Ctrl.Y2 * 100) / zContainer.Height) & ")"
                 
                 Else
                 
                    Print #F, Ctrl.Name & ".Left = Int((" & zContainer.Name & ".Width / 100) * " & Int((Ctrl.Left * 100) / zContainer.Width) & ")"
             
                    Print #F, Ctrl.Name & ".Top = Int((" & zContainer.Name & ".Height / 100) * " & Int((Ctrl.Top * 100) / zContainer.Height) & ")"
             
                    Print #F, Ctrl.Name & ".Width = Int((" & zContainer.Name & ".Width / 100) * " & Int((Ctrl.Width * 100) / zContainer.Width) & ")"
             
                    If Not TypeOf Ctrl Is ComboBox Then
                       Print #F, Ctrl.Name & ".Height = Int((" & zContainer.Name & ".Height / 100) * " & Int((Ctrl.Height * 100) / zContainer.Height) & ")"
                    End If
                 
                 End If
                 
                 Print #F, ""
                                     
'تفعل هذا السطر فقط إذا كنت مستخدم أداة الدايلوق في برنامجك
'ComeHere2:
                 
                 Finish_Counter = Finish_Counter + 1
             
                 ReDim Preserve Finish_Array(1 To Finish_Counter) As String
             
                 Finish_Array(Finish_Counter) = Ctrl.Name
                    
                 Is_Found = True
              
                 Exit For
              
              End If
           
          Next
       
          If Is_Found = False Then
          
             Counter = Counter + 1
          
             ReDim Preserve Second_Array(1 To Counter) As String
       
             Second_Array(Counter) = zContainer.Name
       
          End If
                 
ComeToHere:
          
      Next
      
      If Counter <= 0 Then
      
         Set zContainer = Nothing
         
         Is_ExitLoop = True
         
         Close #F
         DoEvents
         
         Exit Do
      
      Else
         
         ReDim First_Array(1 To 1) As String
         
         For I = LBound(Second_Array) To UBound(Second_Array)
             ReDim Preserve First_Array(1 To I) As String
             First_Array(I) = Second_Array(I)
         Next
         
         ReDim Second_Array(1 To 1) As String
         
      End If
      
   End If
   
Loop

MsgBox "تم إنشاء كود تحجيم الأدوات بنجاح وتم وضعه في ملف نصي في مجلد البرنامج بإسم:" & _
       vbNewLine & "ReSizerCode.txt" & vbNewLine & "تجد الملف في هذا المسار:" _
       & vbNewLine & App.Path & vbNewLine & _
       "قم بنسخ الكود ثم ضعه في حدث الريسايز للفورم", vbOKOnly + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ReSizerCode Creator By Ahmed_Mansoor"