سلام
برنامه ی زیر رو خودم نوشتم(البته توسعه اش دادم >> واینکه هنوز کامل نیست <<)
خلاصه ی کاری که میکنه اینه:
تو يه زمان مشخص از صفحه مانيتور عکس ميگيره و در جايي ذخيره ميکنه.
اما حجم عکسايي که ذخيره ميکنه خيلي بالاست(هرعکس 2MB).
سوال:
چکارکنم که هنگام ذخيره خيلي سريع حجمو بياره پايين و ذخير بکنه?
تا اونجا که جا هست حجمو بیاره پایین.
سلام.
از این کد برای تبدیل عکس bmp به jpg و تعیین Quality برای آن استفاده کنید.
کد:
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
دوست عزیز ممنون از پاسخ شما
میشه بیشتر توضیح بدید؟
نحوه ی استفاده و نحوه ی تعیین quality
چطوره؟
سلام.
دستورات رو در یک ماژول کپی کنید و تابع مربوطه رو صدا بزنید. کیفیت عکس هم بستگی به نیاز شما داره. هر چی عدد مربوط به کیفیت کمتر باشه عکس مربوطه بی کیفیت تر و حجم عکس هم کمتر میشه.
سلام
این کد دقیقا با همون سایزی که وارد میکنیم ذخیره نمیکنه، برای شما هم اینطوریه؟
بابام جان! اون عدد حجم فایل نیست که درجه کیفیت عکسه!
منم همین مشکل رو دارم در صورت امکان کمک کنین
و این که چطوری از این ماژول استفاده کنم
(۱۵-بهمن-۱۳۹۰, ۲۳:۲۷:۲۵)movaffag نوشته است: [ -> ]و این که چطوری از این ماژول استفاده کنم
سلام روش استفاده از ماژول:
در یک commad button بنویسید:
کد:
Call SaveJPG(Picture1.Picture, "Address\PictureName.jpg", 100)
* Address محل ذخیره ی عکس میباشد.
** البته پسوند عکس رو به غیر از jpg هم میتونید تعیین کنید.
*** Picture1.Picture حاوی عکس مورد نظر شما، جهت پایین آوردن کیفیت آن عکس میباشد.
**** عدد 100 تعیین کیفیت عکس میباشد و میتواند هر مقداری داشته باشد.
*****در مورد اینکه حجم عکس رو بیایریم پایین دوستان باید کمک کنن، چون من هم بلد نیستم- این ماژول کیفیت عکس رو پایین میاره.
سلام.
خوب عزیز من کیفیت بیاد پایین حجم هم کاهش پیدا میکنه دیگه.
