Bitmap rotation is a graphic effect that Visual Basic does not natively offer. This article shows how to rotate a given image in 90-degree increments. It allows you to rotate any image 0, 90, 180 or 270 degrees. With a little work, the code can be modified to rotate to any angle, but that is beyond the scope of this article. .
The following sample uses a function called RotateBitmap. Here is some information about this function: |
hBitmapDC: Handle to a device context of the image to be rotated. Upon return, this variable will contain the device context of the rotated image. lWidth: Width of the incoming image. Upon return contains the width of the rotated image. lHeight: Height of the incoming image. Upon return, contains the height of the rotated image. lRadians: Angle to rotate the image (in Radians). The sample shows how to convert degrees into radians on the fly.
Step-by-Step Example
- Create a new Standard EXE project in Visual Basic. Form1 is created by default. - Add a Standard Module (Module1) to the project. - Add the following controls to Form1:
- Two PictureBox controls
- One Timer control
For the two PictureBox controls, set their AutoRedraw properties to True. - Copy and paste the following code in the Form's code Window:
Form1.frm |
Click here to copy the following block | Option Explicit
Dim sFileName As String Dim hBitmap As Long Dim lBMDC As Long Dim sBitmapInfo As BITMAP Dim Degrees As Long
Private Sub Command1_Click() If Timer1.Enabled = True Then Timer1.Enabled = False Command1.Caption = "<< Start" Else Timer1.Enabled = True Command1.Caption = "<< Stop" Call LoadBMPFromFile End If End Sub
Private Sub Form_Load() Timer1.Interval = 1000 Timer1.Enabled = False Picture2.AutoRedraw = True Text1 = App.Path & "\24bit.bmp" Call LoadBMPFromFile End Sub
Sub LoadBMPFromFile() Degrees = 0 sFileName = Text1.Text Picture1.Cls Picture2.Cls
hBitmap = LoadImage(0, sFileName, IMAGE_BITMAP, 0, 0, _ LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
If (hBitmap = 0) Then MsgBox "Error, Unable To Load Bitmap", vbOKOnly, _ "Bitmap Load Error" End End If
lBMDC = CreateCompatibleDC(0)
If (lBMDC = 0) Then MsgBox "Error, Unable To Create Device Context", _ vbOKOnly, "Device Context Error" Exit Sub End If
Call SelectObject(lBMDC, hBitmap)
Call GetObject(hBitmap, Len(sBitmapInfo), sBitmapInfo)
Call BitBlt(Picture1.hdc, 0, 0, sBitmapInfo.bmWidth, _ sBitmapInfo.bmHeight, lBMDC, 0, 0, SRCCOPY) Picture1.Refresh End Sub Private Sub Timer1_Timer() Dim hRotatedBitmapDC As Long Dim lWidth As Long Dim lHeight As Long Dim lRadians As Long lWidth = sBitmapInfo.bmWidth lHeight = sBitmapInfo.bmHeight
lRadians = PI * Degrees / 180
hRotatedBitmapDC = Picture1.hdc
RotateBitmap hRotatedBitmapDC, lWidth, lHeight, lRadians
Set Picture2.Picture = LoadPicture
Call BitBlt(Picture2.hdc, 0, 0, lWidth, lHeight, _ hRotatedBitmapDC, 0, 0, SRCCOPY) Picture2.Refresh
Call DeleteDC(hRotatedBitmapDC)
Degrees = Degrees + 90 If Degrees = 360 Then Degrees = 0 End If End Sub |
- Add the following code to the Standard Module (Module1):
Module1.bas |
Click here to copy the following block | Option Explicit
Public Const IMAGE_BITMAP = &O0
Public Const LR_LOADFROMFILE = 16 Public Const LR_CREATEDIBSECTION = 8192 Public Const SRCCOPY = &HCC0020 Public Const PI = 3.14159
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 LoadImage Lib "user32" Alias "LoadImageA" _ (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, _ ByVal n1 As Long, ByVal n2 As Long, ByVal un2 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 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
Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _ (ByVal hObject As Long, ByVal nCount As Long, lpObject 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteObject Lib "gdi32" _ (ByVal hObject As Long) As Long
Public Sub RotateBitmap(hBitmapDC As Long, lWidth As Long, _ lHeight As Long, lRadians As Long)
Dim hNewBitmapDC As Long Dim hNewBitmap As Long Dim lSine As Long Dim lCosine As Long Dim X1 As Long Dim X2 As Long Dim X3 As Long Dim Y1 As Long Dim Y2 As Long Dim Y3 As Long Dim lMinX As Long Dim lMaxX As Long Dim lMinY As Long Dim lMaxY As Long Dim lNewWidth As Long Dim lNewHeight As Long Dim I As Long Dim J As Long Dim lSourceX As Long Dim lSourceY As Long
hNewBitmapDC = CreateCompatibleDC(hBitmapDC)
lSine = Sin(lRadians) lCosine = Cos(lRadians)
X1 = -lHeight * lSine Y1 = lHeight * lCosine X2 = lWidth * lCosine - lHeight * lSine Y2 = lHeight * lCosine + lWidth * lSine X3 = lWidth * lCosine Y3 = lWidth * lSine
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))
lNewWidth = lMaxX - lMinX lNewHeight = lMaxY - lMinY
hNewBitmap = CreateCompatibleBitmap _ (hBitmapDC, lNewWidth, lNewHeight)
Call SelectObject(hNewBitmapDC, hNewBitmap)
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
lWidth = lNewWidth lHeight = lNewHeight
hBitmapDC = hNewBitmapDC
Call DeleteObject(hNewBitmap) End Sub
Private Function Min(X1 As Long, Y1 As Long) As Long If X1 >= Y1 Then Min = Y1 Else Min = X1 End If End Function
Private Function Max(X1 As Long, Y1 As Long) As Long If X1 >= Y1 Then Max = X1 Else Max = Y1 End If End Function |
|