الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

تعلم كيف تنشئ برنامج لتعديل مقاسات الصور بنفسك

بدأه التكنلوجي في 2 يناير 2014 · 3 رد · 1,156 مشاهدة · في Microsoft Visual Basic.NET
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

بسم الله

abaadlogo.png
السلام عليكم

مقدمة
1- مرحلة التخطيط

كما نعلم ان المبرمج يهدف دوماً ببرامجه لتسهيل حياة الناس الذين يقتنون أجهزة الحاسوب .. كنت أواجه صعوبة ما في تعديل مقاس مجموعة كبيرة من الصور فأضطر لفتح برنامج تحرير الصورة وتعديل المقاس واحدة والأخرى وهذا كما نعلم يأخذ منا وقت كبير ونظراً لكثرة تلك الصور قمت بعد توفيق الله بعمل برنامج صغير لتغيير مقاس الصور دفعة واحدة وفي هذه التدوينة سنتحدث عن كود تغيير مقاس الصورة  كما ستجد في آخرها رابط لصفحة مشروع أبعاد الذي هو خلاصة هذا الكود

 

البدأ بالعمل

2 - مرحلة التصميم
سنبني تطبيق من نوع ويندوز أبليكيشن مع العلم انه من السهل تغييره ليكون ويب ابليكيشن لكننا نريد السهولة والسرعة ,نبدأ ببسم الله مع مشروع جديد و نفتح شاشة جديدة (Form) ونصممها بشكل سهل وبسيط لعمل كمايلي :
abaadform1.jpg

 

كل البرنامج عبارة عن هذه الشاشة
أولا ً: سنظيف زرين Buttons الأول لاختيار الصور وسنضعه في أول الشاشة والثانية لحفظ الصور وسنضعه في آخر الشاشة

 

ثانيا : الزر الأول سنحتاج استخدام مربع حوار (فتح) لفتح الصور وسنضيف في المشروع أداة ( OpenDialog ) نسميها OpenImg و الزر الثاني سنحدد به (المجلد) الذي سنحفظ فيه الصور لذلك سنضيف أداة FolderBrowserDialog ونسميها FolderSave

 

ثالثا: سيكون لنا طريقتين في تصغير الصور وسنبدل بين الطريقتين بأزرار إختيار من نوع Radio Button الأول اسمه RadioButSize لتغيير الصورة بحجم محدد والثاني RadioButPersent لتغيير الصورة بالنسبة
الطريقة الأولى التغيير بمقاس محدد مع إمكانية الحفاظ على التناسب بين الابعاد ( المقصود بالتناسب بين الابعاد الحفاظ على الصورة الطويلة بتناسب معين كماهي والصغيرة كماهي فمثلا لو كان طول الصور 120 وعرضها 40 فيعني ان التانسب هنا العرض هو ثلث الطول )
سنجعل تلك الطريقة في مجموعة واحدة اسمها GroSize فيها أداة إدخال أرقام فقط NumericUpDown الأولى للطول ونسميها NumHeight والثانية للعرض ونسميها NumWidth ومربع خيار صغير CheckBox لتفعيل / عدم تفعيل خاصية الحفاظ على التناسب بين الطول والعرض (الحفاظ على تناسب الأبعاد ) ونسميه CheckBRatio
وفي المجموعة الثانية GrPers

 

سنضيف أداة NumericUpDown لوضع نسبة تغيير الحجم فيها فيها ونسميها NumPers
أيضاً بالجهة المقابلة نظيف أداة FolwLayoutPanel لنضع فيها مصغرات بسيطة للصور التي اخترناها ونسميها FLP
ملاحظة : قمت بتجاهل إضافة Labels لان المستخدم سيعرفها من شكل الشاشة .


