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)
   
'Arguments:
'  hDCRotate     - The hDC to rotate the image in
'  amount        - The amount to rotate, see enumAmount
'  x, y, cx, cy  - Specifies a rectangle to rotate in the hDC
'                  (in pixels)

    Debug.Assert (amount = amount180Degrees) Or (cx = cy)
        'If we're rotating 90 or 270 degrees, must use a square

    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
    
    'Create a buffer to copy the image too, then copy it
    hDC = CreateCompatibleDC(hDCRotate)
    hBitmap = CreateCompatibleBitmap(hDCRotate, cx, cy)
    hBitmapNull = SelectObject(hDC, hBitmap)
    
    BitBlt hDC, 0, 0, cx, cy, hDCRotate, x, y, SRCCOPY
    
    'Get the HBITMAP for the buffer
    GetObject hBitmap, Len(bitmapObj), bitmapObj
    
    'Calculate the number of bytes per pixel
    Debug.Assert bitmapObj.bmBitsPixel \ 8 = bitmapObj.bmBitsPixel / 8
      ' This code can only handle multiples of 8 bits per plain
      
    nBytes = bitmapObj.bmBitsPixel / 8
    
    'Create two arrays, the size of the temporary hDC
    ReDim bytesOrig(0 To nBytes - 1, bitmapObj.bmWidth - 1, _
       bitmapObj.bmHeight - 1)
    ReDim bytesCopy(0 To nBytes - 1, bitmapObj.bmWidth - 1, _
       bitmapObj.bmHeight - 1)
    
    'Copy the bitmap to one of these arrays
    GetBitmapBits hBitmap, bitmapObj.bmWidthBytes * _
       bitmapObj.bmHeight, bytesOrig(0, 0, 0)
    
    Dim nCurX As Long
    Dim nCurY As Long
    Dim nCurZ As Long
    
    'Loop through the array, copying it to the second array, performing
    'the rotation translation (the select is on the outside to
    'improve speed)
    
    'NOTE: If you turn of bounds checking in the compiled version,
    '      things should speed up
    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
    
    'Copy the second array back to the temporary bitmap
    SetBitmapBits hBitmap, bitmapObj.bmWidthBytes * bitmapObj.bmHeight, _
       bytesCopy(0, 0, 0)
    
    'Bitblt the temporary bitmap back onto the screen
    BitBlt hDCRotate, x, y, cx, cy, hDC, 0, 0, SRCCOPY
    
    'Clean up
    SelectObject hDC, hBitmapNull
    DeleteObject hBitmap
    DeleteDC hDC

End Sub

    RotatePicture Me.hDC, amount180Degrees, 0, 0, 300, 300