Galera, boa tarde!

 

Estou montando um sistema onde capturo imagens e salvo elas em disco.

Estou utilizando um picturebox1 e para salvar estou usando o seguinte comando:

 

SavePicture Picture1.Image, "c:img1.jpg"

 

O problema que essa imagem não ta salvando como jpg. Percebo que pelo tamanho que ela ta como BMP(224 kb). Ai qdo eu edito a imagem no paint e mando salvar em jpg ai reduz o tamenho para 6kb.

 

alguém poderia dar uma dica como fazer isso?

 

Valeu pela força de todos.

 

Abs

 

Leandro Ramos

use o gdi para isto veja o código

inclua em um form:

 

01 Picturebox

02 TextBox

01 CommandButton

 

e cole o código abaixo

 

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

Private Sub Command1_Click()
If Dir(Text2.Text) <> "" Then
  If MsgBox("Você quer substituir " & Text2.Text & " ?", 292) <> 6 Then Exit Sub
End If

If SaveJPG(Picture1.Picture, Text2.Text, 100) = 0 Then
  MsgBox "Arquivo " & Text2.Text & " convertido com sucesso !", 48
End If
End Sub

Private Sub Form_Load()
Text1.Text = "C:Documents and SettingsAdministradorMeus documentosMinhas imagensecicl.bmp"
Picture1.Picture = LoadPicture(Text1.Text)
End Sub

Private Sub Text1_Change()
Text2.Text = Replace(Text1.Text, ".bmp", ".jpg")
End Sub

Public Function SaveJPG(ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 80) As Long
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
  
   SaveJPG = lRes
   MsgBox Err.Number
  If lRes Then Err.Raise 98775, "GDI+.SaveJPG", "Cannot save the image, error number " & lRes
End Function

Treze, boa tarde!

 

Cara valeu mesmo, funcionou o código.

 

Era isso que eu precisava.

 

tks

 

Leandro