3-مرحلة البرمجة
(سأكتب الكود هنا واشرحه بالفيجول بيسك ثم سأكتب لكم نسخة كاملة ب C# )
نبدأ بجلب المكتبات الثلاث الرسم والرسم ثانئ البعد ومكتبة الإدخال والإخراج كما يلي:
 

Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.IO

ثم لنضع المتغيرات التالية كمتغيرات عامة لكل الفئة

الأول ImgOneOpenLocation لنرسم فيه الصورة (وسنتعامل معه عند تحديد صورة واحدة فقط )
والثاني ImgListOpenLocation مجموعة صورة لنرسم فيها الصور المختارة ( وسنتعامل معه عند تحديد أكثر من صورة )
والثالث ImgSaveLocation لتحديد مجلد الحفظ
الرابع ImgNameOneOpenLocation مسار الصورة (وسنتعامل معه عند تحديد صورة واحدة فقط )
الخامس ImgNamesListOpenLocation لمجموعة مسارات الصور ( وسنتعامل معه عند تحديد أكثر من صورة )
والسادس NewImagesList قائمة صور لنقوم بإضافة الصور بعد تعديل حجمها فيها
 

Public ImgOneOpenLocation As Image
 
    Public ImgListOpenLocation As New List(Of Image)
 
    Public ImgSaveLocation As String
 
    Public ImgNameOneOpenLocation As String
 
    Public ImgNamesListOpenLocation As New List(Of String)
 
    Public NewImagesList As New List(Of Image)

وحتى لايظل برنامجنا يعمل في خلفية الجهاز بعد النقر على زر الإغلاق نظيف في الحدث Close للشاشة الرئيسية الفعل End
 

Private Sub FrmMain_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
        End
    End Sub

في زر الفتح ( تحديد الصور ) سنكتب الكود التالي
 

Try
 
            FLP.Controls.Clear()
 
            ImgListOpenLocation.Clear()
 
            ImgNameOneOpenLocation = ""
 
            ImgNamesListOpenLocation.Clear()
 
            OpenImg.Filter = "All  Image files|*.bmp;*.gif;*.jpg;*.ico;*.emf,*.wmf|Bitmap  Files(*.bmp;*.gif;*.jpg;*.ico)|*.bmp;*.gif;*.jpg;*.ico|****  Files(*.emf;*.wmf)|*.emf;*.wmf"
 
            Dim filter As String = OpenImg.Filter
 
            OpenImg.InitialDirectory = Environment.CurrentDirectory
 
            OpenImg.Title = "اختيار صورة"
 
            OpenImg.ShowHelp = False
 
            OpenImg.Multiselect = True
 
            If OpenImg.ShowDialog() = DialogResult.OK Then
 
                If OpenImg.FileNames.Length > 1 Then
 
                    For i As Integer = 0 To OpenImg.FileNames.Length - 1
 
                        Dim IPictureBox As New PictureBox
 
                        ImgListOpenLocation.Add(Image.FromFile(OpenImg.FileNames(i)))
 
                        ImgNamesListOpenLocation.Add(OpenImg.FileNames(i))
 
                        IPictureBox.Width = 50
 
                        IPictureBox.Height = 50
 
                        IPictureBox.Image = ImgListOpenLocation.Item(i)
 
                        IPictureBox.SizeMode = PictureBoxSizeMode.StretchImage
 
                        IPictureBox.Visible = True
 
                        FLP.Controls.Add(IPictureBox)
 
                    Next
 
                ElseIf OpenImg.FileNames.Length = 1 Then
 
                    Dim IPictureBox As New PictureBox
 
                    ImgOneOpenLocation = Image.FromFile(OpenImg.FileName)
 
                    ImgNameOneOpenLocation = OpenImg.FileName
 
                    IPictureBox.Width = 50
 
                    IPictureBox.Height = 50
 
                    IPictureBox.Image = ImgOneOpenLocation
 
                    IPictureBox.Visible = True
 
                    IPictureBox.SizeMode = PictureBoxSizeMode.StretchImage
 
                    FLP.Controls.Add(IPictureBox)
 
                Else
 
                    MessageBox.Show("فضلا قم باختيار صورة أو عدة صور")
 
                End If
 
            End If
 
        Catch ex As Exception
 
            MessageBox.Show(ex.Message, "خطأ", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RtlReading)
 
        End Try
 
    End Sub

وشرحه كما يلي :

نقوم أولا بتغريغ كافة المتغيرات السابقة تمهيداً لبدأ عملية جديدة
 

FLP.Controls.Clear()
 
            ImgListOpenLocation.Clear()
 
            ImgNameOneOpenLocation = ""
 
            ImgNamesListOpenLocation.Clear()

نحدد الملفات التي سنقبل ان نفتحها وقد اخترت أغلب الأنواع المشهورة
 

OpenImg.Filter = "All  Image files|*.bmp;*.gif;*.jpg;*.ico;*.emf,*.wmf|Bitmap  Files(*.bmp;*.gif;*.jpg;*.ico)|*.bmp;*.gif;*.jpg;*.ico|****  Files(*.emf;*.wmf)|*.emf;*.wmf

كما نحدد بقية الخواص لمربع الفتح

OpenImg.InitialDirectory = Environment.CurrentDirectory
              OpenImg.Title = "اختيار صورة"
              OpenImg.ShowHelp = False

فنحدد المسار وعنوان الشاشة ونقوم بإلغاء زر المساعدة
وأهم من ذلك أن نفعل خاصية اختيار أكثر من ملف

OpenImg.Multiselect = True

ثم نشغل الشاشة وننتظر أن تعود لنا بالقيمة OK بمعنى اننى لن نقوم بأي إجراء في حال قام المستخدم بالنقر على زر Cancel
 

If OpenImg.ShowDialog() = DialogResult.OK Then

الآن سننظر هل قام المستخدم باختيار ملف صورة واحدة ام عدة صور
 

If OpenImg.FileNames.Length > 1 Then

إذا اختار أكثر من صورة فإننا سنقوم بعمل دائرة تكرار (For Next ) تبدأ من صفر وتنتهي بإجمالي عدد الملفات ناقص واحد
 

For i As Integer = 0 To OpenImg.FileNames.Length – 1

نضيف اسم كل صورة لقائمة أسماء الصور ImgNamesListOpenLocation ونظيف الصورة نفسها أيضا لقائمة الصور ImgListOpenLocation
 

ImgListOpenLocation.Add(Image.FromFile(OpenImg.FileNames(i)))
 
ImgNamesListOpenLocation.Add(OpenImg.FileNames(i))

نقوم بإنشاء مربع صورة لكل صورة ( للصورة المصغرة التي ستضهر في الأداة FLP ) ونحدد طولها وعرضها ب50 بكسل مع تمكين خاصية تمدد الصورة داخل الأدة وخاصية إظهار الصورة
 

Dim IPictureBox As New PictureBox
 
                        IPictureBox.Width = 50
 
                        IPictureBox.Height = 50
 
                        IPictureBox.Image = ImgListOpenLocation.Item(i)
 
                        IPictureBox.SizeMode = PictureBoxSizeMode.StretchImage
 
                        IPictureBox.Visible = True

ثم نقوم أخيراً بإضافة مربع الصورة في الأداة FLP
 

FLP.Controls.Add(IPictureBox)

نفس ماقمنا به أعلاه سنكرره لكن في حال اختيار صورة واحدة
 

Dim IPictureBox As New PictureBox
 
                    ImgOneOpenLocation = Image.FromFile(OpenImg.FileName)
 
                    ImgNameOneOpenLocation = OpenImg.FileName
 
                    IPictureBox.Width = 50
 
                    IPictureBox.Height = 50
 
                    IPictureBox.Image = ImgOneOpenLocation
 
                    IPictureBox.Visible = True
 
                    IPictureBox.SizeMode = PictureBoxSizeMode.StretchImage
 
                    FLP.Controls.Add(IPictureBox)

يجب أن نجعل المستخدم يختار فقط إحدى الطريقتين وسنقوم في زر اختيار التصغير باستخدام مقاس محدد بإضافة الكود التالي عند الحدث CheckedChanged

 

Private Sub RadioButSize_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButSize.CheckedChanged
 
       If RadioButSize.Checked = True Then
 
           GroSize.Enabled = True
 
           GrPers.Enabled = False
 
       Else
 
           GroSize.Enabled = False
 
           GrPers.Enabled = True
 
       End If
 
   End Sub

وملخص الكود هو أنه اذا حدد المستخدم زر التعديل بمقاس محدد فعل مجموعة الأزرار لتتغيير بطول وعرض محدد وعند تفعيل الزر الأخر قم بتفعيل مجموعة التغيير بالنسبة وإلي التفعيل للمجوعة الأولى
دعونا قبل ان نتحدث عن زر الحفظ ان نقوم بإضافة وظيفتي تغيير الحجم الأولى ستأخذ الصورة image مع المقاس الجديد size بالإضافة لخاصية التناسب بين الطول والعرض وتأخذ بشكل أساسي قيمة نعم preserveAspectRatio وتعيد لنا بعد ذلك الصورة معدلة
 

Public Shared Function ResizeImg(ByVal image As Image, _
 
  ByVal size As Size, Optional ByVal preserveAspectRatio As Boolean = True) As Image

في حال اختار المستخد خاصية التناسب بين الطول والعرض فسنحدد مغيرات إضافية الأولى للطول والعرض بعد تعديل التناسب والثانية لتحديد النسبة بين الطول والعرض مع أخذ أكبرهما كأساس للتناسب

 

Dim newWidth As Integer
 
        Dim newHeight As Integer
 
        If preserveAspectRatio Then
 
            Dim OrgWidth As Integer = image.Width
 
            Dim OrgHeight As Integer = image.Height
 
            Dim percentWidth As Single = CSng(size.Width) / CSng(OrgWidth)
 
            Dim percentHeight As Single = CSng(size.Height) / CSng(OrgHeight)
 
            Dim percent As Single = If(percentHeight < percentWidth,
 
                    percentHeight, percentWidth)
 
            newWidth = CDbl(OrgWidth * percent)
 
            newHeight = CDbl(OrgHeight * percent

في حال لم يختار المستخدم خاصية التناسب سنسد قيمة الطول والعرض من المقاس المرسل لمتغييرين أساسيين

 

Else
 
            newWidth = size.Width
 
            newHeight = size.Height
 
        End If

الان نقوم بإعادة رسم الصورة باستخدام الدالة DrawImage من جديد بطول وعرض محددين ثم نعيد الصورة الجديدة كالتالي:
 

Dim newImage As Image = New Bitmap(newWidth, newHeight)
 
        Using graphicsHandle As Graphics = Graphics.FromImage(newImage)
 
            graphicsHandle.InterpolationMode = InterpolationMode.HighQualityBicubic
 
            graphicsHandle.DrawImage(image, 0, 0, newWidth, newHeight)
 
        End Using
 
        Return newImage

وهذ الفكرة الأساسية

في الوظيفة الثانية سنقوم بنفس العمل تقريباً وستأخذ الوظيفة متغييرين فقط أولهما الصورة القديمة والثانية هي النسبة المئوية والفرق عن الوظيفة السابقة هنا أننا نعيد حساب الطول الجديد والعرض بتقسيمها على 100 لنأخذ قيمة 1% ثم نضربها في النسبة التي أراد المستخدم التغيير إليها فلو كان الطول 10000 واختار التغيير بنسبة 50% سيكون الطول الجديد 5000
وباقي الوظيفة هو نفس الوظيفة السابقة بإعادة رسم الصورة
 

Public Shared Function ResizePercentImg(ByVal image As Image, _
 
  ByVal percent As Integer) As Image
 
        Dim newWidth As Integer
 
        Dim newHeight As Integer
 
        Dim OrgWidth As Integer = image.Width
 
        Dim OrgHeight As Integer = image.Height
 
        newWidth = (CDbl(OrgWidth / 100) * percent)
 
        newHeight = (CDbl(OrgHeight / 100) * percent)
 
        Dim newImage As Image = New Bitmap(newWidth, newHeight)
 
        Using graphicsHandle As Graphics = Graphics.FromImage(newImage)
 
            graphicsHandle.InterpolationMode = InterpolationMode.HighQualityBicubic
 
            graphicsHandle.DrawImage(image, 0, 0, newWidth, newHeight)
 
        End Using
 
        Return newImage
 
    End Function

أخيرا زر الحفظ وملخص أدائه كالتالي
أولا : نتأكد ان المستخدم اختار صورة او عدة صور

 

If ImgNameOneOpenLocation = "" And ImgNamesListOpenLocation.Count = 0 Then
 
                MessageBox.Show("قم باختيار صورة او عدة صور أولا", "خطأ", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RtlReading)
 
                Exit Sub
 
            End If

ثانيا نجعل المستخدم يحدد مجلد الحفظ بعرض مربع الحوار FolderSave
 

If FolderSave.ShowDialog = Windows.Forms.DialogResult.OK Then

نخزن المسار في متغير من نوع DirectoryInfo اسمه Dirc
 

Dim Dirc As New IO.DirectoryInfo(FolderSave.SelectedPath)

طبعا نمسح قائمة الصور الجديدة

ثم ننظر هل قام المستخدم باختيار الطريقة الأولى ام الثانية
إذا اختار الطريقة الأولى ( التغيير بحجم ثابت )
ننظر هل قام المستخدم باختيار صورة واحدة ام عدة صور ثم نرسل بعد ذلك الصورة او الصور للوظيفة الأولى
 

If RadioButSize.Checked = True Then
 
                    If ImgNamesListOpenLocation.Count > 0 Then
 
                        For i As Integer = 0 To ImgListOpenLocation.Count - 1
 
                            NewImagesList.Add(ResizeImg(ImgListOpenLocation(i), New Size(NumWidth.Value, NumHeight.Value), CheckBRatio.Checked))
 
                        Next
 
                    ElseIf ImgNameOneOpenLocation <> "" Then
 
                        ImgNamesListOpenLocation.Add(ImgNameOneOpenLocation)
 
                        NewImagesList.Add(ResizeImg(ImgOneOpenLocation, New Size(NumWidth.Value, NumHeight.Value), CheckBRatio.Checked))
 
                    End If
 
                Else

في حال ان المستخدم اختار الطريقة الثانية (التغيير بنسبة )

سننظر هل قام باختيار صورة واحدة ام عدة صور ونرسلهم بعد ذلك للوظيفة الثانية
 

If NumPers.Value = 0 Then
 
                        MessageBox.Show("لقد اخترت تغيير حجم الصورة بنسبة 0 % " & vbNewLine & "وهذا يعني انه لن يتم تغيير الحجم فضلا قم بتغيير القيمة المؤية لتكون اكبر من صفر", "خطأ", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RtlReading)
 
                        Exit Sub
 
                    End If
 
                    If ImgNamesListOpenLocation.Count > 0 Then
 
                        For i As Integer = 0 To ImgListOpenLocation.Count - 1
 
                            NewImagesList.Add(ResizePercentImg(ImgListOpenLocation(i), NumPers.Value))
 
                        Next
 
                    ElseIf ImgNameOneOpenLocation <> "" Then
 
                        ImgNamesListOpenLocation.Add(ImgNameOneOpenLocation)
 
                        NewImagesList.Add(ResizePercentImg(ImgOneOpenLocation, NumPers.Value))
 
                    End If

الان حتى لانقع في مشاكل تكرار اسم الصورة سنظيف لكل صورة حرف A ورقم كعداد ويتم البحث عن نفس الأسم إذا كان موجود مسبقا يتم إضافة حرف A والعدد
 

For ImgNo As Integer = 0 To NewImagesList.Count - 1
 
                    Dim img As Image = NewImagesList(ImgNo)
 
                    Dim OldName As New FileInfo(ImgNamesListOpenLocation(ImgNo))
 
                    Dim counter As Integer = 1
 
                    Dim NewName As String
 
                    Dim IsNewName = True
 
                    Do
 
                        NewName = (OldName.Name.Split(".")(0) & "A" & counter.ToString & "." & OldName.Name.Split(".")(1))
 
                        IsNewName = False
 
                        For Each FilStr As String In Directory.GetFiles(FolderSave.SelectedPath)
 
                            Dim Fil As New FileInfo(FilStr)
 
                            If Fil.Name = NewName Then
 
                            counter = counter + 1
 
                            IsNewName = True
 
                            Exit For
 
                            End If
 
                        Next
 
                    Loop Until IsNewName = False
 
                    img.Save(FolderSave.SelectedPath & "\" & NewName)
 
                Next
يبقى عليك أخي القارئ إضافة بعض التحسينات والشكليات الجمالية على البرنامج مثل الأيقونات وشعار للبرنامج وخلافه فيما يلي رابط صفحة المشروع باستخدام Visual Studio 2012 بلغة Vb.net مع نسخة من المشروع بتنسيق exe. جاهزة للتثبيت على جهازكم الرابط موجود في أسفل الصفحة باسم Download

http://tecnyt.com/Project.aspx?id=9#.UqcC8Zbo8wA.twitter
2

راسلني على

mamb121@hotmail.com

أو تفضل وتكرم بزيارة موقعي

www.tecnyt.com

#2

مشروع جميل

 

يعطيك العافية

 

 

وعندي ملاحظات  .....ربما تحتاجهم  بالمشروع

1- اظهار مقاس الصورة الاصلية .....

2- جعل للمستخدم الحرية باختيار صيغة الصور

3- جعل للمستخدم الحرية في مكان حفظ الصور .... بدون  مجلدات

4-  أضف صيغة الصور PNG   عند اختيار صورة

 

 

مع الشكر

1

اذا المشاركة قد نالت على أعجابك .... فارجوا التقييم  rep_up.png

#3
اقتباس

 

مشروع جميل

 

يعطيك العافية

 

 

وعندي ملاحظات  .....ربما تحتاجهم  بالمشروع

1- اظهار مقاس الصورة الاصلية .....

2- جعل للمستخدم الحرية باختيار صيغة الصور

3- جعل للمستخدم الحرية في مكان حفظ الصور .... بدون  مجلدات

4-  أضف صيغة الصور PNG   عند اختيار صورة

 

 

مع الشكر

 

 

جزاك الله خير ستكون الملاحظات في الحسبان

راسلني على

mamb121@hotmail.com

أو تفضل وتكرم بزيارة موقعي

www.tecnyt.com

#4

شكراً جزيل لكم

راسلني على

mamb121@hotmail.com

أو تفضل وتكرم بزيارة موقعي

www.tecnyt.com

مواضيع مشابهة

عدد الزوار حالياً

المتواجدون خلال آخر دقيقتين · يتحدّث كل ٣٠ ثانية

—الإجمالي—أعضاء مسجّلون—زوار بدون تسجيل

جارٍ التحقق من المتواجدين…