# The age old question: Bitmap Rotation

Now all you geniuses, lets see how you handle this one.
How do you rotate a bitmap, on the fly, through any angle (an no sine, cosine crap, thats yesterdays homework), without using Direct X or Open GL.

Shouldn't be too hard for you masters of programming.
###### Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Commented:
Global Const SRCCOPY = &HCC0020
Global Const Pi = 3.14159265359

Public Declare Function StretchBlt Lib "gdi32" Alias "StretchBlt" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Public Declare Function SetPixel Lib "gdi32" Alias "SetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Public Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Sub bmp_rotate (pic1 As PictureBox, pic2 As PictureBox, ByVal theta!)

' bmp_rotate(pic1, pic2, theta)
' Rotate the image in a picture box.
'pic1 is the picture box with the bitmap to rotate
'pic2 is the picture box to receive the rotated bitmap
'theta is the angle of rotation
Dim c1x As Integer, c1y As Integer
Dim c2x As Integer, c2y As Integer
Dim a As Single
Dim p1x As Integer, p1y As Integer
Dim p2x As Integer, p2y As Integer
Dim n As Integer, rAs Integer
c1x = pic1.ScaleWidth \ 2
c1y = pic1.ScaleHeight \ 2
c2x = pic2.ScaleWidth \ 2
c2y = pic2.ScaleHeight \ 2
If c2x < c2y Then n = c2y Else n = c2x
n = n - 1
pic1hDC% = pic1.hDC
pic2hDC% = pic2.hDC

For p2x = 0 To n

For p2y = 0 To n
If p2x = 0 Then a = Pi / 2 Else a = Atn(p2y / p2x)
r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)
p1x = r * Cos(a + theta!)
p1y = r * Sin(a + theta!)
c0& = GetPixel(pic1hDC%, c1x + p1x, c1y + p1y)
c1& = GetPixel(pic1hDC%, c1x - p1x, c1y - p1y)
c2& = GetPixel(pic1hDC%, c1x + p1y, c1y - p1x)
c3& = GetPixel(pic1hDC%, c1x - p1y, c1y + p1x)
If c0& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2x, c2y + p2y, c0&)
If c1& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2x, c2y - p2y, c1&)
If c2& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2y, c2y - p2x, c2&)
If c3& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2y, c2y + p2x, c3&)
Next

t% = DoEvents()
Next

End Sub

Pic1 & 2's Scale mode should be set to 3.

Some examples:

Sub Command1_Click ()

'flip horizontal
picture2.Cls
px% = picture1.ScaleWidth
py% = picture1.ScaleHeight
retval% = StretchBlt(picture2.hDC, px%, 0, -px%, py%, picture1.hDC, 0, 0, px%, py%, SRCCOPY)
End Sub

Sub Command2_Click ()

'flip vertical
picture2.Cls
px% = picture1.ScaleWidth
py% = picture1.ScaleHeight
retval% = StretchBlt(picture2.hDC, 0, py%, px%, -py%, picture1.hDC, 0, 0, px%, py%, SRCCOPY)
End Sub

Sub Command3_Click ()

'rotate 45 degrees
picture2.Cls
Call bmp_rotate(picture1, picture2, 3.14 / 4)
End Sub
0

Experts Exchange Solution brought to you by

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Author Commented:
That is very slow (especially for on the fly "rotation of a ship" in a game say), is there a faster way?
0
Commented:
You can read this microsoft KB article:

HOWTO: Rotate a Bitmap Image in 90-Degree Increments
http://support.microsoft.com/support/kb/articles/Q186/2/60.ASP

Cheers!

0
Commented:
That was something I picked up at planet-source-code.  I'm not sure how to make it faster.

Why don't you just make two bitmaps, one right side up and one upside down?
0
###### It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.