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.
prueba ejecutando el programa y pasandole la ruta del archivo:
"c:\sdpaint.exe c:\imagen.jpg"
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.
Cita de: 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.
sí ya veo que no anda, bueno cambialo a esto:
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.
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.
Hola :D
En un Form crea un Botón (CommandButton)
Mete esto en un Módulo:
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'Funcición API para enviar un mensaje a MSPaint
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const SC_CLOSE = &HF060&
Const WM_COMMAND = &H111
Const WM_SYSCOMMAND = &H112
'Función API para obtener el nombre de un archivo a partir de un directorio
Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" _
(ByVal lpszFile As String, _
ByVal lpszTitle As String, _
ByVal cbBuf As Integer) As Integer
'Función para deternimnar si un proceso es una ventana
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
'Función para obtener el nombre corto de un directorio
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
Public Const MS_SAVE = 0
Public Const MS_SAVE_AS = 1
Dim hwMsPaint As Long 'para el Handle de MsPaint
Public Function GetDirCorto(strPath) As String
Dim ShortName As String * 255
Call GetShortPathName(strPath, ShortName, 255)
GetDirCorto = Left$(ShortName, InStr(1, ShortName, Chr$(0)) - 1)
End Function
'Inicia MsPaint en modo oculto
Public Function StartMSPaint(ByVal PathMsPaint As String, ByVal strPathFile As String, ByVal Modo As Integer)
On Error GoTo Error_sub
Dim Count As Long
Dim objStartup As Object
Dim objWMIService As Object
Dim objConfig As Object
Dim objProcess As Object
Dim Error As Integer
Dim strComputer As String
Dim intProcessID As Long
Dim Opcion As Integer
Dim sFile As String
Dim sDir As String
strComputer = "."
hwMsPaint = 0
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"
'Si el archivo no existe...
If sDir = "" Then
MsgBox "No se encuentra " & strPathFile, vbCritical
Exit Function
End If
Error = objProcess.Create(PathMsPaint & " " & sDir, Null, objConfig, intProcessID)
If Error Then
MsgBox "No se encuentra " & PathMsPaint & "." & vbCrLf & vbCrLf & _
"Compruebe que la aplicación existe o está correctamente escrito.", _
vbCritical, "Error"
Exit Function
End If
'On Local Error Resume Next
'Elimina las variables de objeto
Set objStartup = Nothing
Set objWMIService = Nothing
Set objConfig = Nothing
Set objProcess = Nothing
'Obtiene el título del archivo a guardar
sFile = gFileTitle(strPathFile)
'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
'No pasa hasta el siguiente comando hasta que MsPaint se haya abierto
Dim n&
Do While n& = 1
n& = IsWindow(hwMsPaint)
DoEvents
Loop
'Envia el mensaje Guardar o Guardar como a MsPaint
Call MsPaintSave(Modo)
Do While n& = 0
n& = IsWindow(hwMsPaint)
CloseMsPaint
DoEvents
Loop
Exit Function
Error_sub:
MsgBox Err.Description, vbCritical
On Local Error Resume Next
'Elimina las variables de objeto
Set objStartup = Nothing
Set objWMIService = Nothing
Set objConfig = Nothing
Set objProcess = Nothing
End Function
Private Sub MsPaintSave(ByVal Modo As Integer)
Select Case Modo
Dim X&
Case 0
X& = SendMessage(hwMsPaint, WM_COMMAND, 57603, &H0) 'Guardar
Case 1
X& = SendMessage(hwMsPaint, WM_COMMAND, 57604, &H0) 'Guardar como...
End Select
End Sub
'Cierra MsPaint
Public Function CloseMsPaint()
'Envía el mensaje de Cerrar a MSPaint
SendMessage hwMsPaint, WM_SYSCOMMAND, SC_CLOSE, &H0
End Function
'Obtiene el nombre del archivo Ej.: E:\Paisaje.jpg" ->obtiene "Paisaje.jpg"
Private Function gFileTitle(ByVal strPathFile As String) As String
Dim strFileTitle As String
strFileTitle = Space(100)
GetFileTitle strPathFile, strFileTitle, 100
gFileTitle = Left$(strFileTitle, InStr(1, strFileTitle, Chr$(0)) - 1)
End Function
Mete esto en un Form:
Private Sub Command1_Click()
Dim strFile As String
strFile = App.Path & "\Dock.jpg"
'MS_SAVE = Guardar (No aparecerá cuadro de diálogo)
'MS_SAVE_AS = Guardar como ...
Call StartMSPaint("mspaint.exe", strFile, MS_SAVE): CloseMsPaint
End Sub
Private Sub Form_Load()
Show
'Centrar formulario
Me.Move (Screen.Width / 2) - (Me.Width / 2), (Screen.Height / 2) - (Me.Height / 2)
Command1.Caption = "Guardar con MsPaint"
End Sub
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)
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:
'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:
hwMsPaint = FindWindow("MSPaintApp", sFile & " - Paint")
debería ser:
hwMsPaint = FindWindow("SDPaintApp", sFile & " - Paint")
Pero no comprendo como trabaja esta parte de código que supongo carga mspaint:
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:
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.
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.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" _
(ByVal hMenu As Long, _
ByVal wIDItem As Long, _
ByVal lpString As String, _
ByVal nMaxCount As Long, _
ByVal wFlag As Long) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSubMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Const MF_BYPOSITION = &H400&
Const WM_COMMAND = &H111
Const MF_POPUP = &H10&
Private Sub Command1_Click()
Dim hwnd As Long
Dim hMainMenu As Long
Dim hMenu As Long
Dim MenuID As Long
Dim szbuf As String * 128
Dim szBufM As String * 128
Dim I, Z
Z = 0 'Posición del menú
I = 2 'Posición del submenú
hwnd = FindWindow("SDPaintApp", vbNullString)
If hwnd = 0 Then Exit Sub
hMainMenu = GetMenu(hwnd)
hMenu = GetSubMenu(hMainMenu, Z)
MenuID = GetMenuItemID(hMenu, I)
Call GetMenuString(hMenu, MenuID, szbuf, 128, MF_BYPOSITION & MF_POPUP)
MsgBox MenuID & " " & szbuf
'X& = SendMessage(hwnd, WM_COMMAND, MenuID, 0&)
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.
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:
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:
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.
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)
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.
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.
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.
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:
Dim hwndViewer As Long
Do While hwndViewer = 0
hwndViewer = FindWindow("Photo_Lightweight_Viewer", vbNullString)
DoEvents
Loop
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
Gracias okik:
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:
Dim hwndViewer As Long
Do While hwndViewer = 0
hwndViewer = FindWindow("Photo_Lightweight_Viewer", vbNullString)
DoEvents
Loop
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.
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:
Name ListFiles.List(i) As Left(ListFiles.List(i), Len(ListFiles.List(i)) - 4) & "_Procesado.jpg"
como luego borras la lista no hace falta, pero si no la borras puedes actualizar el nuevo nombre:
ListFiles.List(i) = Left(ListFiles.List(i), Len(ListFiles.List(i)) - 4) & "_Procesado.jpg"
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.
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.
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
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.
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.
Felicidades ;-)
Parece que al final has logrado tu objetivo.
Hola a todos:
SI, pero gracias a vuestra ayuda.
Gracias y un saludo.
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.
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.
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
Cita de: Fran1946 en 26 Mayo 2015, 14: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.
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)
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:
CitarPrueba 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.
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
Hola:
CitarYo 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.
Citarlo 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.
Cita de: Fran1946 en 12 Junio 2015, 01:26 AM
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
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.
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!
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
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)
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
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
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.
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
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
Private Type COLORADJUSTMENT
caSize As Integer
caFlags As Integer
caIlluminantIndex As Integer
caRedGamma As Integer
caGreenGamma As Integer
caBlueGamma As Integer
caReferenceBlack As Integer
caReferenceWhite As Integer
caContrast As Integer
caBrightness As Integer
caColorfulness As Integer
caRedGreenTint As Integer
End Type
Private Declare Function SetColorAdjustment Lib "gdi32" _
(ByVal hdc As Long, _
lpca As COLORADJUSTMENT) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" _
(ByVal hdc As Long, _
ByVal nStretchMode As Long) As Long
Private Declare Function GetColorAdjustment Lib "gdi32" _
(ByVal hdc As Long, _
lpca As COLORADJUSTMENT) As Long
Private Declare Function StretchBlt Lib "gdi32" _
(ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal nSrcWidth As Long, _
ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long
Const HALFTONE = 4
Dim Imagen As StdPicture
Private Sub Form_Load()
'Valores para el HScroll
HScroll1.Max = 100
HScroll1.Min = -100
HScroll1.Value = 0
CommonDialog1.ShowOpen
CommonDialog1.Filter = "*.jpg file|*.jpg"
'Abre el cuadro de diálogo abrir y mete la imagen en la variable 'Imagen'
If Len(CommonDialog1.FileName) > 0 Then
Set Imagen = LoadPicture(CommonDialog1.FileName)
End If
'Valores para el Picture
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
Picture1.Picture = Imagen
End Sub
Private Sub HScroll1_Scroll()
Dim ca As COLORADJUSTMENT
With Picture1
.Picture = Imagen 'Linea necesaria para actualizar la imagen
SetStretchBltMode .hdc, HALFTONE 'No borrar
GetColorAdjustment .hdc, ca 'No borrar
ca.caColorfulness = HScroll1.Value 'Cambia el valor de color de la imagen
SetColorAdjustment .hdc, ca 'No borrar
StretchBlt .hdc, 0, 0, .ScaleWidth, .ScaleHeight, .hdc, 0, 0, .ScaleWidth, .ScaleHeight, vbSrcCopy
.Refresh
End With
End Sub
Hola okik:
No hay nada que perdonar, te agradezco una vez más tu ayuda y aportes.
Citarsi 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.