Rotar imagen

[auxsys]

Buenas!

Estoy con un programita que tiene que manipular unas imágenes, nada demasiado complicado. El problema me viene a la hora de rotarlas, y es que necesito hacerlo con un determinado ángulo y manteniendo la calidad. Por eso supongo que necesitaré un API, y la única que encontré fue PlgBlt. Funciona bien excepto que normalmente aparece una línea arriba y a la izquierda, y es un error que creo que no puedo compensar.

La cosa es que necesito la imagen completa, por lo que al rotarla, se deberán ajustar las dimensiones del Picture. Mejor pongo el ejemplo... http://www.4shared.com/file/68097423/988b04b9 (lo siento, no puedo poner los links bien)

Parece una chorrada pero tengo que juntar muchas imágenes y da mucho la nota.
¿Alguien conoce otra función que haga lo mismo, o me puede decir qué hago mal?

Graciasss.

Salu00000010!!!

[Avellaneda]

Iniciado por auxsys

Buenas!

Estoy con un programita que tiene que manipular unas imágenes, nada demasiado complicado. El problema me viene a la hora de rotarlas, y es que necesito hacerlo con un determinado ángulo y manteniendo la calidad. Por eso supongo que necesitaré un API, y la única que encontré fue PlgBlt. Funciona bien excepto que normalmente aparece una línea arriba y a la izquierda, y es un error que creo que no puedo compensar.

La cosa es que necesito la imagen completa, por lo que al rotarla, se deberán ajustar las dimensiones del Picture. Mejor pongo el ejemplo... http://www.4shared.com/file/68097423/988b04b9 (lo siento, no puedo poner los links bien)

Parece una chorrada pero tengo que juntar muchas imágenes y da mucho la nota.
¿Alguien conoce otra función que haga lo mismo, o me puede decir qué hago mal?

Graciasss.

Salu00000010!!!

Hola,
Lo probé y la solución que encontré, para que no muestre las líneas arriba y a la izquierda, fué añadir un punto a las variables MenorX y MenorY.
En el procedimiento HScroll1_Scroll():

MenorX = Menor(Punto(0).X, Punto(1).X, Punto(2).X, Punto(3).X) + 1
MenorY = Menor(Punto(0).Y, Punto(1).Y, Punto(2).Y, Punto(3).Y) + 1

Saludos

[auxsys]

Mmm sí, de hecho creo que probé lo mismo que tú pero lo descarté porque seguían pasando cosas raras con las dimensiones de la imagen. Aunque ahora estaba mirándolo y me he dado cuenta de que cuando se inserta el ángulo directamente, la imagen toma alternativamente unas veces las dimensiones correctas y otras incorrectas. Quiero decir que a veces con el mismo ángulo la imagen toma dimensiones diferentes. Esto por supuesto será un error de mi código, supongo que al tomar las dimensiones del Picture y dividir entre 2 o algo así, pero no sé verlo... alguna idea? Gracias!

Y una última cosa... vuelvo a insistir en otra API más 'profesional'. Esta hace que la imagen pierda calidad. Ya supongo que es difícil comparar alguna API a lo que hace photoshop, pero por ejemplo, ahí rotas la imagen y queda exactamente igual en calidad que la original. Se puede conseguir algo parecido?

Salu00000010!!!

[truskyvb]

Hola. Yo estoy haciendo un puzzle y utilizo lo siguiente:

Módulo:

Option Explicit
Const OBJ_BITMAP = 7
Const SRCCOPY = &HCC0020
Type Size
cx As Long
cy As Long
End Type

Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Declare Function GetCurrentObject Lib "gdi32" (ByVal hDC As Long, ByVal _
uObjectType As Long) As Long

Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal _
hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Declare Function GetBitmapDimensionEx Lib "gdi32" (ByVal hBitmap As _
Long, lpDimension As Size) As Long

Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, _
ByVal dwCount As Long, lpBits As Any) As Long

Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, _
ByVal dwCount As Long, lpBits As Any) As Long

Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, _
ByVal nWidth As Long, ByVal nHeight As Long) As Long

Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) _
As Long

Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, _
ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) _
As Long

Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long

Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long

Public Enum enumAmount
amount90Degrees
amount180Degrees
amount270Degrees
End Enum

