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

اعادة حفظ صورة بدقة اقل

مغلق
بدأه عبدالفتاح حسن في 5 سبتمبر 2007 · 3 رد · 918 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

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

يسهل حفظها فقد قمت بإضافة كود يمكن من خلاله تغير ابعاد الصورة بالإستعانة بـ pictureBox

Function ReSizePic(Pic_fileName As String) As String
	pictureBox1.Width = 6000
	pictureBox1.Height = 6000
	pictureBox1.PaintPicture LoadPicture(Pic_fileName), 0, 0, 6000, 6000, 0, 0
	ReSizePic = App.Path & "\Tmppicture.tmp"
	SavePicture pictureBox1.Image, ReSizePic
End Function

تم تعديل هذه المشاركة بواسطة عبدالفتاح حسن في 5 سبتمبر 2007 في 15:42

كن كالنخيل عن الأحقاد مرتفعا .. يرمى بصخر فيرمى أطيب الثمر

#2

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

وقد تم ارفاق مثال حتى تعم الفائدة يتم فيه التحويل من bmp الى jpg

BmpToJpg.rar

BmpToJpg.rar

كن كالنخيل عن الأحقاد مرتفعا .. يرمى بصخر فيرمى أطيب الثمر

#3

لو اللى أنت هتستعمله هو التحويل من BMP لـ JPG بس فلا داعى ﻷى أداة , يمكنك اﻷعتماد على الـ Module التالى :

'ModSaveJpg
'By : Tmax
'http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=66454&lngWId=1
Option Explicit

Private Type GUID

   Data1 As Long

   Data2 As Integer

   Data3 As Integer

   Data4(0 To 7) As Byte

End Type



Private Type GdiplusStartupInput

   GdiplusVersion As Long

   DebugEventCallback As Long

   SuppressBackgroundThread As Long

   SuppressExternalCodecs As Long

End Type



Private Type EncoderParameter

   GUID As GUID

   NumberOfValues As Long

   Type As Long

   Value As Long

End Type



Private Type EncoderParameters

   Count As Long

   Parameter As EncoderParameter

End Type



Private Declare Function GdiplusStartup Lib "GdiPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long

Private Declare Function GdiplusShutdown Lib "GdiPlus" (ByVal token As Long) As Long

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GdiPlus" (ByVal hbm As Long, ByVal hPal As Long, Bitmap As Long) As Long

Private Declare Function GdipDisposeImage Lib "GdiPlus" (ByVal Image As Long) As Long

Private Declare Function GdipSaveImageToFile Lib "GdiPlus" (ByVal Image As Long, ByVal FileName As Long, clsidEncoder As GUID, encoderParams As Any) As Long

Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long



Public Sub SaveJPG(ByVal pict As StdPicture, ByVal FileName As String, Optional ByVal quality As Byte = 80)

Dim tSI As GdiplusStartupInput

Dim lRes As Long

Dim lGDIP As Long

Dim lBitmap As Long



tSI.GdiplusVersion = 1

lRes = GdiplusStartup(lGDIP, tSI)



If lRes = 0 Then

   lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)

   If lRes = 0 Then

	  Dim tJpgEncoder As GUID

	  Dim tParams As EncoderParameters

	  CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

	  tParams.Count = 1

	  With tParams.Parameter

		 CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID

		 .NumberOfValues = 1

		 .Type = 4

		 .Value = VarPtr(quality)

	  End With

	 lRes = GdipSaveImageToFile(lBitmap, StrPtr(FileName), tJpgEncoder, tParams)

	  GdipDisposeImage lBitmap

   End If

   GdiplusShutdown lGDIP

End If

If lRes Then

   Err.Raise 17, , Error(17) & " " & lRes

End If

End Sub

إقرأ معى:

melal.jpg

----

المثقفون العرب .. المزورون العرب: تأبين محمود درويش نموذجا

ماذا خسر العالم بانحطاط المسلمين ؟!! للعلامه: أبو الحسن الندوى (كتاب هام لكل مسلم).

المنهجية ومقدمات في الطلب (لطلاب العلم الشرعى)

#4

شكرا اخى الكريم على هذا الكود

بالتأكيد هو افضل بكثير من استخدام اداه او مكتبة خارجية يجب ان ترفق مع المشروع وقد يكون لها مساوئ لاتظهر الا فيما بعد ( فى زمن التشغيل)

كن كالنخيل عن الأحقاد مرتفعا .. يرمى بصخر فيرمى أطيب الثمر

هذا الموضوع مغلق.

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