Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: Fran1946 en 8 Mayo 2015, 19:37 pm



Título: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 8 Mayo 2015, 19:37 pm
Hola a todos:

Os explico mi necesidad, y de paso esto os puede servir a muchos para diminuir mucho el peso de imágenes JPG hechas con cámaras digitales o móviles.

Por casualidad descubrí que abriendo una imagen JPG en msPaint de Windows XP, y sin hacer nada con ella, salvarla con Ctr+g o en el Menú...Archivo...Guardar, lógicamente con el mismo nombre, ahora esa imagen pesará entre el 30 al 85 % menos, un ejemplo real con una de mis imágenes hecha con una cámara Cannon EOS 600D:
Imagen original  pesa 8.89 Mb, la misma cargada en msPaint y salvada pesa 1.44 Mb, o sea 83,80 % menos.
Comparadas en el visor de imágenes de Windows, son exactamente iguales no hay perdida de resolución, no eres capaz de distinguirlas, y con Zoom en Photosop son exactamente iguales y la ficha EXIF también.

Si alguien lo duda que haga la prueba, y si alguien sabe por que ocurre esto que me lo explique.

Entonces he hecho una aplicación, donde hago un Drag & Drop de una carpeta donde haya imagenes JPG, o de varios archivos seleccionados de una carpeta, y solo los que sean JPG se cargan sus rutas completas en un ListBox, luego al pulsar un botón, se genera una carpeta donde se copian todos los JPG's originales de la lista.
Y a continuación se cargaran uno a uno en Paint, y se salvan mandando con SendKeys las pulsaciones Ctr+g, por que no he podido conseguir como mandarle el comando 'Guardar' a Paint desde vb6, si alguien sabe como hacerlo por favor explicármelo.

Pero necesito hacer esa misma aplicación para Windows 7, y el msPaint de Win7, utilizando el mismo 'truco' que el de XP, no reduce nada el peso, pero ejecutando una copia del msPaint de Win XP desde Win7, si funciona y lo hace igual que lo que he mencionado.

Entonces la idea es, tengo una copia de msPaint de Win XP, que se llama 'SDpaint.exe'   

Y la aplicación al ejecutarse, abre 'SDpaint.exe' con Shell:
 
Y lo que necesito, es que una vez 'SDpaint.exe' esta abierto, sin ninguna imagen, desde mi aplicación cargar una serie de imágenes.jpg una a una desde la lista de un ListBox (que tiene la ruta completa de la imagen), pero en el 'SDpaint.exe' abierto al principio, no me sirve cerrar 'SDpaint.exe' y cargar una imagen en un nuevo 'SDpaint.exe', cerrarlo y cargar la siguiente abriendo otro.

He probado capturando primero el hWnd del 'SDpaint.exe' abierto, en la variable LhWnd , para utilizarlo con ShellExecute así:
L = ShellExecute(LhWnd, "Open", ListFiles.List(i), "", "", 0)
Pero ejecuta el visor de imágenes de Windows, no carga la imagen en el Paint abierto, y creo que esto se debe poder hacer, no encuentro nada en Internet.

Agradecería cualquier ayuda, perdonad el tocho.

Un saludo.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: luis_74 en 10 Mayo 2015, 01:14 am


prueba ejecutando el programa y pasandole la ruta del archivo:

Código:

"c:\sdpaint.exe c:\imagen.jpg"



Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 11 Mayo 2015, 19:58 pm
Gracias por tu interés, pero creo que no entiendo tu respuesta:

"c:\sdpaint.exe c:\imagen.jpg"
Eso no es código ejecutable, y si te refieres a:

Call Shell("c:\sdpaint.exe c:\imagen.jpg",1) eso tampoco es ejecutable.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: luis_74 en 12 Mayo 2015, 05:04 am
Gracias por tu interés, pero creo que no entiendo tu respuesta:

"c:\sdpaint.exe c:\imagen.jpg"
Eso no es código ejecutable, y si te refieres a:

Call Shell("c:\sdpaint.exe c:\imagen.jpg",1) eso tampoco es ejecutable.


sí ya veo que no anda, bueno cambialo a esto:

Código:

ShellExecute 0, "open", "c:\windows\system32\mspaint.exe", "c:\imagen.jpg", "", 1



cambiando las rutas del progrmas y la imagen  ya tienes abierta la imagen en el paint.

lo acabo de probar y si funciona.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 12 Mayo 2015, 13:09 pm
ShellExecute 0, "open", "c:\windows\system32\mspaint.exe", "c:\imagen.jpg", "", 1

Claro, si llamas al msPaint y la imagen esta en C:\ si funciona, pero si la imagen esta en, por ejemplo, "T:\A\Nueva carpeta\imagen.jpg", entonces no funciona.

Pero creo que no has entendido mi pregunta:

Yo no tengo problema para abrir las imágenes en cualquier ruta y HD, con una copia de 'mspaint.exe', renombrada por mi como 'SDPaint.exe' ubicada en otra ruta diferente a "c:\windows\system32".

En Win XP, mi aplicación funciona 100%, utilizando "c:\windows\system32\mspaint.exe" , donde no funciona es en Win7, por que el mspaint de Win7 es diferente al de Win XP, digamos que es menos básico y tiene mas herramientas, pero al salvar las imágenes no las reduce de peso nada, que es el objetivo de mi aplicación.

Ya he conseguido también ajecutar 'SDPaint' al principio sin ninguna imagen, y luego cargar una a una todas la imágenes con sus rutas completas de la lista de un ListBox, lo único que no he conseguido es mandarle el comando Ctr+g, que es lo que salva la imagen cargada en 'SDPaint', por que haciendolo con:
SendKeys "^{g}", 3
No funciona, y creo que la única forma es hacerlo con SendMessage o con PostMessage, pero hay me pierdo.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: okik en 12 Mayo 2015, 17:08 pm
Hola  :D

En un Form crea un Botón (CommandButton)


Mete esto en un Módulo:

Código
  1. Option Explicit
  2. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  3. (ByVal lpClassName As String, _
  4. ByVal lpWindowName As String) As Long
  5.  
  6. 'Funcición API para enviar un mensaje a MSPaint
  7. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  8. (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  9. Const SC_CLOSE = &HF060&
  10. Const WM_COMMAND = &H111
  11. Const WM_SYSCOMMAND = &H112
  12.  
  13. 'Función API para obtener el nombre de un archivo a partir de un directorio
  14. Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" _
  15. (ByVal lpszFile As String, _
  16. ByVal lpszTitle As String, _
  17. ByVal cbBuf As Integer) As Integer
  18.  
  19. 'Función para deternimnar si un proceso es una ventana
  20. Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
  21. 'Función para obtener el nombre corto de un directorio
  22. Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _
  23. (ByVal lpszLongPath As String, _
  24. ByVal lpszShortPath As String, _
  25. ByVal cchBuffer As Long) As Long
  26.  
  27.  
  28. Public Const MS_SAVE = 0
  29. Public Const MS_SAVE_AS = 1
  30. Dim hwMsPaint As Long 'para el Handle de MsPaint
  31.  
  32. Public Function GetDirCorto(strPath) As String
  33. Dim ShortName As String * 255
  34. Call GetShortPathName(strPath, ShortName, 255)
  35. GetDirCorto = Left$(ShortName, InStr(1, ShortName, Chr$(0)) - 1)
  36. End Function
  37.  
  38.  
  39. 'Inicia MsPaint en modo oculto
  40. Public Function StartMSPaint(ByVal PathMsPaint As String, ByVal strPathFile As String, ByVal Modo As Integer)
  41.    On Error GoTo Error_sub
  42.    Dim Count As Long
  43.    Dim objStartup      As Object
  44.    Dim objWMIService   As Object
  45.    Dim objConfig       As Object
  46.    Dim objProcess      As Object
  47.    Dim Error           As Integer
  48.    Dim strComputer     As String
  49.    Dim intProcessID    As Long
  50.    Dim Opcion          As Integer
  51.    Dim sFile           As String
  52.    Dim sDir            As String
  53.  
  54.    strComputer = "."
  55.    hwMsPaint = 0
  56.    Set objWMIService = GetObject("winmgmts:" _
  57.    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  58.    Set objStartup = objWMIService.Get("Win32_ProcessStartup")
  59.    Set objConfig = objStartup.SpawnInstance_
  60.    objConfig.ShowWindow = 12 'Iniciar en modo oculto (usar 1 para modo visible)
  61.    Set objProcess = GetObject("winmgmts:root\cimv2:Win32_Process")
  62.  
  63.    sDir = GetDirCorto(strPathFile) 'Obtiene el directorio corto Ej.: "[Drive]:\Name~1.jpg"
  64.        'Si el archivo no existe...
  65.        If sDir = "" Then
  66.            MsgBox "No se encuentra " & strPathFile, vbCritical
  67.            Exit Function
  68.        End If
  69.  
  70.    Error = objProcess.Create(PathMsPaint & " " & sDir, Null, objConfig, intProcessID)
  71.        If Error Then
  72.            MsgBox "No se encuentra " & PathMsPaint & "." & vbCrLf & vbCrLf & _
  73.            "Compruebe que la aplicación existe o está correctamente escrito.", _
  74. vbCritical, "Error"
  75.            Exit Function
  76.        End If
  77.  
  78.    'On Local Error Resume Next
  79.    'Elimina las variables de objeto
  80.    Set objStartup = Nothing
  81.    Set objWMIService = Nothing
  82.    Set objConfig = Nothing
  83.    Set objProcess = Nothing
  84.  
  85.    'Obtiene el título del archivo a guardar
  86.    sFile = gFileTitle(strPathFile)
  87.  
  88.    'Obtiene el handle de MSPaint que ha abierto el archivo
  89.    Do While hwMsPaint = 0
  90.        Count = Count + 1
  91.        hwMsPaint = FindWindow("MSPaintApp", sFile & " - Paint")
  92.        DoEvents
  93.        If Count > 50000 Then Exit Function
  94.    Loop
  95.  
  96.    'No pasa hasta el siguiente comando hasta que MsPaint se haya abierto
  97.    Dim n&
  98.    Do While n& = 1
  99.        n& = IsWindow(hwMsPaint)
  100.        DoEvents
  101.    Loop
  102.  
  103.    'Envia el mensaje Guardar o Guardar como a MsPaint
  104.    Call MsPaintSave(Modo)
  105.  
  106.    Do While n& = 0
  107.    n& = IsWindow(hwMsPaint)
  108.    CloseMsPaint
  109.    DoEvents
  110.    Loop
  111.  
  112.    Exit Function
  113.  
  114. Error_sub:
  115.    MsgBox Err.Description, vbCritical
  116.  
  117.    On Local Error Resume Next
  118.    'Elimina las variables de objeto
  119.  
  120.    Set objStartup = Nothing
  121.    Set objWMIService = Nothing
  122.    Set objConfig = Nothing
  123.    Set objProcess = Nothing
  124. End Function
  125.  
  126. Private Sub MsPaintSave(ByVal Modo As Integer)
  127. Select Case Modo
  128. Dim X&
  129. Case 0
  130. X& = SendMessage(hwMsPaint, WM_COMMAND, 57603, &H0) 'Guardar
  131. Case 1
  132. X& = SendMessage(hwMsPaint, WM_COMMAND, 57604, &H0) 'Guardar como...
  133. End Select
  134.  
  135. End Sub
  136.  
  137. 'Cierra MsPaint
  138. Public Function CloseMsPaint()
  139. 'Envía el mensaje de Cerrar a MSPaint
  140. SendMessage hwMsPaint, WM_SYSCOMMAND, SC_CLOSE, &H0
  141. End Function
  142.  
  143. 'Obtiene el nombre del archivo Ej.: E:\Paisaje.jpg" ->obtiene "Paisaje.jpg"
  144. Private Function gFileTitle(ByVal strPathFile As String) As String
  145. Dim strFileTitle As String
  146. strFileTitle = Space(100)
  147. GetFileTitle strPathFile, strFileTitle, 100
  148. gFileTitle = Left$(strFileTitle, InStr(1, strFileTitle, Chr$(0)) - 1)
  149. End Function
  150.  
  151.  



Mete esto en un Form:

Código
  1.  
  2. Private Sub Command1_Click()
  3. Dim strFile As String
  4. strFile = App.Path & "\Dock.jpg"
  5.  
  6. 'MS_SAVE = Guardar (No aparecerá cuadro de diálogo)
  7. 'MS_SAVE_AS = Guardar como ...
  8. Call StartMSPaint("mspaint.exe", strFile, MS_SAVE): CloseMsPaint
  9.  
  10. End Sub
  11.  
  12. Private Sub Form_Load()
  13. Show
  14. 'Centrar formulario
  15. Me.Move (Screen.Width / 2) - (Me.Width / 2), (Screen.Height / 2) - (Me.Height / 2)
  16. Command1.Caption = "Guardar con MsPaint"
  17. End Sub
  18.  
  19.  


Lo que hace...
1. Abre MSPaint en modo oculto (se ejecuta pero no se ve) con la imagen que quieras convertir. Mejor dicho, volver a guardar pero con MSPaint.

2.  Envía un mensaje a MSPaint mediante SendMessage. Que viene a ser el equivalente a pulsar "Guardar" o "Guardar como" del menú. (A elección)

3. Cierra MSPaint.

Download code:
https://mega.co.nz/#!WEllUYYB!JpyYKyzME3pBQc_Q9oZkoa4fnRGuapVAA19fM0Z98oQ (https://mega.co.nz/#!WEllUYYB!JpyYKyzME3pBQc_Q9oZkoa4fnRGuapVAA19fM0Z98oQ)


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 13 Mayo 2015, 19:27 pm
Hola okik:

Te agradezco mucho tu respuesta, y además con un código completo de programa.

Lo he probado y funciona perfectamente, pero no me soluciona el problema te explico:

Este programa llama al mspaint de windows, en su ruta original de 'System32', por lo tanto si yo ejecuto este programa en Win 7, ejecutara y cargará los archivos JPG en el maspaint de win 7, y este al salvar no disminuye nada el peso de los archivos JPG, que es el objeto de la aplicación.

Y el código que yo tengo en mi aplicación, ejecuta una copia de mspaint.exe de Win XP, que yo he renombrado como 'SDPaint.exe' que estaría en la ruta donde este el ejecutable de mi aplicación.
Por lo tanto si se ejecuta en Win 7, utiliza 'SDPaint.exe' , o sea la copia renombrada de mspaint de win XP, y no el mspaint de Win 7, y entonces si disminuye el peso de los archivos JPG.

Pero además he modificado la copia 'SDPaint.exe' con el editor hexadecimal WinHex, de forma que donde figura como 'MSPaintApp' ahora es 'SDPaintApp'.

Entonces en esta parte de tu código:

 
Código:
'Obtiene el handle de MSPaint que ha abierto el archivo
    Do While hwMsPaint = 0
        Count = Count + 1
        hwMsPaint = FindWindow("MSPaintApp", sFile & " - Paint")
        DoEvents
        If Count > 50000 Then Exit Function
    Loop
  Entonces esta linea:
Código:
hwMsPaint = FindWindow("MSPaintApp", sFile & " - Paint") 

debería ser:
Código:
hwMsPaint = FindWindow("SDPaintApp", sFile & " - Paint")

Pero no comprendo como trabaja esta parte de código que supongo carga mspaint:
Código:
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set objStartup = objWMIService.Get("Win32_ProcessStartup")
    Set objConfig = objStartup.SpawnInstance_
    objConfig.ShowWindow = 12 'Iniciar en modo oculto (usar 1 para modo visible)
    Set objProcess = GetObject("winmgmts:root\cimv2:Win32_Process")
 
    sDir = GetDirCorto(strPathFile) 'Obtiene el directorio corto Ej.: "[Drive]:\Name~1.jpg"

Y no se si se puede modificar para que cargue 'SDPaint.exe' , o sea la copia renombrada de mspaint de win XP.

Si esto fuera posible, entonces si me valdría.

Pero lo que si ha sido definitivo para que el código de mi proyecto, que si utiliza 'SDPaint.exe' , o sea la copia renombrada de mspaint de win XP, pueda salvar sin utilizar SendKeys, es esta linea de tu código:

Código:
X& = SendMessage(hwMsPaint, WM_COMMAND, 57603, &H0) 'Guardar

Y por favor me puedes decir donde has conseguido saber que el parámetro 57603 es 'Guardar' y el 57604 es 'Guardar como', por que esto lo he buscado durante días en Internet y no he conseguido nada, y tengo un listado completo de constantes para SendMessage, y estos 2 parámetros no aparecen, este es el link:

http://www.vbcode.com/asp/showsn.asp?theID=11797

No se si me puedes responder a estas dudas, pero te doy las gracias de todas formas por tu ayuda.

Un saludo.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: okik en 13 Mayo 2015, 20:06 pm
Hola #Fran1946#

Me alegro que te haya funcionado correctamente. El cambio puede venir bien para otros usuarios que usen W7 y buen detalle lo de incluir el nombre de clase, que lógicamente cambia. Si quieres, además, si quieres usar otra versión que no se encuentre en el directorio del sistema, puedes poner el directorio:

Call StartMSPaint("C:\Directorio\mspaint.exe", strFile, MS_SAVE)


En cuanto al código  57603-'Guardar' y el 57604- 'Guardar como', hay  varias formas de obtenerlo. Una es extrayendo el menú mediante código o bien usando Spy++, pero es difícil de explicar.

Mediante código, puedes usar este, de prueba. Ejecuta SDPaint y con el paint abierto ejecuta este código.


Código
  1. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  2. (ByVal lpClassName As String, _
  3. ByVal lpWindowName As String) As Long
  4. Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" _
  5. (ByVal hMenu As Long, _
  6. ByVal wIDItem As Long, _
  7. ByVal lpString As String, _
  8. ByVal nMaxCount As Long, _
  9. ByVal wFlag As Long) As Long
  10.  
  11. Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
  12. Private Declare Function GetMenuItemID Lib "user32" _
  13. (ByVal hMenu As Long, ByVal nPos As Long) As Long
  14. Private Declare Function GetSubMenu Lib "user32" _
  15. (ByVal hMenu As Long, ByVal nPos As Long) As Long
  16. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  17. (ByVal hwnd As Long, _
  18. ByVal wMsg As Long, _
  19. ByVal wParam As Long, _
  20. lParam As Any) As Long
  21. Const MF_BYPOSITION = &H400&
  22. Const WM_COMMAND = &H111
  23. Const MF_POPUP = &H10&
  24.  
  25.  
  26.  
  27. Private Sub Command1_Click()
  28.    Dim hwnd As Long
  29.    Dim hMainMenu As Long
  30.    Dim hMenu As Long
  31.    Dim MenuID As Long
  32.    Dim szbuf As String * 128
  33.    Dim szBufM As String * 128
  34.    Dim I, Z
  35.    Z = 0 'Posición del menú
  36.    I = 2 'Posición del submenú
  37.    hwnd = FindWindow("SDPaintApp", vbNullString)
  38.    If hwnd = 0 Then Exit Sub
  39.    hMainMenu = GetMenu(hwnd)
  40.    hMenu = GetSubMenu(hMainMenu, Z)
  41.    MenuID = GetMenuItemID(hMenu, I)
  42.    Call GetMenuString(hMenu, MenuID, szbuf, 128, MF_BYPOSITION & MF_POPUP)
  43.  
  44.    MsgBox MenuID & "     " & szbuf
  45.  
  46.    'X& = SendMessage(hwnd, WM_COMMAND, MenuID, 0&)
  47.  
  48. End Sub


el valor Z representa el lugar del menú e I el lugar del submenú.

Puedes crear un bucle For/Next y repasar números del -1 al  1000 para I y de esa manera obtener todos los comandos.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 14 Mayo 2015, 03:01 am
Hola de nuevo okik:

Me encanta este código, lo he probado y me ha dado todos los wParam de los menues de Paint, solo he hecho un For-Next de 30 y me han sobrado.
Esto me va a servir de mucha ayuda para muchas cosas.

Sobre esto:
Código:
Call StartMSPaint("C:\Directorio\mspaint.exe", strFile, MS_SAVE)

Así ya lo utilizaba en tu código, pero la desventaja es que cada archivo del ListBox que mando, carga un nuevo 'SDPaint', y eso lo quería evitar, quiero cargar solo en el primer archivo 'SDPaint' y luego mandarle los siguientes al mismo 'SDPaint' sin cerrar lo, pero en tu código no se si esto es posible, al menos yo no se donde hay que modificarlo.

El código para hacer esto, que me lo dado un usuario del foro de canalvisualbasic.net  que precisamente publico este post:

http://www.canalvisualbasic.net/foro/visual-basic-6-0/aporte-arrastrar-ficheros-sobre-una-ventana-21333/#post66767

Y con este código si se hace lo que quiero, pero no se podía salvar con SendKeys, por que lo que hace es Drag&Drop de los archivos a  un solo 'SDPaint' abierto, pero en memoria RAM.
Este código a mi me ha sorprendido, por que abarca todas las posibilidades, aunque yo solo utilizo una y ademas siempre consigue el hwnd de 'SDPaint', por que con:
Código:
 hwnd = FindWindow("SDPaintApp", vbNullString)

Falla mucho, y no siempre consigue el hwnd a la primera.

Y gracias a ti y a el, tengo lo necesario para lo que necesito.

 Por cierto la imagen que adjuntas en el proyecto 'Dock.jpg' que pesa 309 Kb, con  'SDPaint', la reduce a 72.4 Kb un 76.6 % menos, aseguro que son exactamente iguales en resolución y calidad, pero no solo con JPG's de 72 ppp hace lo mismo con JPG's de 300 ppp, no me explico como Paint de XP consigue esto, que no se consigue con ningún otro programa, Photoshop hace justo lo contrario, aumenta el peso.

Te reitero una vez mas las gracias por tu ayuda.

Y si a ti o a alguien le interesa tener esta aplicación que lo diga en este post y yo publico o el link para descargar el ejecutable (60 Kb), o el código del proyecto.

Voy a hacer un vídeo para que se vea como utilizarlo, y lo subo aquí.

Un saludo.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: okik en 15 Mayo 2015, 12:02 pm
Quizás te interese este código. No es mío, es de un tal John Korejwa.  Puedes crear o convertir archivos JPG con diferentes niveles de compresión sin perder calidad. Es muy bueno, lo malo es que el como lo hace es muy complejo y resulta dificil de descifrar para luego modifiarlo y usarlo a tu manera. Utiliza módulos de clase y funciones GDI.


http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=50065&lngWId=1 (http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=50065&lngWId=1)

Enlace de descarga:
http://www.planet-source-code.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=50065&strZipAccessCode=tp%2FJ500653091 (http://www.planet-source-code.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=50065&strZipAccessCode=tp%2FJ500653091)





Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 16 Mayo 2015, 02:44 am
Lo he visto por encima, y efectivamente es un código muy complicado, pero siempre es bueno tener códigos como este para poder utilizarlo en una aplicación, sin tener que utilizar OCX para exportar a JPG.
Lo voy a mirar con mas detalle a ver si me vale para salvar un PictureBox de una aplicación que tengo, que grafica varios planos mecánicos por código.

Pero lo he ejecutado cargando un BMP y salvado a JPG con calidad 100% y 1:1, y luego el mismo BMP cargado con Paint de XP, y salvado a JPG y tiene 60% menos de peso que el salvado con este código.
Me gustaría saber que algoritmo de compresión JPG tiene Paint, que salva los JPG con el peso mas bajo posible, me parece increíble, por que el formato JPG no lo desarrolló Microsoft, y no entiendo como mejora la compresión en un porcentaje enorme respecto al original. 


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 18 Mayo 2015, 20:03 pm
Hola a todos:

Ya termine la aplicación, y funciona muy bien, gracias a la ayuda de okik y a la de otro usuario de otro foro.

Para quien quiera ver como funciona, este es el link del vídeo que he hecho:

https://www.youtube.com/watch?v=kr35DvIztYU

Solo me queda una pregunta para okik:

Si has visto el vídeo, veras que después de haber salvado los archivos, tiene una opción de ver y comparar el original y el convertido en el visor de imágenes y fax de windows.
Pues yo quería que al visualizar las imágenes en el visor de Win, a continuación del nombre del archivo, se viera ' - Original' o ' - Convertido', en lugar de:
 - Visor de imágenes y fax de Windows
Y esto ya lo tenía conseguido y cambiaba el Caption del visor de Win poniendo una interrupción después de la linea del código que manda el mensaje, pero si quito la interrupción, lo manda y se ve un instante, pero a continuación vuelve a verse ' - Visor de imágenes y fax de Windows'  

No se si esto se puede evitar, y conseguir que se vea, por ejemplo
En lugar de:
Imagen 1 - Visor de imágenes y fax de Windows
Se vea:    
'Imagen 1 - Convertido', o 'Imagen 1 - Original'

Gracias y un saludo.





Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: okik en 19 Mayo 2015, 19:19 pm
Buen trabajo  ;-). Felicidades por le programa y la idea.

En cuanto a lo de cambiar el nombre yo siempre he usado la función API  SetWindowText.

Código
  1. Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Tan sólo necesitas obtener el Handle de la ventana, en este caso del visor de imágenes de Windows. El Handle, como ya sabes puedes obtenerlo con FindWindow y necesitas el nombre de clase de la ventana que es "Photo_Lightweight_Viewer" y "ShlmgVw:CPreviewWnd" en XP, o bien el mismo título de la ventana.

Luego el código podría ser:

Código
  1. Dim hwndViewer As Long
  2. Do While hwndViewer = 0
  3. hwndViewer = FindWindow("Photo_Lightweight_Viewer", vbNullString)
  4. DoEvents
  5. Loop
  6. Call SetWindowText(hwndViewer, "Imagen 1 - Convertido")

*Recuerdo que si se sustituye "vbNullString" por el título de la ventana sólo se obtendrá el handle de una ventana que contenga dicho título.

Saludos


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 20 Mayo 2015, 01:28 am
Gracias okik:

Código
  1. Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Si así lo he echo yo con 'SetWindowTextA'

Tan sólo necesitas obtener el Handle de la ventana, en este caso del visor de imágenes de Windows. El Handle, como ya sabes puedes obtenerlo con
FindWindow y necesitas el nombre de clase de la ventana que es "Photo_Lightweight_Viewer" y "ShlmgVw:CPreviewWnd" en XP, o bien el mismo título de la ventana.

Luego el código podría ser:

Código
  1. Dim hwndViewer As Long
  2. Do While hwndViewer = 0
  3. hwndViewer = FindWindow("Photo_Lightweight_Viewer", vbNullString)
  4. DoEvents
  5. Loop
  6. Call SetWindowText(hwndViewer, "Imagen 1 - Convertido")

Esto no funciona, no obtiene el handle, siempre  = 0, ya te dije que esta función falla mucho.

Pero yo si consigo el handle siempre, con un módulo de clase que tengo se llama 'clsEnum.cls'

Y me funciona y cambia el captión, como he comentado, pero solo desde VB6, poniendo una interrupción, pero si la quito, entonces la cambia un instante y vuelva a ponerse:  ' - Visor de imágenes y fax de Windows' 

Subo 2 capturas para que lo veas:

(http://s4.postimg.org/mbzhiyj59/Interrup_1.jpg) (http://postimg.org/image/mbzhiyj55/full/)
imagen (http://postimage.org/index.php?lang=spanish)

(http://s10.postimg.org/aevb4rf6h/Interrup_2.jpg) (http://postimg.org/image/huukqk2vp/full/)
subir fotos a internet (http://postimage.org/index.php?lang=spanish)

Un saludo.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: pkj en 21 Mayo 2015, 10:16 am
Veo 2 problemas:
1, si el visor vuelve a cambiar el titulo debe ser que tiene alguna especie de timer que lo actualiza, porque con otros programas parece ser un cambio mas permanente.
2, tu tienes asociado el visor de imagenes de windows a las fotos, pero mucha gente asocia un visor diferente y tu programa no les va a servir. A mi de hecho me aparece el visor de windows como "visualizador de fotos de windows", pero ademas las imagenes las tengo asociadas a ACDSee.

La solucion mas simple es que, justo despues de guardar la imagen con sdpaint la renombres. Asi el propio visor te muestra si es procesada o no.
Hacer un "Guardar como..." no te interesa porque tendrias que ir dandole nombres durante todo el proceso, pero justo despues del sendmessage con ctrl+G puedes poner algo como:
Código
  1. Name ListFiles.List(i) As Left(ListFiles.List(i), Len(ListFiles.List(i)) - 4) & "_Procesado.jpg"
  2.  

como luego borras la lista no hace falta, pero si no la borras puedes actualizar el nuevo nombre:
Código
  1. ListFiles.List(i) = Left(ListFiles.List(i), Len(ListFiles.List(i)) - 4) & "_Procesado.jpg"
  2.  

Tambien puedes guardar las originales con el "_Original" al final al copiarlas o renombrandolas despues.
Incluso te puede interesar hacer esto ultimo mejor que otra cosa, ya que solo renombras las originales, y las nuevas que son las que se supone que te interesan mantienen su nombre original.

Que se de bien.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 22 Mayo 2015, 14:48 pm
Hola okik:

Buena sugerencia, esto ya lo había pensado para otros, no para mí que ya lo he comprobado con mas de 2000 fotos pasando de 2.34 Gb a 1.4 Gb

de espacio, ya que después de comprobar que son iguales lo normal es borrar la carpeta 'BackPaint' donde están lo originales, por que el

programa si no puede salvar 'convertir' un archivo lo deja como original, y lo apunta en el archivo 'Informe convertidos.txt' como  0.0% menos.

Esto es el contenido de ''Informe convertidos.txt' de la conversión se solo 2 fotos:

Fecha: 18/05/2015    Hora: 19:00:16
 
1 - T:\DATOS\Camara\Cumple Susi y Germán 2015\_MG_2237.JPG -  (Antes) 5597,5 Kb / (Despues) 822,5 Kb - 85,3 % menos
2 - T:\DATOS\Camara\Cumple Susi y Germán 2015\_MG_2239.JPG -  (Antes) 9107,1 Kb / (Despues) 1475,4 Kb - 83,8 % menos
 
2 Archivos originales copiados en: T:\DATOS\Camara\Cumple Susi y Germán 2015\BackPaint\, Total: 14.704,6 Kb
 
-------------------------------------------------------------------------------------------------
 
2 Archivos convertidos en: T:\DATOS\Camara\Cumple Susi y Germán 2015\, Total: 2.297,9 Kb
Total: 12.406,7 Kb menos, promedio de ahorro total: 84,4 % menos
-------------------------------------------------------------------------------------------------
Pero lo ideal sería poder cargar el original y el convertido, sin cambiar el Caption del visor, ya que el programa indica cual estas viendo, pero de la forma como carga los archivos de 'SDPaint' en el mismo visor, no abriendo otro nuevo, por que de esta forma no hay un parpadeo entre una imagen y la otra como ocurre ahora, y eso destruye el poder ver la misma imagen antes y después, sin parpadeo, o sea como se ve si hubiera en la misma carpeta, por ejemplo, 2 imágenes:
Imagen_1 e Imagen_1A, y selecciones en el explorer las 2 y con botón derecho en una de ellas eliges en el menú emergente 'Vista previa' y entonces con cualquier tecla de flecha del teclado, pasas de una otra sin parpadeo y entonces si ves claramente que no distingues cual es cual.
Y eso no se si se puede conseguir utilizando el código del usuario del otro foro, por que he probado teniendo una imagen cargada en el visor de Win y arrastro otra desde el Explorer, y la carga pero con parpadeo.

Dime si conoces algún visor gratuito, muy simple, para poder probar con el código que utilizo con 'SDPaint'.

Gracias de nuevo por tu interés.

Si quieres, tu u otras personas, descarga el programa aquí, y lo pruebas:

https://dl.dropboxusercontent.com/u/51073224/FOTOS%20JPG.rar

Un saludo.



Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: pkj en 22 Mayo 2015, 19:32 pm
Puedes intentar crear tu propio visor dentro del proyecto.
Asi cargas las imagenes p.ej en 2 picturebox diferenes y despues ocultas o muestras el que quieres, con los mensajes y descripciones que quieras.
No creo que sea muy complicado si no tienes que manipular la imagen.

Saludos


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 22 Mayo 2015, 22:09 pm
Gracias pkj:

Si es buena idea, había hecho un visor con 2 PictureBox, uno al lado del otro, y que el de la izquierda, al mover la imagen con el mouse, el otro movía la suya de la misma forma, pero el movimiento es lento.

Pero voy a probar tu idea, pero con imágenes muy grandes como las de mi cámara de 5184x3456, no se ve entera en un monitor de 20-22", con autosize=true, y si no la imagen solo ves una parte superior arriba.

Pero voy a probar con un control Image, con Stretch=true, a ver si la carga es rápida.

Un saludo.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 23 Mayo 2015, 19:23 pm
Bueno, pues ya está terminado el programa, funciona muy bien.

Si queréis ver la última versión con visor propio, y funciones que facilitan poder comparar los originales con los convertidos, de forma muy cómoda y fácil.

Este es el link del vídeo nuevo:

https://www.youtube.com/watch?v=BkmX5sx_bGw

Y este es el link de descarga del programa, para quien lo necesite, solo hay que descomprimir el rar en C;\, no tiene instalación:

https://dl.dropboxusercontent.com/u/51073224/FOTOS%20JPG.rar

Un saludo, y gracias a todos por vuestra ayuda.



Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: pkj en 24 Mayo 2015, 10:51 am
Felicidades  ;-)
Parece que al final has logrado tu objetivo.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 26 Mayo 2015, 14:28 pm
Hola a todos:

SI, pero gracias a vuestra ayuda.

Gracias y un saludo.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: okik en 26 Mayo 2015, 15:14 pm


Me alegro que te hayas acabado el programa con éxito. Pero permíteme un apunte por si lees este comentario.

Respecto a "FindWindow" dices que: " Esto no funciona, no obtiene el handle, siempre  = 0, ya te dije que esta función falla mucho.
"

No falla, y si lo hace es por tres razones. La primera es que se trate de buscar el handle de la ventana antes que se haya abierto del todo. Es decir algunas ventanas tardan en cargarse y hay que esperar a que se cargen del todo, porque si no da 0. Esta es la razón que en el ejemplo lo pusiera dentro de un Do/Loop de este modo no falla porque el bucle no para de buscar la ventana hasta sea un valor distinto de 0. La segunda razón es que el nombre de clase utilizado sea incorrecto. Comprueba cual es en Windows 7, ya que yo no uso Windows 7 y puede que el que te dí no fuera el corrrecto. También al poner FindWindow ( "Nombredeclase", "TítuloVentana")  o bién FindWindow (vbnullstring, "TítuloVentana"),  el título de la ventana no sea el correcto. La tercera razón sería  que la ventana no esté abierta.





Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 28 Mayo 2015, 02:19 am
Hola okik:

Si tienes razón, si esta dentro de un bucle Do/Loop, con un contador hasta 50000, como en tu ejemplo de código, si lo lee, pero yo utilizo el código de 'Arratrarventana', que me dio el otro usuario de otro foro que mencioné, y ese siempre lo consigue por que lo busca así:
Si hay titulo se intenta con el y FindWindow
Si no hay titulo tiene que haber exe
Si no se encuentra se intenta ejecutar
Y de esta forma siempre lo consigue, luego hace el proceso de Drag&Drop en memoria, esto es fundamental para mí, por que carga todos los JPG en el mismo SDPaint abierto con el primer JPG, y se ahorra tener que repetir el proceso de abrir SDPaint y leer el hWnd y esperar 2 segundos en cada archivo.

Mañana lo probaré en Win 7 x32 y x64, pero creo que funcionará bien, y con este código no necesito la clase del Paint de Win 7, por que con ese Paint no disminuye nada el peso, lo deja como está, por eso tengo que utilizar el Paint de XP.

Para XP, no necesitaría un Paint modificado con un editor hexadecimal, pero tengo amigos que les pasaré la aplicación, que tienen Win 7, S.O. que odio profundamente.

Ten en cuenta que yo he convertido carpetas enteras donde había 100 o 200 JPG's.

Un saludo.  


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: okik en 29 Mayo 2015, 17:58 pm
Bueno, cambiando de tema y centrándome en lo de convertir múltiples imagenes yo uso Xnview.

http://www.xnview.com/en/ (http://www.xnview.com/en/)

Versión Standard (All languages)
http://download.xnview.com/XnView-win.zip (http://download.xnview.com/XnView-win.zip)

Verisón extendida (All languages)
http://download3.xnview.com/XnView-win-full.zip (http://download3.xnview.com/XnView-win-full.zip)

(el idioma se cambia en menú -> Tools/Options/Interface)

Es gratis y fácil de usar. Verás un listado de de precios... pero fíjate en el mensaje "If you intend to use XnView in a company, you must purchase a license.", es decir que si es para uso empresarial hay que pagar, pero para uso privado es gratis.

 Tiene su propio explorador, seleccionas las imágenes y del menú emergente seleccionas "Conversión por lotes". Una vez ahí, le das al botón opciones y eliges el método de compresión. Pero no olvides elegir el directorio donde irán las imágenes de lo contrario modificará las originales, de todos modos un mensaje te avisa de ello y puedes cancelar.  

Además puedes, también por lotes, cambiar; tamaño, brillo, contraste, efectos, etc. Soporta también algunos plugins de photoshop. En fin es completísimo, tiene infinidad de utilidades, es intuitivo y fácil de usar. Además pesa muy poco.

Lo tienes para Windows, MacOS y Linux.

Espero te sirva.

Saludos

 


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: General Dmitry Vergadoski en 29 Mayo 2015, 20:28 pm
Hola a todos:

SI, pero gracias a vuestra ayuda.

Gracias y un saludo.
publica el codigo fuente que es lo que al final interesa, ya que programas para comprimir imagenes hay muchos.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 29 Mayo 2015, 20:34 pm
Hola okik:

Interesante programa, realmente es muy completo, y me puede ser útil para algunas cosas, aunque cuando quiero manipular imágenes utilizo Photoshop que evidentemente es lo más profesional que existe.

Pero para mi propósito que es simplemente conseguir el peso mínimo posible de un archivo JPG, conservando todas las propiedades del original, y me refiero a todas, EXIF, resolución en ppp, perfil de color, tamaño, etc, ninguno de los que he probado lo hacen es mas, hacen lo contrario, incluido este, aumentan el peso del archivo.

He probado con una imagen que el original pesa 1.4 Mb.
Con Xnview, aumenta el peso de 1.4 Mb a 1.94 Mb un 35 % mas.

Mira la captura.

Con mi sistema y Paint, disminuye de 1.4 Mb a 0.376 Mb, un 73,8 % menos.
La diferencia es abismal.

Evidentemente no puedo saber si existe algún programa, de los cientos que hay, que pudiera mejorar el resultado de Paint, pero no creo que exista ese programa.

Lo he repetido en este post varias veces, aunque no creo que nadie excepto Microsoft sepa por que ocurre "este milagro".

Pero muchas gracias otra vez por tu ayuda.

Un saludo.

(http://s21.postimg.org/3ndm9wds7/Cap.jpg) (http://postimage.org/)
sube fotos (http://postimage.org/index.php?lang=spanish)


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: okik en 2 Junio 2015, 19:51 pm
Interesante!!

Bueno, yo he analizado el Paint y utiliza funciones GDI que se obtienen de GDI32.DLL para convertir imágenes. Además, yo si que creo que reduce algo la calidad, porque en la imagen convertida se aprecian píxels (cuadritos) que antes no aparecían.  Prueba a convertir una imagen con un gran cielo azul o algo así e imágenes que no sean de gran calidad, seguro que aprecias alguna imperfección que antes no estaba.

 Te sugiero que si de verdad te interesa saber como lo hace, es que estudies las funciones GDI. Desgraciadamente, no se mucho del tema. Tengo alguna plantilla con ejemplos simples de uso del GDI, pero no para convertir imágenes. Tengo proyectos OCX, pero las funciones GDI se llaman desde módulos de clase que usan variables que están vinculadas a una determinada función, a otro módulo de clase que su vez a un módulo, lo cual resulta complejo de analizar.

A ver si puedes encontrar ejemplos sencillos o algún tutorial en la web, Por mi parte yo haré lo mismo.

 :rolleyes:







Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 3 Junio 2015, 01:39 am
Citar
Prueba a convertir una imagen con un gran cielo azul o algo así e imágenes que no sean de gran calidad, seguro que aprecias alguna imperfección que antes no estaba.

Eso ya lo he hecho, y muchas mas pruebas con todo tipo de imágenes, y analizándolas luego en Photoshop, no hay pérdida perceptible al ojo humano, pero realmente es evidente que hay una pérdida respecto al original, pero el algoritmo de compresión, se basa principalmente en la poca sensibilidad del ojo humano a los cambios de color (crominancia), y a la alta sensibilidad a los cambios de brillo (luminancia) y así consigue comprimir mucho el factor crominancia, que es lo que mas información y peso en bytes consume.

Por que no te descargas el programa y haces pruebas con imágenes tuyas y lo ves por ti mismo.

Las imágenes de poca calidad y poco peso, no merece la pena convertirlas, aunque incluso imágenes que tengo de solo 12-15 Kb también disminuyen en peso un promedio del 15-30 %.

Realmente las funciones GDI, de momento no me interesan, por que el único propósito de esta aplicación es para reducir el tamaño que ocupan en el HD, cuando tienes cientos de imágenes como es mi caso.

Yo aparte de programación por hobby, hago mucho diseño gráfico, con Corel, Photoshop y 3Dmax, y en 3Dmax con muchas texturas el consumo de RAM se dispara, y si ahorras un 80 % en peso, ganas horas a la hora de renderizar.

Un saludo.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Neocortex en 11 Junio 2015, 21:27 pm
Buenas,

Yo recuerdo que para una clase hice un compresor de imagenes siguiendo más o menos la lógica de compresión del jpg, hay distintas compresiones, las que tienen pérdidas y las que no, para la 2da no importa cuantas veces lo guardes, va llegar a un tope y no se va comprimir más, lo que tu visualizaste con el mspaint fue que se "volvió" a comprimir con jpg a saber con que tasa de compresión...

Saludos


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 12 Junio 2015, 01:26 am
Hola:

Citar
Yo recuerdo que para una clase hice un compresor de imagenes siguiendo más o menos la lógica de compresión del jpg, hay distintas compresiones, las que tienen pérdidas y las que no, para la 2da no importa cuantas veces lo guardes, va llegar a un tope y no se va comprimir más,

Todo esto ya lo se desde hace muchos años.

Citar
lo que tu visualizaste con el mspaint fue que se "volvió" a comprimir con jpg a saber con que tasa de compresión...

Pues claro, eso es el propósito para reducir el peso de los archivos y no se ni me importa la tasa de conversión que utiliza msPaint, solo me interesa el resultado que es el que ya he explicado muchas veces (conseguir reducir el peso de los archivos sin perder calidad ni resolución a efectos del ojo humano, incluso con Zoom elevados), pero creo que no has entendido lo que pretendía hacer y que ya lo he conseguido al 100% con la utilidad que he programado, lo he explicado 3 o 4 veces en este post.

Gracias por tu respuesta.

Saludos.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Neocortex en 12 Junio 2015, 18:29 pm
Hola:

Todo esto ya lo se desde hace muchos años.

Pues claro, eso es el propósito para reducir el peso de los archivos y no se ni me importa la tasa de conversión que utiliza msPaint, solo me interesa el resultado que es el que ya he explicado muchas veces (conseguir reducir el peso de los archivos sin perder calidad ni resolución a efectos del ojo humano, incluso con Zoom elevados)

Buenas,

Perdón no alcancé a leer todos los posts porque ando en el trabajo pero entiendo más o menos tu punto, corrígeme si me equivoco:
- Mantener las propiedades de la imagen (EXIF data).
- que la compresión sea humanamente sin pérdidas.
- Que la resolución no cambie.

(http://puu.sh/imchk/3341254bfa.jpg)
^
Esa fue mi primer versión del compresor, así como a ti me interesaba comprimir a gran escala gran cantidad de imágenes que estuvieran pesadas y reducirlas a menos de 1MB. El truco es que yo no utilicé ninguna herramienta externa, si no hice un mappeo de los colores e hice un algoritmo bastante sencillo que es muy parecido a lo que hace .jpg cada que se guarda la imagen, solo que mi algoritmo solo hace la compresión una vez, si se vuelve a guardar ya no comprime más, a menos que se guarde con jpg...
Lo de las propiedades y eso no me puse a indagar mucho en el tema cuando lo hice, pero a ver si esté fin le busco y te resuelvo eso, sirve que mejoro el código que ya tiene sus años...

La última versión que hice maneja drop de carpetas completas.

(http://puu.sh/imcAI/c6a96b841b.jpg)

Saludos y una disculpa si se malinterpretó mi respuesta




Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 13 Junio 2015, 03:19 am
Hola Neocortex:

Efectivamente lo que quiero es como dices, me extrañaba tu respuesta si habías seguido el post, o es que yo no me he explicado bien.

Yo como te comenté, ya tengo el programa funcionando empleando msPaint, pero si me gustaría poder hacerlo sin mspaint.

Veo que consigues, en la primera imagen de tu programa, una tasa de reducción del 89% en una imagen de 1920x1080, y aunque no puedo apreciar bien en tu captura detalles ampliados, parece que a simple vista no pierde calidad apreciable.

Pero no se que resolución en ppp (puntos por pulgada) tiene esa imagen.

Yo tengo cientos de imágenes muy grandes, 5184x3456 de una cámara Cannon EOS 600D 16 Mpix pero es de 72 ppp, que demuestra lo equivocada que esta la mayoría de la gente, que cree que una cámara de 16 Mpix tiene mejor calidad que una de 3.5 Mpix Cannon IXUS V3 de 180 ppp (yo tengo las dos).
Pues no... los Mpix solo significan el tamaño máximo de la imagen, y los ppp son la calidad (resolución) de la imagen.
Por que 72 ppp son 5184 pixels en una pulgada cuadrada, o sea en un cuadrado de 25.4x25.4 mm.
Y 180 ppp son 32400 pixels en la misma pulgada cuadrada, o sea un 160% mas de resolución.

Si no te importa compartir conmigo ese algoritmo, te lo agradecería mucho.

Y de todas formas gracias por tu respuesta, y no tengo nada que disculparte, solo agradecerte la información.

No se si has visto el vídeo que subí a YouTube, si lo quieres ver es este:

https://www.youtube.com/watch?v=BkmX5sx_bGw
 
Saludos.   

 


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Neocortex en 13 Junio 2015, 20:13 pm
es bastante sencillo, lo hice para una materia en la universidad en un domingo en la mañana.

a la imagen en cuestión la recorres en ancho y alto, luego le sacas el valor de los pixeles.

(http://puu.sh/inuAj/2c7d7865c4.png)

Luego a los arreglos generados se les asigna nuevo valor
(http://puu.sh/inuKr/bc4fc76c33.png)

Para no hacerla muy larga, lo que hace es generar un promedio de valores
si el pixel está en (122,152,167) lo convierte a (120,150,170), así reduce la cantidad de colores.

Si gustas pudieras dejarme alguna fotografía de esas magnitudes para ver el tiempo que dura y te paso los resultados.

*EDIT*
Ah... Y a los limites del blanco y negro le di cierto margen mayor para que no se notara tanto.


Saludos!


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 13 Junio 2015, 21:24 pm
Hola Neocortex:

Gracias por tu respuesta una vez más.
Veo que el código está en C++, y yo hace 40 años que no he vuelto a programar en C++, en aquella época no había Visual C, solo C++ de Borland, en puro MSDOS.

Y me resulta bastante difícil traducir este código a VB6, que es el lenguaje que utilizo para las aplicaciones que hago actualmente para mis "apaños" y por hobby.
Si pudieras traducirme el código a VB6 te lo agradecería.

Te pongo el link para que tengas 2 imágenes de las que he convertido, se llaman:
'O_MG_2356.JPG' esta es la original pesa 8071,2 Kb , y 'C_MG_2356.JPG' esta es la convertida y pesa 1235,2 Kb, un 84,7 % menos, la puedes ver con Photoshop u otro soft con el Zoom que quieras y no las puedes distinguir.
Y el tiempo que tarda con mi sistema y mspaint es 4 seg, por que hago una espera de 3 segundos por precaución y dar le tiempo a que cargue la imagen, para salvarla después.

https://dl.dropboxusercontent.com/u/51073224/Imagenes.rar

Un saludo


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Neocortex en 14 Junio 2015, 02:43 am
Lo pasé a Vb.net, como quiera y te da una idea... Por cierto pobré la imagen le pasó lo mismo que la versión que comprimes, y con 20kb de más jaja, ojo que mi script es prácticamente hacerlo a pie y es algo lento, tardo como 40-50 segundos en hacer todo (mappeo, conversion y guardado)


Código:
Public Sub listas()
Dim pixeles As Byte() = New Byte(50) {}
Dim pixeldos As Byte() = New Byte(254) {}
Dim sumador As Byte = 0
For i As Integer = 0 To pixeles.Length - 2
pixeles(i) = sumador
sumador += 5
Next
For i As Integer = 0 To pixeldos.Length - 2
pixeldos(i) = CByte(i)
Next
For i As Integer = 0 To intwidth - 1
For j As Integer = 0 To intheight - 1
'#Region "limites"
If arrayRed(i, j) = 0 OrElse arrayRed(i, j) < 2 Then
arrayRed(i, j) = 0
End If
If arrayGreen(i, j) = 0 OrElse arrayGreen(i, j) < 2 Then
arrayGreen(i, j) = 0
End If
If arrayBlue(i, j) = 0 OrElse arrayBlue(i, j) < 2 Then
arrayBlue(i, j) = 0
End If
If arrayRed(i, j) = 255 OrElse arrayRed(i, j) > 252 Then
arrayRed(i, j) = 255
End If
If arrayGreen(i, j) = 255 OrElse arrayGreen(i, j) > 252 Then
arrayGreen(i, j) = 255
End If
If arrayBlue(i, j) = 255 OrElse arrayBlue(i, j) > 252 Then
arrayBlue(i, j) = 255
End If
'#End Region
For m As Integer = 3 To pixeles.Length - 3
If arrayRed(i, j) >= pixeles(m) AndAlso arrayRed(i, j) < pixeles(m + 1) Then
arrayRed(i, j) = CByte(pixeles(m) + 2)
End If
If arrayBlue(i, j) >= pixeles(m) AndAlso arrayBlue(i, j) < pixeles(m + 1) Then
arrayBlue(i, j) = CByte(pixeles(m) + 2)
End If
If arrayGreen(i, j) >= pixeles(m) AndAlso arrayGreen(i, j) < pixeles(m + 1) Then
arrayGreen(i, j) = CByte(pixeles(m) + 2)
End If
Next
Next
Next
End Sub

Código:
For i As Integer = 0 To intwidth - 1
For j As Integer = 0 To intheight - 1
Dim clr As Color = img2.GetPixel(i, j)
red = clr.R
green = clr.G
blue = clr.B
arrayRed(i, j) = clr.R
arrayGreen(i, j) = clr.G
arrayBlue(i, j) = clr.B
Next
Next

Saludos


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 14 Junio 2015, 12:16 pm
Gracias de nuevo.
Lo probaré para comparar los resultados a nivel de calidad y resolución, pero la diferencia de tiempo de conversión es enorme.

He hecho la conversión de una carpeta que tiene 86 imágenes del tamaño de la que te puse en el link, de 5184x3456 a 72 ppp.
Con mi sistema tarda 04:44:04 minutos en convertir las 86 imágenes.

Con tu sistema, tomando como promedio 45 seg/imagen, tardaría 64:50:00 minutos, o sea aproximadamente una hora, contra 4.5 minutos, 14.3

veces mas lento, y además según dices la imagen que te subí tiene 20 Kb mas que la misma convertida con mi sistema, mira la captura, le he

agregado un medidor de tiempo al programa.

Pero además el hecho de utilizar msPaint, tiene la ventaja de que el usuario esta viendo cada imagen que se esta convirtiendo, y cuanto

reduce el peso, en tiempo real.
Pero me gustaría saber como poder ejecutar al principio, mspaint con un tamaño de ventana pequeño, como la captura que subo.

(http://s24.postimg.org/orqcyy20l/Cap_1.jpg) (http://postimage.org/)
subir fotos gratis (http://postimage.org/index.php?lang=spanish)

(http://s15.postimg.org/sq7cut9yz/Cap_2.jpg) (http://postimage.org/)
subir imagenes gratis (http://postimage.org/index.php?lang=spanish)

Saludos.


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Neocortex en 17 Junio 2015, 21:10 pm
Creo que encontré la manera de mejorar el código, en la tarde que llegue a la casa le muevo al código y dejo resultados, aunque dudo llegar a la velocidad del mspaint  :laugh:

Saludos desde México


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: okik en 18 Junio 2015, 19:41 pm
Hola de nuevo
Perdonad que me meta en vuestro intercambio de pareceres  :P

Repito lo que te dije Fran1946 tiempo atrás, si no quieres depender de mspaint, puedes usar las funciones GDI que se encuentran el gdi32.dll de windows, que no hace falta instalar porque va con el SO. Creo que en todas las versiones, en w98 o Me, no tengo ni idea, pero quien uso eso ya.

Como te dije no conozco mucho el tema del GDI, lo tengo pendiente. Por ahora solo tengo esto que si que he podido mirar. Como muestra que este es el camino si no me equivoco, o por lo menos uno más. A no ser que diseñes tu propio sistema de compresión.

https://mega.co.nz/#!zd8lkJZb!7tjONqVuRwIrBsp7SfbfzNDUTZIazreQXEoLP1XLvXI (https://mega.co.nz/#!zd8lkJZb!7tjONqVuRwIrBsp7SfbfzNDUTZIazreQXEoLP1XLvXI)

Para cualquier duda sobre este código, puedes preguntarme



Ejemplo sencillo del uso de GDI para cambiar la intensidad de color.  


ca.caColorfulness = -100  'Convierte la imagen a blanco y negro


Código
  1. Private Type COLORADJUSTMENT
  2.        caSize As Integer
  3.        caFlags As Integer
  4.        caIlluminantIndex As Integer
  5.        caRedGamma As Integer
  6.        caGreenGamma As Integer
  7.        caBlueGamma As Integer
  8.        caReferenceBlack As Integer
  9.        caReferenceWhite As Integer
  10.        caContrast As Integer
  11.        caBrightness As Integer
  12.        caColorfulness As Integer
  13.        caRedGreenTint As Integer
  14. End Type
  15.  
  16. Private Declare Function SetColorAdjustment Lib "gdi32" _
  17. (ByVal hdc As Long, _
  18. lpca As COLORADJUSTMENT) As Long
  19. Private Declare Function SetStretchBltMode Lib "gdi32" _
  20. (ByVal hdc As Long, _
  21. ByVal nStretchMode As Long) As Long
  22. Private Declare Function GetColorAdjustment Lib "gdi32" _
  23. (ByVal hdc As Long, _
  24. lpca As COLORADJUSTMENT) As Long
  25. Private Declare Function StretchBlt Lib "gdi32" _
  26. (ByVal hdc As Long, _
  27. ByVal x As Long, _
  28. ByVal y As Long, ByVal nWidth As Long, _
  29. ByVal nHeight As Long, _
  30. ByVal hSrcDC As Long, _
  31. ByVal xSrc As Long, _
  32. ByVal ySrc As Long, _
  33. ByVal nSrcWidth As Long, _
  34. ByVal nSrcHeight As Long, _
  35. ByVal dwRop As Long) As Long
  36.  
  37. Const HALFTONE = 4
  38. Dim Imagen As StdPicture
  39. Private Sub Form_Load()
  40. 'Valores para el HScroll
  41. HScroll1.Max = 100
  42. HScroll1.Min = -100
  43. HScroll1.Value = 0
  44.  
  45. CommonDialog1.ShowOpen
  46. CommonDialog1.Filter = "*.jpg file|*.jpg"
  47.  
  48. 'Abre el cuadro de diálogo abrir y mete la imagen en la variable 'Imagen'
  49. If Len(CommonDialog1.FileName) > 0 Then
  50. Set Imagen = LoadPicture(CommonDialog1.FileName)
  51. End If
  52.  
  53. 'Valores para el Picture
  54. Picture1.AutoRedraw = True
  55. Picture1.ScaleMode = vbPixels
  56. Picture1.Picture = Imagen
  57.  
  58. End Sub
  59.  
  60. Private Sub HScroll1_Scroll()
  61. Dim ca As COLORADJUSTMENT
  62.    With Picture1
  63.       .Picture = Imagen 'Linea necesaria para actualizar la imagen
  64.        SetStretchBltMode .hdc, HALFTONE 'No borrar
  65.        GetColorAdjustment .hdc, ca 'No borrar
  66.        ca.caColorfulness = HScroll1.Value 'Cambia el  valor de color de la imagen
  67.        SetColorAdjustment .hdc, ca  'No borrar
  68.        StretchBlt .hdc, 0, 0, .ScaleWidth, .ScaleHeight, .hdc, 0, 0, .ScaleWidth, .ScaleHeight, vbSrcCopy
  69.        .Refresh
  70.    End With
  71. End Sub


Título: Re: Salvar JPG con mucho menos peso sin perder calidad
Publicado por: Fran1946 en 18 Junio 2015, 21:46 pm
Hola okik:

No hay nada que perdonar, te agradezco una vez más tu ayuda y aportes.
Citar
si no quieres depender de mspaint, puedes usar las funciones GDI que se encuentran el gdi32.dll de windows

A mi no me importa depender de mspaint, me es muy cómodo utilizarlo ya que me resuelve el objetivo de la aplicación, sin tener que complicarme en escribir y probar código, ya que solo lo utilizo cuando saco fotos y las almaceno en el HD con el mínimo peso posible, y esto lo hace perfecto la aplicación que ya la doy por terminada.
No obstante, tu aporte de código y el de otros posibles usuarios del foro, son importantes para aprender cuestiones que no se y quizás nunca utilice, pero el saber no ocupa lugar, y los guardo en mi colección para posibles usos futuros.
No creo que se pueda mejorar, ni siquiera igualar, el algoritmo de compresión de mspaint, a no ser que el GDI tenga una función especifica para salvar a JPG.

Por que el mspaint de Win 7 y posteriores, tiene mas herramientas, y sigue siendo muy básico, pero el algoritmo no tiene nada que ver con el mspaint de Win XP, no altera nada el peso, por eso no me sirve.
Si esta aplicación fuera solo para mí, que tengo Win XP y seguiré con el siempre, por que odio Win 7, Win 8, etc, no hubiera modificado el mspaint, pero tengo amigos y familiares que todos tienen Win 7 u 8.1, y la aplicación no funcionaría. 

Voy a probar tu código y te cuento.

Saludos.