Public Sub RotatePicture(hDCRotate As Long, amount As enumAmount, _
X As Long, Y As Long, cx As Long, cy As Long)

'Argumentos:
' hDCRotate - Propiedad hDC del contenedor de la imagen a rotar
' amount - Grados a rotar, ver enumAmount
' x, y, cx, cy - Rectángulo a rotar en el hDC (en pixels)

Debug.Assert (amount = amount90Degrees) Or (cx = cy)
'Si estamos rotando 90 o 270 grados, debemos usar un cuadrado

Dim hDC As Long
Dim hBitmap As Long
Dim hBitmapNull As Long
Dim bitmapObj As BITMAP
Dim bytesOrig() As Byte
Dim bytesCopy() As Byte
Dim nBytes As Long

'Creamos un buffer para copiar la imagen
hDC = CreateCompatibleDC(hDCRotate)
hBitmap = CreateCompatibleBitmap(hDCRotate, cx, cy)
hBitmapNull = SelectObject(hDC, hBitmap)

BitBlt hDC, 0, 0, cx, cy, hDCRotate, X, Y, SRCCOPY

'Obtenemos el HBITMAP del buffer
GetObject hBitmap, Len(bitmapObj), bitmapObj

'Calculamos el número de bytes por pixel
Debug.Assert bitmapObj.bmBitsPixel \ 8 = bitmapObj.bmBitsPixel / 8
' Este código sólo puede manejar múltiplos de 8 bits por plano

nBytes = bitmapObj.bmBitsPixel / 8

'Creamos dos arrays del tamaño del hDC temporal
ReDim bytesOrig(0 To nBytes - 1, bitmapObj.bmWidth - 1, _
bitmapObj.bmHeight - 1)
ReDim bytesCopy(0 To nBytes - 1, bitmapObj.bmWidth - 1, _
bitmapObj.bmHeight - 1)

'Copiamos el bitmap a uno de los arrays
GetBitmapBits hBitmap, bitmapObj.bmWidthBytes * _
bitmapObj.bmHeight, bytesOrig(0, 0, 0)

Dim nCurX As Long
Dim nCurY As Long
Dim nCurZ As Long

'Recorremos el array, copiando en el segundo array haciendo la rotación (el select
'está fuera para incrementar la velocidad

'NOTA : Si desactivas la comprobación de límites en los arrays en la versión
'compilada se incrementará la velocidad.

Select Case amount
Case amount90Degrees
For nCurX = 0 To cx - 1
For nCurY = 0 To cy - 1
For nCurZ = 0 To nBytes - 1
bytesCopy(nCurZ, (cy - 1) - nCurY, nCurX) = _
bytesOrig(nCurZ, nCurX, nCurY)
Next
Next
Next
Case amount180Degrees
For nCurX = 0 To cx - 1
For nCurY = 0 To cy - 1
For nCurZ = 0 To nBytes - 1
bytesCopy(nCurZ, (cx - 1) - nCurX, (cy - 1) - _
nCurY) = bytesOrig(nCurZ, nCurX, nCurY)
Next
Next
Next
Case amount270Degrees
For nCurX = 0 To cx - 1
For nCurY = 0 To cy - 1
For nCurZ = 0 To nBytes - 1
bytesCopy(nCurZ, nCurY, (cx - 1) - nCurX) = _
bytesOrig(nCurZ, nCurX, nCurY)
Next
Next
Next
End Select

'Copiamos el segundo array de nuevo en el bitmap temporal
SetBitmapBits hBitmap, bitmapObj.bmWidthBytes * bitmapObj.bmHeight, _
bytesCopy(0, 0, 0)

'Copiamos con Bitblt el bitmap temporal en la pantalla
BitBlt hDCRotate, X, Y, cx, cy, hDC, 0, 0, SRCCOPY

'Limpiamos
SelectObject hDC, hBitmapNull
DeleteObject hBitmap
DeleteDC hDC

End Sub


En el formulario:

Al hacer click en el picture:

RotatePicture Picture1.hDC, amount90Degrees, 0, 0, (Picture1.Width / Screen.TwipsPerPixelX) - 0, (Picture1.Height / Screen.TwipsPerPixelY) - 0

Donde dice amount90Degrees, puede ser 180 ó 270


Espero que te sirva