[download69]

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

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

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

[Amin_Mansouri]

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

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)

[download69]

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

کد:

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

[Amin_Mansouri]

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

[download69]

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