تقييم الموضوع :
  • 1 أصوات - بمعدل 5
  • 1
  • 2
  • 3
  • 4
  • 5
الكود الصانع لكود تحجيم الأدوات مع تغير حجم الفورم
#1
بسم الله الرحمن الرحيم

السلام عليكم ورحمة الله وبركاته

- إخواني الكرام , هذا كود قمت بعمله لكي يقوم بإنشاء الكود الذي تحتاجه لكي يتم تحجيم الأدوات الموجوده على الفورم مع تغير حجم الفورم , مالذي يجب عليك عمله لتستفيد من هذا الكود , قم بإتباع الخطوات التاليه :

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

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.Container
       
          If zContainer
.Name Me.Name Then
             
             
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
 
                         
             
Print #F, ""
 
                         
             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_ArrayTo UBound(Finish_Array)
 
             If Ctrl.Name Finish_Array(IThen
                 
GoTo ComeToHere
              End 
If
 
         Next
          
          Set zContainer 
Ctrl.Container
                           
          Is_Found 
False
       
          For I 
LBound(First_ArrayTo UBound(First_Array)
 
      
              If zContainer
.Name First_Array(IThen
              
                 
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
 
                
                 
Print #F, ""
 
                                    
                 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 LBound(Second_ArrayTo 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" 
الرد }}}}
#2
وعليكم بالسلام ورحمة الله وبركاته

بارك الله فيك اخي احمد


بالتوفيق
محاسب / أحمد عبد العليم
الرد }}}}
تم الشكر بواسطة: Ahmed_Mansoor , عبد العزيز البسكري
#3
عمل جبار من شخص كان يعاني من هذه الاشياء سابقا و لكن للاسف لن استفيد من هذا الكود لانتقالي على .Net
و التي وفرت بدورها ادوات تتحكم بالاحجام و مواقع الادوات في الفورم الخاص بك و التي بالصراحه اعجبتني كثيرا ،،

بالتوفيق لك استاذ احمد
اسم معرفي : محمد يحيى
الرد }}}}
تم الشكر بواسطة: Ahmed_Mansoor , عبد العزيز البسكري
#4
صباح الابداع والاتقان
صبااح الرووعات
حقيقة اعشق فيك الدقة والترتيب
شكرا جزيلا اخي احمد
سأعود قريباً ان شاء الله

الرد }}}}
تم الشكر بواسطة: Ahmed_Mansoor , عبد العزيز البسكري
#5
يأهلا وسهلا بكم إخواني الكرام ألف شكراً جزيلاً لكم على مروركم وكلامكم الرائعان ، جزاكم الله كل خير .
الرد }}}}
#6
السّلام عليكم و رحمة الله و بركاته
ألف شكر أخي الغالي و أستاذي الكريم
" أحمد منصور "
على العمل الرّائع المتقن و المميّز
قمّة الابداع و قمّة الرّوعة كروعة صاحبه القدير المحترم
جزاك الله خيرًا و زادها بموازين حسناتك و زادك من علمه و فضله
فترة الاستراحة قصيرة جدًّا .. و لذلك سأنكب على التّطبيق لهذا الكود مساءً إن شاء الله
حقيقة و الله على ما أقوله شهيد .. يعجز لساني عن التّعبير لك عن مدى إمتناني لك و شكري لك و حبي لك في الله
فائق إحتراماتي و إعجاباتي بروائع أعمالك
الرد }}}}
تم الشكر بواسطة: Amir_alzubidy , Amir_alzubidy , Ahmed_Mansoor
#7
السّلام عليكم و رحمة الله و بركاته
ألف شكر أخي الفاضل " أحمد منصور " على الكود أكثر من الرّائع
أفضالك علينا لا يمكن لنا عدّها ..
أدعو الله أنْ يمنَّ عليكَ بدوام الصحّة و العافية و طول العمر و يزيدك من علمه و فضله
عمل متقن و أسلوب بسيط و شرح رائع ..
تمّ بفضل الله ثم بفضل سيادتك المحترمة عمل المطلوب
الحمد لله أوّلاً و أخيرًا
فائق إحتراماتي
الرد }}}}
تم الشكر بواسطة:
#8
أهلا أخي عبدالعزيز . شكرا جزيلا لك على كلماتك الجميله , جزاك الله كل خير .
الرد }}}}
تم الشكر بواسطة: عبد العزيز البسكري


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  معرفة رقم سطر الخطأ في الكود Ahmed_Mansoor 2 217 22-11-16, 03:28 PM
آخر رد: sendbad100
  التحكم في دقة الشاشة من خلال الكود abulayth 3 2,070 08-02-14, 02:43 PM
آخر رد: dohadream

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


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم