
http://www.scottandmichelle.net/scott/code/
El código que veremos a continuación sirve para rotar una imagen 90, 180 y 270 grados. Esta imagen puede estar contenida en cualquier objeto que tenga la propiedad hDC (formulario, picture, etc).
Se le pasan como parámetros el hDC del objeto que contiene la imagen, los grados a rotar, y las coordenadas del área que queremos rotar (en pixels).
Este código emplea Get y Set BitmapBits para rotar una imagen dentro de un hDC. Como usa intensamente matrices, se puede incrementar la velocidad de ejecución en el ejecutable compilado desactivando el chequeo de los límites de los arrays.
Pega este código en un 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 = amount180Degrees) 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
Y para usarlo, simplemente :
RotatePicture Me.hDC, amount180Degrees, 0, 0, 300, 300
He realizado algunas pruebas con picturebox y parece que tiene en cuenta los bordes, por lo que hay que restarle algunos pixels :
RotatePicture Picture1.hDC, amount180Degrees, 0, 0, (Picture1.Width / Screen.TwipsPerPixelX) - 4, (Picture1.Height / Screen.TwipsPerPixelY) - 4

