davidsuarez.es

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]
Private Declare Function DIWriteJpg Lib “DIjpg.dll” (ByVal DestPath As String, ByVal quality As Long, ByVal progressive As Long) As Long
Dim nombreFichero As String
Dim convertido As Boolean
Dim OriginalSize As Long
Dim FinalSize As Long
Dim sOriginalSize As String
Dim sFinalSize As String
Private Sub cmdCargar_Click()
convertido = False
Image1.Picture = LoadPicture()
Image2.Picture = LoadPicture()
With dlgCommonDialog
.DialogTitle = “Seleccionar archivo para convertir”
.FileName = “”
.CancelError = False
.InitDir = App.Path
.Filter = “Archivos .jpg (*.jpg)|*.jpg”
.ShowOpen
If Len(.FileName) = 0 Then
Exit Sub
End If
Image1 = LoadPicture(.FileName)
nombreFichero = .FileName
End With
OriginalSize = FileLen(nombreFichero)
sOriginalSize = Mid(Str(OriginalSize), 1, Len(Str(OriginalSize)) – 3)
lblOriginalSize.Caption = sOriginalSize & ” Kb”
End Sub

Private Sub cmdExit_Click()
End
End Sub

Private Sub cmdSave_Click()
Dim retval As Long
Dim loadStr As String

If convertido = True Then
MsgBox “El archivo ya ha sido convertido”
Exit Sub
End If
‘OtraVez:
MousePointer = vbHourglass

‘Initializa input path
loadStr = nombreFichero

‘Requerido por DIjpg.dll
SavePicture Image1.Picture, “C:\tmp.bmp”
‘Salvar a JPEG
On Error GoTo Error
retval = DIWriteJpg(loadStr, hshQual.Value, chkProg.Value)

If retval = 1 Then ‘correcto
Image2.Picture = LoadPicture(loadStr)
Else ‘ocurrió un error
MsgBox “La conversión NO fue exitosa. Intentelo de nuevo.”
Exit Sub
End If

‘Elimino el fichero temporal
Kill “C:\tmp.bmp”
MousePointer = vbNormal
convertido = True
FinalSize = FileLen(nombreFichero)
sFinalSize = Mid(Str(FinalSize), 1, Len(Str(FinalSize)) – 3)
lblFinalSize.Caption = sFinalSize & ” Kb”
MsgBox “La conversion se ha realizado con éxito de ” & sOriginalSize & ” Kb a ” & sFinalSize & ” Kb. ” _
& “El tamaño del fichero se ha reducido a un ” & Round(FinalSize * 100 / OriginalSize, 2) & ” %”, , “Información de conversion”
Exit Sub

Error:
MsgBox Err.Description
MousePointer = vbNormal
End Sub
Private Sub Form_Load()
convertido = False
End Sub
Private Sub hshQual_Scroll()
txtQual.Text = Str(hshQual.Value)
End Sub

[/c]

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é.

(No Ratings Yet)

 Loading ...