Cita:
|
Iniciado por Marc EOS
La prueba lógica es abrir, editar el cuadro completo, es decir cambiar el valor de TODOS los pixeles, por ejemplo elevando saturación o luminosidad, o cualquier parámetro global, y luego guardar. Apostaría a que con menos de 20 repeticiones ya comienza a presentar artefactos varios   |
Tens tota la raò. Así que ahora he hecho que en cada guardado se alteren los niveles de los 3 canales de color de
todos los pixels en nada menos que 20 niveles. Así un pixel con componente azul por ejemplo 200 pasaría a 220, y en la siguiente vuelta me lo vuelvo a traer a 200, así las muestras impares salen claritas, y las pares similares al primer JPEG guardado arriba.
Imagino que algún pixel se habrá quemado en uno o más de sus canales pero la verdad es que no ha parecido interferir en la compresión JPEG ni en el aspecto global de la foto.
Os paso algunas muestras. Aquí no llego a 2000 porque ya le cuesta un poco más
pero mientras escribo esto la máquina de churros sigue sacando JPEG's y la calidad se mantiene muy aceptable.
20-AVO JPEG (87 KB)
21-AVO JPEG (87 KB)
Y si nos vamos al...
523-AVO JPEG (87 KB)
524-AVO JPEG (87 KB)
Como decía Marc han ido apareciendo artefactos (ver los cuadraditos a la derecha), sobre la versión 40 que a medida que se guardaban se incrementaban en notoriedad.
Pero aún así creo que el JPEG lo hace bastante bien no? pensad que es un JPEG de calidad mediocre además (el ratio de compresión ha sido de 14 respecto al BMP: de 1250KB a 88KB).
Os pongo el código fuente (k=20 niveles):
For i = 1 To 2000
Set MyObj1 = New GflAx.GflAx
MyObj1.LoadBitmap (sFileName)
For lX = 0 To 532
For lY = 0 To 799
lColour = MyObj1.GetColorAt(lX, lY)
iRGB(1) = GetR(lColour) + k
iRGB(2) = GetG(lColour) + k
iRGB(3) = GetB(lColour) + k
For l = 1 To 3
If iRGB(l) < 0 Then
iRGB(l) = 0
ElseIf iRGB(l) > 255 Then
iRGB(l) = 255
End If
Next l
lColour = RGB(iRGB(1), iRGB(2), iRGB(3))
MyObj1.LineColor = lColour
MyObj1.DrawPoint lX, lY
Next lY
Next lX
k = -k
MyObj1.SaveFormat = iFormat
sFileName = sRoot & "test_" & IIf(i < 10, "000" & i, IIf(i < 100, "00" & i, IIf(i < 1000, "0" & i, i))) & _
Extension(iFormat)
MyObj1.SaveBitmap (sFileName)
Set MyObj1 = Nothing
frmPrincipal.txtRuta = sFileName
DoEvents
Next i
Manolowar, yo es que de PS no tengo ni idea sino lo usaría.