ترددت الأسئلة فى الفترة الأخيره عن الفورمات الأخرى للصور و كيفي التعامل معها فى الفيجوال بيسيك
و آسف على تأخير الدرس و لكنى لأنشغالى الفترة السابقه
و درسنا اليوم عن التعامل مع ملفات ال jpeg فى الفيجوال بيسيك و التحويل من bmp إلى jpeg بإستخدام مكتبة ijl11.dll
فلنبدأ على بركة الله
أولا من المعروف إن الفيجوال بيسيك لا يدعم فى الحفظ إلا صيغة bmp
الفرق بين jpeg و bmp
لن أتطرق لجميع الفروق بينهما و لكن يكفى أن أقول أن ال jpeg تكون مضغوطة بطريقة معينه تجعل مساحتها أصغر كثيرا من bmp
نبدأ بدأ فى الشغل
أولا ملفات التى تحتاجها
ijl11.dll
cdibsection.cls
و سنشرح أستعمالهم
أولا
المكتبة ijl11.dll
يهمنا فيها ثلاث دوال
ijlinet
ijlwrite
ijlfree
وهذه الدوال التى سوف يتم أستعمالها للتعامل مع الصوره و لكنهم يتعاملون مع الصورة كمؤشرات و هو ما سيتم أيضاحه
و لكن قبل التطبيق لا بد من شرح الكلاس cdibsection و فائدتها
أولا ال cdibsection دى كلاس جاهزه تتعامل مع الصوره
فتقوم بتخزين المؤشرات للصوره حتى يتم النعامل معها بسهوله من حيث تحويلها من نوع إلى نوع أو التعديل فى فورمات الصوره
وقد أستعملنا هذه الكلاس لأن مكتبة ijl تتعامل مع الصوره كمؤشرات حتى يتم التحويل
على ما أظن حان وقت العمل
أول شئ ننشئ مشروع جديد و نضيف إليه الكلاس الجاهزه دى
ثانى شئ نضف موديول جديد ودى هى اللى هنحط فيها الشغل كله
نعرف دوال ال api اللى هنستخدمها
'دوال خاصه بالمكتبه Private Declare Function ijlInit Lib "ijl11.dll" (jcprops As Any) As Long Private Declare Function ijlFree Lib "ijl11.dll" (jcprops As Any) As Long Private Declare Function ijlWrite Lib "ijl11.dll" (jcprops As Any, ByVal ioType As Long) As Long 'دالة نسخ جزء من الذاكره Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
بعد ذلك نقوم بتعريف type و التى سيخزن بها معلومات الصوره
Private Type JPEG_CORE_PROPERTIES_VB ' Sadly, due to a limitation in VB (UDT variable count) UseJPEGPROPERTIES As Long '// default = 0 DIBBytes As Long '; '// default = NULL 4 DIBWidth As Long '; '// default = 0 8 DIBHeight As Long '; '// default = 0 12 DIBPadBytes As Long '; '// default = 0 16 DIBChannels As Long '; '// default = 3 20 DIBColor As Long '; '// default = IJL_BGR 24 DIBSubsampling As Long '; '// default = IJL_NONE 28 JPGFile As Long 'LPTSTR JPGFile; 32 '// default = NULL JPGBytes As Long '; '// default = NULL 36 JPGSizeBytes As Long '; '// default = 0 40 JPGWidth As Long '; '// default = 0 44 JPGHeight As Long '; '// default = 0 48 JPGChannels As Long '; '// default = 3 JPGColor As Long '; '// default = IJL_YCBCR JPGSubsampling As Long '; '// default = IJL_411 JPGThumbWidth As Long '; '// default = 0 JPGThumbHeight As Long '; '// default = 0 cconversion_reqd As Long '; '// default = TRUE upsampling_reqd As Long '; '// default = TRUE jquality As Long '; '// default = 75. 100 is my preferred quality setting. jprops(0 To 19999) As Byte End Type
ثم نقوم بكتابة الفانكشن الآتيه وهى savejpg
Public Function SaveJPG(ByRef cDib As cdibsection, ByVal sFile As String, ByVal lQuality As Long) As Boolean Dim tJ As JPEG_CORE_PROPERTIES_VB Dim bFile() As Byte Dim lPtr As Long Dim lR As Long lR = ijlInit(tJ) If lR = 0 Then ' Set up the DIB information: ' Store DIBWidth: tJ.DIBWidth = cDib.Width ' Store DIBHeight: tJ.DIBHeight = -cDib.Height ' Store DIBBytes (pointer to uncompressed JPG data): tJ.DIBBytes = cDib.DIBSectionBitsPtr ' Very important: tell IJL how many bytes extra there ' are on each DIB scan line to pad to 32 bit boundaries: tJ.DIBPadBytes = cDib.BytesPerScanLine - cDib.Width * 3 ' Set up the JPEG information: ' Store JPGFile: bFile = StrConv(sFile, vbFromUnicode) ReDim Preserve bFile(0 To UBound(bFile) + 1) As Byte bFile(UBound(bFile)) = 0 lPtr = VarPtr(bFile(0)) CopyMemory tJ.JPGFile, lPtr, 4 ' Store JPGWidth: tJ.JPGWidth = cDib.Width ' .. & JPGHeight member values: tJ.JPGHeight = cDib.Height ' Set the quality/compression to save: tJ.jquality = lQuality ' Write the image: lR = ijlWrite(tJ, 8&) If lR = 0 Then SaveJPG = True End If ' Ensure we have freed memory: ijlFree tJ End If End Function
و قبل الدخول فى شرح الفانكشن يجب أولا توضيح بعض المعلومات عن المؤشرات و دعم الفيجوال بيسيك لها
لأن دوال مكتبة ijl تتعامل مع المؤشرات
أولا المؤشرات هى أماكن تحجز فى الذاكره و لكنها مجرد العنوان و ليست القيمه المخزنه
بمعنى أنه إذا تم حجز متغير يتم حجز مكان له فى الذاكره عنوان هذا المكان فى الذاكره يسمى المؤشر
يهمنا فى المؤشرات الداله copymemory
وهى تستخدم لنقل جزء من الذاكره من مكان لآخر و طبعا نعوض عن المكانين بالمؤشرات
و تصريح الداله
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
حيث destination هو المكان المراد إيصال جزء الذاكره إليه أى مستقبل البيانات
source هو مكان وجود البيانات الأصلى
length عدد البايتات التى سيتم نقلها
الدالة varptr
وهى دالة فى الفيجوال بيسيك يتم عن طريقها تحديد المؤشر لمتغير ما أو عنصر فى مصفوفه
وتكتب بالشكل
vadress = varptr (ptr)
حيث ptr هو أسم المتغير أو عنصر المصفوفه
و vadress هو متغير يتم تعريفه لتخزين المؤشر فيه و يجب أن يكون من النوع long لأن أرقام المؤشرات كبيره نوعا ما
على ما أظن محتاجين مثال
لتحديد مؤشر لعنصر فى مصفوفه
Private Sub Command1_Click() Dim vadress As Long Dim MyArray(8) As Integer ' لإيجاد المؤشر للعنصر رقم 7 vadress = VarPtr(MyArray(7)) msgbox " المؤشر للعنصر رقم 7 هو : " & vadress End Sub
يارب تكون فكرة المؤشرات وصلت
كان ممكن أقول أستخدام الفانكشن دون التطرق لشرحها و لكنى آثرت شرحها حتى يتم المعنى
نرجع للفانكشن بتاعتنا و نشرحها سطر سطر
Public Function SaveJPG(ByRef cDib As cdibsection, ByVal sFile As String, ByVal lQuality As Long) As Boolean
هذا تصريح الفانكشن و قد عرفناها على أنها boolean لكى تعود ب true or false لمعرفة نجاح العمليه أو فشلها
معاملاتها
cdib
وهى الكلاس المرفقفه ببرنامجنا
sfile
هو الملف الذى سوف يتم تخزين فيه الصوره ال jpg
quality
الجودة وهى رقم بين 1 و 100
Dim tJ As JPEG_CORE_PROPERTIES_VB Dim bFile() As Byte Dim lPtr As Long Dim lR As Long
لقد عرفنا المتغيرات
فقد عرفنا tj على أنها jpeg_core_properaties_vb وهى الtype والتى سبق و عرفناها و التى سيتم تخزين بيانات الصور بها
lptr و ir و عرفناهم بالنوع long
lR = ijlInit(tJ)
ويتم فيه أختبار الصوره بالدالة ijllnit ووضع النتيجه فى المتغير ir
If lR = 0 Then
فى حالة نجاح الأختبار ترجع الدالة القيمه 0
' Set up the DIB information: 'تخزين العرض tJ.DIBWidth = cDib.Width 'تخزين الطول tJ.DIBHeight = -cDib.Height 'تخزين المؤشرات للصوره الأصليه tJ.DIBBytes = cDib.DIBSectionBitsPtr ' Very important: tell IJL how many bytes extra there ' are on each DIB scan line to pad to 32 bit boundaries: tJ.DIBPadBytes = cDib.BytesPerScanLine - cDib.Width * 3
يتم تحديد مواصفات الصورة التى فى cdib ووضعها فى ال tj
bFile = StrConv(sFile, vbFromUnicode)
تحويل أسم الملف من صيغة اليونيكود إلى الصيغة القياسيه ansi وتخزينه فى المصفوفه bfile
ReDim Preserve bFile(0 To UBound(bFile) + 1) As Byte
إعادة تعريف المصفوفه من صفر إلى أعلى حد فى مصفوفة أسم الملف + 1
bFile(UBound(bFile)) = 0
وضع أعلى حد فى المصفوفه بحيث يساوى صفر
lPtr = VarPtr(bFile(0))
تخزين المؤشر للحد رقم صفر فى المصفوفه - وهو بداية أسم الملف
CopyMemory tJ.JPGFile, lPtr, 4
نقل مؤشر حد المصفوفه (صفر وهو بداية أسم الملف )إلى tj.jpgfile
tJ.JPGWidth = cDib.Width tJ.JPGHeight = cDib.Height tJ.jquality = lQuality
تخزين الطول و العرض للصوره و الدقه
lR = ijlWrite(tJ, 8&)
كتابة الصورة الجديده jpg إلى الملف و تخزين النتيجه فى المتغير ir
If lR = 0 Then SaveJPG = True End If
فى حالة نجاح الدالة ترجع القيمة 0
و فى هذه الحالة تحمل الفانكشن بالقيمه true
' Ensure we have freed memory: ijlFree tJ
و بهذا نكون أكملنا كتابة الفانكشن
خد نفس عميق لأننا أنجزنا أصعب جزء فى العمليه و يتبقى الجزء الأسهل و هو أستخدام الفانكشن
نأتى لعملية الحفظ
Dim c As New cdibsection Set c = New cdibsection
يتم تعريف c على أنها كلاس من النوع cdibsection
c.CreateFromPicture LoadPicture(filename)
يتم فتح الصوره و تخزين بياناتها فى الكلاس حيث ال filename هو أسم الملف
DoEvents With CommonDialog1 .DialogTitle = "save jpg format" .Filter = "jpeg files (*.jpg)|*.jpg|" .ShowSave
أستخدام ال commondialog لإظهار مربع الحوار للحفظ
If SaveJPG(c, .FileName,quality) Then MsgBox "operation complete" Else MsgBox "failed to save the picture" End If
حفظ الصوره حيث quality هىجودة الصوره
و أختبار الفانكشن فإذا جاءت بقيمة true إذا العملية قد نجحت و إذا جاءت بقيمة غيرها إذا العملية لم تنجح
أرجو أن أكون وفقت فى الشرح مع العلم أنى قد قمت بإعادة كتابة الدرس أكثر من مرة و درست أكثر من مثال حتى أصل لأسهل طريقة لأيصال تلك المعلومه
و أنا أستخدمت المكتبه ijl11.dll
لأنها تتعامل مع ال jpg و هناك مكتبات أحدث و لكنها أسهلهم
و فى المرفقات مثال من برمجتى يوضح الفكره مع الكلاس الجاهزه cdibsection و مكتبة ijl11.dll
و لا تنسونا من الدعاء
هذا و الله أعلم
وشكرا
