Esta es una pequeña aplicación que utilizo para ponerla a disposición de los inexpertos que permite reducir considerablemente el tamaño de las imágenes jpg.

Los resultados son sorprendentes y todo gracias a la librería DIjpg.dll.

El código de visual basic es el siguiente:

C:
  1. Private Declare Function DIWriteJpg Lib "DIjpg.dll" (ByVal DestPath As String, ByVal quality As Long, ByVal progressive As Long) As Long
  2. Dim nombreFichero As String
  3. Dim convertido As Boolean
  4. Dim OriginalSize As Long
  5. Dim FinalSize As Long
  6. Dim sOriginalSize As String
  7. Dim sFinalSize As String
  8. Private Sub cmdCargar_Click()
  9. convertido = False
  10. Image1.Picture = LoadPicture()
  11. Image2.Picture = LoadPicture()
  12. With dlgCommonDialog
  13. .DialogTitle = "Seleccionar archivo para convertir"
  14. .FileName = ""
  15. .CancelError = False
  16. .InitDir = App.Path
  17. .Filter = "Archivos .jpg (*.jpg)|*.jpg"
  18. .ShowOpen
  19. If Len(.FileName) = 0 Then
  20. Exit Sub
  21. End If
  22. Image1 = LoadPicture(.FileName)
  23. nombreFichero = .FileName
  24. End With
  25. OriginalSize = FileLen(nombreFichero)
  26. sOriginalSize = Mid(Str(OriginalSize), 1, Len(Str(OriginalSize)) - 3)
  27. lblOriginalSize.Caption = sOriginalSize & " Kb"
  28. End Sub
  29.  
  30. Private Sub cmdExit_Click()
  31. End
  32. End Sub
  33.  
  34. Private Sub cmdSave_Click()
  35. Dim retval As Long
  36. Dim loadStr As String
  37.  
  38. If convertido = True Then
  39. MsgBox "El archivo ya ha sido convertido"
  40. Exit Sub
  41. End If
  42. 'OtraVez:
  43. MousePointer = vbHourglass
  44. 'Initializa input path
  45. loadStr = nombreFichero
  46.  
  47. 'Requerido por DIjpg.dll
  48. SavePicture Image1.Picture, "C:\tmp.bmp"
  49. 'Salvar a JPEG
  50. On Error GoTo Error
  51. retval = DIWriteJpg(loadStr, hshQual.Value, chkProg.Value)
  52.  
  53. If retval = 1 Then  'correcto
  54. Image2.Picture = LoadPicture(loadStr)
  55. Else                'ocurrió un error
  56. MsgBox "La conversión NO fue exitosa. Intentelo de nuevo."
  57. Exit Sub
  58. End If
  59.  
  60. 'Elimino el fichero temporal
  61. Kill "C:\tmp.bmp"
  62. MousePointer = vbNormal
  63. convertido = True
  64. FinalSize = FileLen(nombreFichero)
  65. sFinalSize = Mid(Str(FinalSize), 1, Len(Str(FinalSize)) - 3)
  66. lblFinalSize.Caption = sFinalSize & " Kb"
  67. MsgBox "La conversion se ha realizado con éxito de " & sOriginalSize & " Kb a " & sFinalSize & " Kb. " _
  68. & "El tamaño del fichero se ha reducido a un " & Round(FinalSize * 100 / OriginalSize, 2) & " %", , "Información de conversion"
  69. Exit Sub
  70. Error:
  71. MsgBox Err.Description
  72. MousePointer = vbNormal
  73. End Sub
  74. Private Sub Form_Load()
  75. convertido = False
  76. End Sub
  77. Private Sub hshQual_Scroll()
  78. txtQual.Text = Str(hshQual.Value)
  79. End Sub

Descargas:
Ficheros fuentes
DIjpg.dll
freeSize.ocx

Si alguien está interesado en la instalación completa de la aplicación para windows que deje su huella en los comentarios y lo subiré.


Posts anterior y posterior:


Posts Relacionados: