+- Parsi Coders (http://parsicoders.com)
+-- انجمن: Software Development Programming (http://parsicoders.com/forumdisplay.php?fid=37)
+--- انجمن: Visual Basic Programming (http://parsicoders.com/forumdisplay.php?fid=39)
+---- انجمن: Visual Basic 6 (http://parsicoders.com/forumdisplay.php?fid=44)
+---- موضوع: درخواست سورسی که حجم تصاویر را کاهش می دهد (/showthread.php?tid=333)
درخواست سورسی که حجم تصاویر را کاهش می دهد - download69 - 05-30-2011
با سلام خدمت شما
کسی سورسی سراغ نداره که باهاش بشه حجم یک تصویر رو کاهش داد
خیلی ضروریه هرکی داره دریغ نکنه
RE: درخواست سورسی که حجم تصاویر را کاهش می دهد - Amin_Mansouri - 05-30-2011
سلام
ببین به کارت میاد ؟
This program will resize all the images in a folder and then save them as a jpg. This comes in handy when you have alot of screen shots or decompiled a avi movie and have alot of images you need smaller. Please vote and leave comments. (This saves as true .jpg files not bmps with the extension of jpg) (the required dll is included)
download:
Mass_image(www.parsicoders.com).zip (اندازه 123.4 KB / تعداد دانلود: 24)
RE: درخواست سورسی که حجم تصاویر را کاهش می دهد - download69 - 06-04-2011
سلام یکی از دوستان این کد را به من داد ولی من نمیدونم که چطوری ازش استفاده کنم
هرکی که بلده سورس وی بی رو بزاره
اینم کد :
کد:
' ----==== API Declarations ====----
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
' ----==== SaveJPG ====----
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
' Initialize GDI+
tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI)
If lRes = 0 Then
' Create the GDI+ bitmap
' from the image handle
lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
If lRes = 0 Then
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters
' Initialize the encoder GUID
CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), _
tJpgEncoder
' Initialize the encoder parameters
tParams.Count = 1
With tParams.Parameter ' Quality
' Set the Quality GUID
CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
.NumberOfValues = 1
.type = 4
.Value = VarPtr(quality)
End With
' Save the image
lRes = GdipSaveImageToFile( _
lBitmap, _
StrPtr(filename), _
tJpgEncoder, _
tParams)
' Destroy the bitmap
GdipDisposeImage lBitmap
End If
' Shutdown GDI+
GdiplusShutdown lGDIP
End If
If lRes Then
Err.Raise 5, , "Cannot save the image. GDI+ Error:" & lRes
End If
End Subاینم توضیحاتی که خودش داد :
نقل قول:پارامتر اول متد savejpg رو یه picturebox بفرست. پارامتر دوم یه آدرس که فایل jpg ذخیره بشه و پارامتر سوم کیفیت فایل. هر چه عدد پارامتر سوم رو کمتر کنی حجم عکست کمتر و طبیعتا عکست بی کیفیت تر میشه.
RE: درخواست سورسی که حجم تصاویر را کاهش می دهد - Amin_Mansouri - 06-04-2011
سلام
فقط یه picturebox به فرمت اضافه کن همین
کد:
'Www.parsicoders.com
' ----==== API Declarations ====----
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
' ----==== SaveJPG ====----
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
' Initialize GDI+
tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI)
If lRes = 0 Then
' Create the GDI+ bitmap
' from the image handle
lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
If lRes = 0 Then
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters
' Initialize the encoder GUID
CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), _
tJpgEncoder
' Initialize the encoder parameters
tParams.Count = 1
With tParams.Parameter ' Quality
' Set the Quality GUID
CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
.NumberOfValues = 1
.type = 4
.Value = VarPtr(quality)
End With
' Save the image
lRes = GdipSaveImageToFile( _
lBitmap, _
StrPtr(filename), _
tJpgEncoder, _
tParams)
' Destroy the bitmap
GdipDisposeImage lBitmap
End If
' Shutdown GDI+
GdiplusShutdown lGDIP
End If
If lRes Then
Err.Raise 5, , "Cannot save the image. GDI+ Error:" & lRes
End If
End Sub
Private Sub Form_Load()
Picture1.Picture = LoadPicture("c:\www.parsicoders.jpg")
SaveJPG Picture1, "c:\parsa.jpg", "50"
End SubRE: درخواست سورسی که حجم تصاویر را کاهش می دهد - download69 - 06-04-2011
دمت گرم
انجام شد
این رو
SaveJPG Picture1, "c:\parsa.jpg", "50"
که بهش اضاف کردی ، کار کرد ، چون من یک پیکچر باکس گزاشتم ولی کار نکرد ، دمت گرم دادش