Programación General > Visual Basic 6.0 e inferiores
Convertir De Bmp A Jpg
(1/1)
9tnix:
Hola gente
Necesito convertir los bmp a jpg para hacer mas ligero el envio de imagenes por la red usando winsock porque cuando los envio con bmp es muy pesada la imagen aprox mas de 1 MB y si fuera JPG pues seria algo de 125 Kb y seria mejor.
Espero su ayuda
Att. Rick
Amilius:
usas el objeto TjpegImage (uses JPEG si mal no recuerdo), configuras las opciones de calidad a 40 a 60 para la compresion tipica y le asignas una imagen en bmp y luego lo guardas como jpg.
cpmario:
Revisa esta discusión:
http://foros.solocodigo.com/index.php?showtopic=16522&hl=jpg
:comp:
jc_moty:
Bueno, buscando por ahi me tope con un código que permite convertir el contenido de un Picturebox a JPG y con unas cuantas modificaciones he logrado hacer que guarde imagenes en formato: GIF, PNG, BMP y obviamente JPG.
Aqui dejo el código:
En un Modulo:
--- Código: Text --- Option Explicit ' ----==== GDIPlus Const ====----Const GdiPlusVersion As Long = 1Private Const EncoderParameterValueTypeLong As Long = 4Private Const EncoderQuality As String = _ "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}" ' ----==== Sonstige Types ====----Public Enum MimeType JPG = 0 GIF = 1 PNG = 2 BMP = 3End Enum Private Type PICTDESC cbSizeOfStruct As Long picType As Long hgdiObj As Long hPalOrXYExt As LongEnd Type Private Type IID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As ByteEnd Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As ByteEnd Type ' ----==== GDIPlus Types ====----Private Type GDIPlusStartupInput GdiPlusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As LongEnd Type Private Type EncoderParameter GUID As GUID NumberOfValues As Long type As Long Value As LongEnd Type Private Type EncoderParameters Count As Long Parameter(15) As EncoderParameterEnd Type Private Type ImageCodecInfo Clsid As GUID FormatID As GUID CodecNamePtr As Long DllNamePtr As Long FormatDescriptionPtr As Long FilenameExtensionPtr As Long MimeTypePtr As Long flags As Long Version As Long SigCount As Long SigSize As Long SigPatternPtr As Long SigMaskPtr As LongEnd Type ' ----==== GDIPlus Enums ====----Public Enum Status 'GDI+ Status OK = 0 GenericError = 1 InvalidParameter = 2 OutOfMemory = 3 ObjectBusy = 4 InsufficientBuffer = 5 NotImplemented = 6 Win32Error = 7 WrongState = 8 Aborted = 9 FileNotFound = 10 ValueOverflow = 11 AccessDenied = 12 UnknownImageFormat = 13 FontFamilyNotFound = 14 FontStyleNotFound = 15 NotTrueTypeFont = 16 UnsupportedGdiplusVersion = 17 GdiplusNotInitialized = 18 PropertyNotFound = 19 PropertyNotSupported = 20 ProfileNotFound = 21End Enum ' ----==== GDI+ API Declarationen ====----Private Declare Function GdiplusStartup Lib "gdiplus" _ (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, _ Optional ByRef lpOutput As Any) As Status Private Declare Function GdiplusShutdown Lib "gdiplus" _ (ByVal token As Long) As Status Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _ (ByVal FileName As Long, ByRef Bitmap As Long) As Status Private Declare Function GdipSaveImageToFile Lib "gdiplus" _ (ByVal image As Long, ByVal FileName As Long, _ ByRef clsidEncoder As GUID, _ ByRef encoderParams As Any) As Status Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" _ (ByVal Bitmap As Long, ByRef hbmReturn As Long, _ ByVal background As Long) As Status Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _ (ByVal hbm As Long, ByVal hpal As Long, _ ByRef Bitmap As Long) As Status Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" _ (ByRef numEncoders As Long, ByRef Size As Long) As Status Private Declare Function GdipGetImageEncoders Lib "gdiplus" _ (ByVal numEncoders As Long, ByVal Size As Long, _ ByRef Encoders As Any) As Status Private Declare Function GdipDisposeImage Lib "gdiplus" _ (ByVal image As Long) As Status Private Declare Function CLSIDFromString Lib "ole32" _ (ByVal str As Long, id As GUID) As Long Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" _ (lpPictDesc As PICTDESC, riid As IID, ByVal fOwn As Boolean, _ lplpvObj As Object) Private Declare Function lstrlenW Lib "kernel32" _ (lpString As Any) As Long Private Declare Function lstrcpyW Lib "kernel32" _ (lpString1 As Any, lpString2 As Any) As Long Private retStatus As StatusPrivate GdipToken As LongPrivate GdipInitialized As Boolean Private Function StartUpGDIPlus(ByVal GdipVersion As Long) As Status Dim GdipStartupInput As GDIPlusStartupInput GdipStartupInput.GdiPlusVersion = GdipVersion StartUpGDIPlus = GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)End Function Private Function ShutdownGDIPlus() As Status ShutdownGDIPlus = GdiplusShutdown(GdipToken)End Function Private Function Execute(ByVal lReturn As Status) As Status Dim lCurErr As Status If lReturn = Status.OK Then lCurErr = Status.OK Else lCurErr = lReturn End If Execute = lCurErrEnd Function Public Function Convertir(ByVal Pic As StdPicture, _ ByVal FileName As String, Optional ByVal Quality As Long = 85, _ Optional ByVal FileType As MimeType = JPG) _ As Boolean Dim retStatus As Status Dim retVal As Boolean Dim lBitmap As Long '// Variable para el MimeType Dim mimeT As String Iniciar If GdipInitialized = False Then Exit Function ' Erzeugt eine GDI+ Bitmap vom StdPicture Handle -> lBitmap retStatus = Execute(GdipCreateBitmapFromHBITMAP(Pic.Handle, 0, _ lBitmap)) If retStatus = OK Then Dim PicEncoder As GUID Dim tParams As EncoderParameters '// Seleccion de casos para el MimeType Select Case FileType Case JPG mimeT = "image/jpeg" Case GIF mimeT = "image/gif" Case PNG mimeT = "image/png" Case BMP mimeT = "image/bmp" End Select '// Ermitteln der CLSID vom mimeType Encoder retVal = GetEncoderClsid(mimeT, PicEncoder) If retVal = True Then If Quality > 100 Then Quality = 100 If Quality < 0 Then Quality = 0 ' Initialisieren der Encoderparameter tParams.Count = 1 With tParams.Parameter(0) ' Quality ' Setzen der Quality GUID CLSIDFromString StrPtr(EncoderQuality), .GUID .NumberOfValues = 1 .type = EncoderParameterValueTypeLong .Value = VarPtr(Quality) End With ' Speichert lBitmap als JPG retStatus = Execute(GdipSaveImageToFile(lBitmap, _ StrPtr(FileName), PicEncoder, tParams)) If retStatus = OK Then Convertir = True Else Convertir = False End If Else Convertir = False MsgBox "Konnte keinen passenden Encoder ermitteln.", _ vbOKOnly, "Encoder Error" End If ' Lösche lBitmap Call Execute(GdipDisposeImage(lBitmap)) Dim ret As Long If GdipInitialized = True Then ret = Execute(ShutdownGDIPlus) End If End IfEnd Function Private Function GetEncoderClsid(MimeType As String, pClsid As GUID) _ As Boolean Dim num As Long Dim Size As Long Dim pImageCodecInfo() As ImageCodecInfo Dim j As Long Dim buffer As String Call GdipGetImageEncodersSize(num, Size) If (Size = 0) Then GetEncoderClsid = False Exit Function End If ReDim pImageCodecInfo(0 To Size \ Len(pImageCodecInfo(0)) - 1) Call GdipGetImageEncoders(num, Size, pImageCodecInfo(0)) For j = 0 To num - 1 buffer = Space$(lstrlenW(ByVal pImageCodecInfo(j).MimeTypePtr)) Call lstrcpyW(ByVal StrPtr(buffer), ByVal _ pImageCodecInfo(j).MimeTypePtr) If (StrComp(buffer, MimeType, vbTextCompare) = 0) Then pClsid = pImageCodecInfo(j).Clsid Erase pImageCodecInfo GetEncoderClsid = True Exit Function End If Next j Erase pImageCodecInfo GetEncoderClsid = FalseEnd Function Private Sub Iniciar() Dim ret As Long ret = Execute(StartUpGDIPlus(1)) If ret = 0 Then GdipInitialized = True Else MsgBox "El GDI no está inicializado", vbOKOnly, "GDI Error" End IfEnd Sub Su uso desde un CommandButton:
--- Código: Text --- Private Sub Command1_Click() Convertir Picture1, "C:\Bitmap.bmp", , BMP Convertir Picture1, "C:\ImagenPNG.png", , PNG Convertir Picture1, "C:\ImagenJPG.jpg", , JPG Convertir Picture1, "C:\ImagenGIF.gif", , GIFEnd Sub Tene en cuenta que este codigo hace uso de las funciones contenidas en la libreria gdiplus.dll y esta solamente viene incluida con Windows XP, es decir que para ejecutar este programa en versiones anteriores de Windows, debes descargar esta libreria; aqui dejo un vinculo donde podes descargarla: Descargar GDI+.
Agradecimientos a: Leandro (por postear el codigo), y a Luciano (por su modificacion y simplificacion).
Saludos :comp:
9tnix:
Hola gente
hey muchahos jc_moty, cpmario, amilius gracias por sus aportes para resolver mi duda, en fin creo que estoy metiendo mucho floro a este foro jejeje solo keria darles las gracias y tmb decir algo.
amilius: gracias por responder pero creo que el TjpegImage es un component de Delphi y tendria que compilarlo en una dll para poder luego enlazarlo con vb
cpmario: olvide hacer la busqueda y bueno tenias razon la proxima buscare la proxima vez.
jc_moti: gracias por responder enviandome el code y por hacer las modificaciones para poder usarlo
Agradecimientos a: Leandro (por postear el codigo), y a Luciano (por su modificacion y simplificacion).
gracias a todos.
hace un tiempo estuve haciendo lo que hace el msn lo de asistencia remota y para ello necesitaba capturar la pantalla y enviarlo por winsock a otro ekipo para poder hacer la asistencia remota se entiende verdad? y bueno lo deje inconcluso y me he propuesto nuevamente retomarlo es por eso que pregunte esto de convertir a JPG ya ke el envio con BMP era muy lento.
Gracias muchachos por sus aportaciones
Att. Rick
Navegación
Ir a la versión completa