10-03-16, 11:00 AM
(آخر تعديل لهذه المشاركة : 30-05-17, 11:27 AM {2} بواسطة Ahmed_Mansoor.)
بسم الله الرحمن الرحيم
السلام عليكم ورحمة الله وبركاته
- إخواني الكرام , هذا كود قمت بعمله لكي يقوم بإنشاء الكود الذي تحتاجه لكي يتم تحجيم الأدوات الموجوده على الفورم مع تغير حجم الفورم , مالذي يجب عليك عمله لتستفيد من هذا الكود , قم بإتباع الخطوات التاليه :
1- قم بإنشاء زر جديد على الفورم ثم قم بنسخ هذا الكود بداخله .
2- يجب أن يكون الفورم في وضعه الطبيعي وأقصد بذلك أن تكون خاصية الـ WindowState التابعه للفورم تساوي 0 أو Normal وذلك فقط إلى أن يتم إنشاء كود التحجيم ووضعه في الملف النصي بعد ذلك تستطيع تغيير قيمة الخاصية إلى أي قيمه تريدها .
3- شغل المشروع ثم قم بالضغط على الزر الجديد الذي أنشأته ووضعت الكود بداخله .
4- بعد الضغط على الزر وعند إنتهاء عمل الكود سيقوم بإظهار رسالة منبثقه تخبرك بنجاح إنشاء كود التحجيم الخاص بالأدوات الموجوده على الفورم , حيث بعد إنتهاء عمل الكود سيتم إنشاء ملف نصي بإسم ReSizerCode.txt في داخل مجلد المشروع .
5- إذهب إلى مجلد المشروع وإفتح الملف النصي المكون ثم قم بحذف الجزء الخاص بالزر الجديد الذي أنشأته على الفورم من الكود الذي ستشاهده داخل الملف النصي .
6- إنسخ باقي الكود الموجود في الملف النصي ثم إلصقه في حدث الـ Form_Resize للفورم .
7- إحذف الزر الجديد الذي أنشأته وإحذف الكود الذي بداخله .
8- إحفظ المشروع ثم شغله ثم جرب تكبير أو تصغير الفورم .
- وإن شاء الله ستظهر الفورم بنفس تنسيق الأدوات التي عليها في جميع أحجام شاشات الأجهزة .
- أرجو أن تفيدكم هذه الطريقه .
- هذا هو الكود والذي أسميته بالـ Resizer Code Creator :
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"
- ملاحظة :- تم تعديل الكود بتاريخ 30-05-2017 , حيث تم إضافة التعامل مع أداة الـ Line وأيضاً أداة الـ CommonDialog إن كانت مستخدمة في برنامجك وأيضاً تحسين أداء الكود .
