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:

CLIC PARA VER TEXTO PLANO
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
  45. 'Initializa input path
  46. loadStr = nombreFichero
  47.  
  48. 'Requerido por DIjpg.dll
  49. SavePicture Image1.Picture, "C:\tmp.bmp"
  50. 'Salvar a JPEG
  51. On Error GoTo Error
  52. retval = DIWriteJpg(loadStr, hshQual.Value, chkProg.Value)
  53.  
  54. If retval = 1 Then  'correcto
  55. Image2.Picture = LoadPicture(loadStr)
  56. Else                'ocurrió un error
  57. MsgBox "La conversión NO fue exitosa. Intentelo de nuevo."
  58. Exit Sub
  59. End If
  60.  
  61. 'Elimino el fichero temporal
  62. Kill "C:\tmp.bmp"
  63. MousePointer = vbNormal
  64. convertido = True
  65. FinalSize = FileLen(nombreFichero)
  66. sFinalSize = Mid(Str(FinalSize), 1, Len(Str(FinalSize)) - 3)
  67. lblFinalSize.Caption = sFinalSize & " Kb"
  68. MsgBox "La conversion se ha realizado con éxito de " & sOriginalSize & " Kb a " & sFinalSize & " Kb. " _
  69. & "El tamaño del fichero se ha reducido a un " & Round(FinalSize * 100 / OriginalSize, 2) & " %", , "Información de conversion"
  70. Exit Sub
  72. Error:
  73. MsgBox Err.Description
  74. MousePointer = vbNormal
  75. End Sub
  76. Private Sub Form_Load()
  77. convertido = False
  78. End Sub
  79. Private Sub hshQual_Scroll()
  80. txtQual.Text = Str(hshQual.Value)
  81. 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: