Public Sub RotateBitmap(hBitmapDC As Long, lWidth As Long, _
lHeight As Long, lRadians As Long)
Dim hNewBitmapDC As Long ' DC of the new bitmap
Dim hNewBitmap As Long ' handle to the new bitmap
Dim lSine As Long ' sine used in rotation
Dim lCosine As Long ' cosine used in rotation
Dim X1 As Long ' used in calculating new
' bitmap dimensions
Dim X2 As Long ' used in calculating new
' bitmap dimensions
Dim X3 As Long ' used in calculating new
' bitmap dimensions
Dim Y1 As Long ' used in calculating new
' bitmap dimensions
Dim Y2 As Long ' used in calculating new
' bitmap dimensions
Dim Y3 As Long ' used in calculating new
' bitmap dimensions
Dim lMinX As Long ' used in calculating new
' bitmap dimensions
Dim lMaxX As Long ' used in calculating new
' bitmap dimensions
Dim lMinY As Long ' used in calculating new
' bitmap dimensions
Dim lMaxY As Long ' used in calculating new
' bitmap dimensions
Dim lNewWidth As Long ' width of new bitmap
Dim lNewHeight As Long ' height of new bitmap
Dim I As Long ' loop counter
Dim J As Long ' loop counter
Dim lSourceX As Long ' x pixel coord we are blitting
' from the source image
Dim lSourceY As Long ' y pixel coord we are blitting
' from the source image
' create a compatible DC from the one just brought
' into this function
hNewBitmapDC = CreateCompatibleDC(hBitmapDC)
' compute the sine/cosinse of the radians used to
' rotate this image
lSine = Sin(lRadians)
lCosine = Cos(lRadians)
' compute the size of the new bitmap being created
X1 = -lHeight * lSine
Y1 = lHeight * lCosine
X2 = lWidth * lCosine - lHeight * lSine
Y2 = lHeight * lCosine + lWidth * lSine
X3 = lWidth * lCosine
Y3 = lWidth * lSine
' figure out the max/min size of the new bitmap
lMinX = Min(0, Min(X1, Min(X2, X3)))
lMinY = Min(0, Min(Y1, Min(Y2, Y3)))
lMaxX = Max(X1, Max(X2, X3))
lMaxY = Max(Y1, Max(Y2, Y3))
' set the new bitmap width/height
lNewWidth = lMaxX - lMinX
lNewHeight = lMaxY - lMinY
' create a new bitmap based upon the new width/height of the
' rotated bitmap
hNewBitmap = CreateCompatibleBitmap _
(hBitmapDC, lNewWidth, lNewHeight)
' attach the new bitmap to the new device context created
' above before constructing the rotated bitmap
Call SelectObject(hNewBitmapDC, hNewBitmap)
' loop through and translate each pixel to its new location.
' this is using a standard rotation algorithm
For I = 0 To lNewHeight
For J = 0 To lNewWidth
lSourceX = (J + lMinX) * lCosine + (I + lMinY) * lSine
lSourceY = (I + lMinY) * lCosine - (J + lMinX) * lSine
If (lSourceX >= 0) And (lSourceX <= lWidth) And _
(lSourceY >= 0) And (lSourceY <= lHeight) Then
Call BitBlt(hNewBitmapDC, J, I, 1, 1, hBitmapDC, _
lSourceX, lSourceY, SRCCOPY)
End If
Next J
Next I
' reset the new bitmap width and height
lWidth = lNewWidth
lHeight = lNewHeight
' return the DC to the new bitmap
hBitmapDC = hNewBitmapDC
' destroy the bitmap created
Call DeleteObject(hNewBitmap)
End Sub
