##### http://www.lawebdelprogramador.com #####
##### RESPUESTA A LA PREGUNTA 34271 - VISUAL BASIC #####


Pega este código en un módulo : 



Codigo:--------------------------------------------------------------------------------
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


##### Angel Bueno - angelbueno@cielo.com #####