Parsi Coders

با سلام خدمت شما

کسی سورسی سراغ نداره که باهاش بشه حجم یک تصویر رو کاهش داد

خیلی ضروریه هرکی داره دریغ نکنه Angel

سلام
ببین به کارت میاد ؟

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:
[attachment=16]

سلام یکی از دوستان این کد را به من داد ولی من نمیدونم که چطوری ازش استفاده کنم
هرکی که بلده سورس وی بی رو بزاره
اینم کد :

کد:
' ----==== 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 ذخیره بشه و پارامتر سوم کیفیت فایل. هر چه عدد پارامتر سوم رو کمتر کنی حجم عکست کمتر و طبیعتا عکست بی کیفیت تر میشه.

سلام
فقط یه 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 Sub

دمت گرم
انجام شد
این رو
SaveJPG Picture1, "c:\parsa.jpg", "50"
که بهش اضاف کردی ، کار کرد ، چون من یک پیکچر باکس گزاشتم ولی کار نکرد ، دمت گرم دادش

download69

Amin_Mansouri

download69

Amin_Mansouri

download69