HOWTO: How to Rotate a Bitmap in VB for WindowsID: Q80406
|
This article contains a program example that uses Visual Basic for Windows statements and functions to rotate a bitmap.
' Example of how to call bmp_rotate.
Sub Command1_Click ()
Const Pi = 3.14159265359
For angle = Pi / 6 To 2 * Pi Step Pi / 6
picture2.Cls
Call bmp_rotate(picture1, picture2, angle)
Next
End Sub
' 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
'
Sub bmp_rotate (pic1 As Control, pic2 As Control, ByVal theta!)
Const Pi = 3.14159265359
Dim c1x As Integer ' Center of pic1.
Dim c1y As Integer ' "
Dim c2x As Integer ' Center of pic2.
Dim c2y As Integer ' "
Dim a As Single ' Angle of c2 to p2.
Dim r As Integer ' Radius from c2 to p2.
Dim p1x As Integer ' Position on pic1.
Dim p1y As Integer ' "
Dim p2x As Integer ' Position on pic2.
Dim p2y As Integer ' "
Dim n As Integer ' Max width or height of pic2.
' Compute the centers.
c1x = pic1.scalewidth / 2
c1y = pic1.scaleheight / 2
c2x = pic2.scalewidth / 2
c2y = pic2.scaleheight / 2
' Compute the image size.
n = pic2.scalewidth
If n < pic2.scaleheight Then n = pic2.scaleheight
n = n / 2 - 1
' For each pixel position on pic2.
For p2x = 0 To n
For p2y = 0 To n
' Compute polar coordinate of p2.
If p2x = 0 Then
a = Pi / 2
Else
a = Atn(p2y / p2x)
End If
r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)
' Compute rotated position of p1.
p1x = r * Cos(a + theta)
p1y = r * Sin(a + theta)
' Copy pixels, 4 quadrants at once.
c0& = pic1.Point(c1x + p1x, c1y + p1y)
c1& = pic1.Point(c1x - p1x, c1y - p1y)
c2& = pic1.Point(c1x + p1y, c1y - p1x)
c3& = pic1.Point(c1x - p1y, c1y + p1x)
If c0& <> -1 Then pic2.PSet (c2x + p2x, c2y + p2y),c0&
If c1& <> -1 Then pic2.PSet (c2x - p2x, c2y - p2y),c1&
If c2& <> -1 Then pic2.PSet (c2x + p2y, c2y - p2x),c2&
If c3& <> -1 Then pic2.PSet (c2x - p2y, c2y + p2x),c3&
Next
' Allow pending Windows messages to be processed.
t% = DoEvents()
Next
End Sub
SavePicture Picture2.Image, "filename.bmp"
Additional query words:
Keywords : kbVBp kbDSupport
Version : WINDOWS:1.0,2.0,3.0
Platform : WINDOWS
Issue type : kbhowto
Last Reviewed: July 13, 1999