• Jueves 30 de Junio de 2022, 15:22

Autor Tema:  Convertir De Bmp A Jpg  (Leído 2993 veces)

9tnix

  • Miembro MUY activo
  • ***
  • Mensajes: 165
  • Nacionalidad: pe
    • Ver Perfil
Convertir De Bmp A Jpg
« en: Viernes 27 de Enero de 2006, 22:28 »
0
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
TP-Systems
our knowledge is our power!

Amilius

  • Miembro HIPER activo
  • ****
  • Mensajes: 665
    • Ver Perfil
Re: Convertir De Bmp A Jpg
« Respuesta #1 en: Viernes 27 de Enero de 2006, 23:02 »
0
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

  • Miembro HIPER activo
  • ****
  • Mensajes: 629
    • Ver Perfil
    • http://www.cpimario.com
Re: Convertir De Bmp A Jpg
« Respuesta #2 en: Domingo 29 de Enero de 2006, 00:54 »
0

jc_moty

  • Miembro activo
  • **
  • Mensajes: 28
    • Ver Perfil
Re: Convertir De Bmp A Jpg
« Respuesta #3 en: Lunes 30 de Enero de 2006, 03:17 »
0
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
  1.  
  2. Option Explicit
  3.  
  4. ' ----==== GDIPlus Const ====----
  5. Const GdiPlusVersion As Long = 1
  6. Private Const EncoderParameterValueTypeLong As Long = 4
  7. Private Const EncoderQuality As String = _
  8.     "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
  9.  
  10. ' ----==== Sonstige Types ====----
  11. Public Enum MimeType
  12.     JPG = 0
  13.     GIF = 1
  14.     PNG = 2
  15.     BMP = 3
  16. End Enum
  17.  
  18. Private Type PICTDESC
  19.     cbSizeOfStruct As Long
  20.     picType As Long
  21.     hgdiObj As Long
  22.     hPalOrXYExt As Long
  23. End Type
  24.  
  25. Private Type IID
  26.     Data1 As Long
  27.     Data2 As Integer
  28.     Data3 As Integer
  29.     Data4(0 To 7)  As Byte
  30. End Type
  31.  
  32. Private Type GUID
  33.     Data1 As Long
  34.     Data2 As Integer
  35.     Data3 As Integer
  36.     Data4(0 To 7) As Byte
  37. End Type
  38.  
  39. ' ----==== GDIPlus Types ====----
  40. Private Type GDIPlusStartupInput
  41.     GdiPlusVersion As Long
  42.     DebugEventCallback As Long
  43.     SuppressBackgroundThread As Long
  44.     SuppressExternalCodecs As Long
  45. End Type
  46.  
  47. Private Type EncoderParameter
  48.     GUID As GUID
  49.     NumberOfValues As Long
  50.     type As Long
  51.     Value As Long
  52. End Type
  53.  
  54. Private Type EncoderParameters
  55.     Count As Long
  56.     Parameter(15) As EncoderParameter
  57. End Type
  58.  
  59. Private Type ImageCodecInfo
  60.     Clsid As GUID
  61.     FormatID As GUID
  62.     CodecNamePtr As Long
  63.     DllNamePtr As Long
  64.     FormatDescriptionPtr As Long
  65.     FilenameExtensionPtr As Long
  66.     MimeTypePtr As Long
  67.     flags As Long
  68.     Version As Long
  69.     SigCount As Long
  70.     SigSize As Long
  71.     SigPatternPtr As Long
  72.     SigMaskPtr As Long
  73. End Type
  74.  
  75. ' ----==== GDIPlus Enums ====----
  76. Public Enum Status 'GDI+ Status
  77.     OK = 0
  78.     GenericError = 1
  79.     InvalidParameter = 2
  80.     OutOfMemory = 3
  81.     ObjectBusy = 4
  82.     InsufficientBuffer = 5
  83.     NotImplemented = 6
  84.     Win32Error = 7
  85.     WrongState = 8
  86.     Aborted = 9
  87.     FileNotFound = 10
  88.     ValueOverflow = 11
  89.     AccessDenied = 12
  90.     UnknownImageFormat = 13
  91.     FontFamilyNotFound = 14
  92.     FontStyleNotFound = 15
  93.     NotTrueTypeFont = 16
  94.     UnsupportedGdiplusVersion = 17
  95.     GdiplusNotInitialized = 18
  96.     PropertyNotFound = 19
  97.     PropertyNotSupported = 20
  98.     ProfileNotFound = 21
  99. End Enum
  100.  
  101. ' ----==== GDI+ API Declarationen ====----
  102. Private Declare Function GdiplusStartup Lib "gdiplus" _
  103.     (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, _
  104.     Optional ByRef lpOutput As Any) As Status
  105.  
  106. Private Declare Function GdiplusShutdown Lib "gdiplus" _
  107.     (ByVal token As Long) As Status
  108.  
  109. Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _
  110.     (ByVal FileName As Long, ByRef Bitmap As Long) As Status
  111.  
  112. Private Declare Function GdipSaveImageToFile Lib "gdiplus" _
  113.     (ByVal image As Long, ByVal FileName As Long, _
  114.     ByRef clsidEncoder As GUID, _
  115.     ByRef encoderParams As Any) As Status
  116.  
  117. Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" _
  118.     (ByVal Bitmap As Long, ByRef hbmReturn As Long, _
  119.     ByVal background As Long) As Status
  120.  
  121. Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _
  122.     (ByVal hbm As Long, ByVal hpal As Long, _
  123.     ByRef Bitmap As Long) As Status
  124.  
  125. Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" _
  126.     (ByRef numEncoders As Long, ByRef Size As Long) As Status
  127.  
  128. Private Declare Function GdipGetImageEncoders Lib "gdiplus" _
  129.     (ByVal numEncoders As Long, ByVal Size As Long, _
  130.     ByRef Encoders As Any) As Status
  131.  
  132. Private Declare Function GdipDisposeImage Lib "gdiplus" _
  133.     (ByVal image As Long) As Status
  134.  
  135.  
  136. Private Declare Function CLSIDFromString Lib "ole32" _
  137.     (ByVal str As Long, id As GUID) As Long
  138.  
  139. Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" _
  140.     (lpPictDesc As PICTDESC, riid As IID, ByVal fOwn As Boolean, _
  141.     lplpvObj As Object)
  142.  
  143. Private Declare Function lstrlenW Lib "kernel32" _
  144.     (lpString As Any) As Long
  145.  
  146. Private Declare Function lstrcpyW Lib "kernel32" _
  147.     (lpString1 As Any, lpString2 As Any) As Long
  148.  
  149. Private retStatus As Status
  150. Private GdipToken As Long
  151. Private GdipInitialized As Boolean
  152.  
  153. Private Function StartUpGDIPlus(ByVal GdipVersion As Long) As Status
  154.     Dim GdipStartupInput As GDIPlusStartupInput
  155.     GdipStartupInput.GdiPlusVersion = GdipVersion
  156.     StartUpGDIPlus = GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
  157. End Function
  158.  
  159. Private Function ShutdownGDIPlus() As Status
  160.    ShutdownGDIPlus = GdiplusShutdown(GdipToken)
  161. End Function
  162.  
  163. Private Function Execute(ByVal lReturn As Status) As Status
  164.     Dim lCurErr As Status
  165.     If lReturn = Status.OK Then
  166.         lCurErr = Status.OK
  167.     Else
  168.         lCurErr = lReturn
  169.        
  170.     End If
  171.     Execute = lCurErr
  172. End Function
  173.  
  174. Public Function Convertir(ByVal Pic As StdPicture, _
  175.     ByVal FileName As String, Optional ByVal Quality As Long = 85, _
  176.     Optional ByVal FileType As MimeType = JPG) _
  177.     As Boolean
  178.    
  179.     Dim retStatus As Status
  180.     Dim retVal As Boolean
  181.     Dim lBitmap As Long
  182.     '// Variable para el MimeType
  183.     Dim mimeT As String
  184.    
  185.     Iniciar
  186.    
  187.     If GdipInitialized = False Then Exit Function
  188.     ' Erzeugt eine GDI+ Bitmap vom StdPicture Handle -> lBitmap
  189.     retStatus = Execute(GdipCreateBitmapFromHBITMAP(Pic.Handle, 0, _
  190.         lBitmap))
  191.    
  192.     If retStatus = OK Then
  193.        
  194.         Dim PicEncoder As GUID
  195.         Dim tParams As EncoderParameters
  196.        
  197.         '// Seleccion de casos para el MimeType
  198.         Select Case FileType
  199.             Case JPG
  200.                 mimeT = "image/jpeg"
  201.             Case GIF
  202.                 mimeT = "image/gif"
  203.             Case PNG
  204.                 mimeT = "image/png"
  205.             Case BMP
  206.                 mimeT = "image/bmp"
  207.         End Select
  208.        
  209.         '// Ermitteln der CLSID vom mimeType Encoder
  210.         retVal = GetEncoderClsid(mimeT, PicEncoder)
  211.         If retVal = True Then
  212.              
  213.               If Quality > 100 Then Quality = 100
  214.               If Quality < 0 Then Quality = 0
  215.              
  216.               ' Initialisieren der Encoderparameter
  217.               tParams.Count = 1
  218.               With tParams.Parameter(0) ' Quality
  219.                   ' Setzen der Quality GUID
  220.                   CLSIDFromString StrPtr(EncoderQuality), .GUID
  221.                   .NumberOfValues = 1
  222.                   .type = EncoderParameterValueTypeLong
  223.                   .Value = VarPtr(Quality)
  224.               End With
  225.              
  226.               ' Speichert lBitmap als JPG
  227.               retStatus = Execute(GdipSaveImageToFile(lBitmap, _
  228.                   StrPtr(FileName), PicEncoder, tParams))
  229.              
  230.               If retStatus = OK Then
  231.                   Convertir = True
  232.               Else
  233.                   Convertir = False
  234.               End If
  235.         Else
  236.               Convertir = False
  237.               MsgBox "Konnte keinen passenden Encoder ermitteln.", _
  238.               vbOKOnly, "Encoder Error"
  239.         End If
  240.        
  241.         ' Lösche lBitmap
  242.         Call Execute(GdipDisposeImage(lBitmap))
  243.        
  244.     Dim ret As Long
  245.  
  246.     If GdipInitialized = True Then
  247.        ret = Execute(ShutdownGDIPlus)
  248.     End If
  249.     End If
  250. End Function
  251.  
  252. Private Function GetEncoderClsid(MimeType As String, pClsid As GUID) _
  253.     As Boolean
  254.    
  255.     Dim num As Long
  256.     Dim Size As Long
  257.     Dim pImageCodecInfo() As ImageCodecInfo
  258.     Dim j As Long
  259.     Dim buffer As String
  260.    
  261.     Call GdipGetImageEncodersSize(num, Size)
  262.     If (Size = 0) Then
  263.         GetEncoderClsid = False
  264.         Exit Function
  265.     End If
  266.    
  267.     ReDim pImageCodecInfo(0 To Size \ Len(pImageCodecInfo(0)) - 1)
  268.     Call GdipGetImageEncoders(num, Size, pImageCodecInfo(0))
  269.    
  270.     For j = 0 To num - 1
  271.         buffer = Space$(lstrlenW(ByVal pImageCodecInfo(j).MimeTypePtr))
  272.        
  273.         Call lstrcpyW(ByVal StrPtr(buffer), ByVal _
  274.               pImageCodecInfo(j).MimeTypePtr)
  275.              
  276.         If (StrComp(buffer, MimeType, vbTextCompare) = 0) Then
  277.               pClsid = pImageCodecInfo(j).Clsid
  278.               Erase pImageCodecInfo
  279.               GetEncoderClsid = True
  280.               Exit Function
  281.         End If
  282.     Next j
  283.    
  284.     Erase pImageCodecInfo
  285.     GetEncoderClsid = False
  286. End Function
  287.  
  288. Private Sub Iniciar()
  289.  Dim ret As Long
  290.  ret = Execute(StartUpGDIPlus(1))
  291.     If ret = 0 Then
  292.         GdipInitialized = True
  293.     Else
  294.         MsgBox "El GDI no está inicializado", vbOKOnly, "GDI Error"
  295.     End If
  296. End Sub
  297.  
  298.  
Su uso desde un CommandButton:
Código: Text
  1.  
  2. Private Sub Command1_Click()
  3.     Convertir Picture1, "C:\Bitmap.bmp", , BMP
  4.     Convertir Picture1, "C:\ImagenPNG.png", , PNG
  5.     Convertir Picture1, "C:\ImagenJPG.jpg", , JPG
  6.     Convertir Picture1, "C:\ImagenGIF.gif", , GIF
  7. End Sub
  8.  
  9.  
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:
[size=109]Compartir el conocimiento es una acción de seres inteligentes, que han comprobado que el conocimiento es un bien que crece a medida que se lo comparte.

Firma la petición para que Microsoft mantenga activo VB6(mas información]aquí[/url])[/size]

9tnix

  • Miembro MUY activo
  • ***
  • Mensajes: 165
  • Nacionalidad: pe
    • Ver Perfil
Re: Convertir De Bmp A Jpg
« Respuesta #4 en: Lunes 6 de Febrero de 2006, 17:02 »
0
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
TP-Systems
our knowledge is our power!