`' This structure holds Bitmap informationPrivate Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As LongEnd Type' This structure holds SAFEARRAY infoPrivate Type SafeArray2 cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long cElements1 As Long lLbound1 As Long cElements2 As Long lLbound2 As LongEnd Type' API declaresPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As _ Any, pSrc As Any, ByVal ByteLen As Long)Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal _ hObject As Long, ByVal nCount As Long, lpObject As Any) As Long' Rotate a 256-color bitmap by any angle:' sourcePB is the source PictureBox control (may be hidden)' destPB is the destination PictureBox control' XC, YC are the coordinates of the rotation center' ANGLE is the rotation angle in degrees' this improved version scans only a portion of the image, and builds' remaining points using simmetry. This algorithm is particularly efficient ' when the' center of the rotation is inside the bitmap, the best performances are ' achieved' when it is near to the center of the bitmap. Moreover, this code saves some' CPU time by using pre-calculated values for SIN, COS, and SQR functions.' IMPORTANT: the source and destination PictureBox control must initially' contain the *same* bitmap, to ensure that size and color palette' are correctly initialized.' Example:' 'Load the same image in both source (hidden) and destination controls' Picture1.Picture = LoadPicture("d:winntgone fishing.bmp")' Picture2.Picture = LoadPicture("d:winntgone fishing.bmp")' ' Rotate by 360Â°' Dim a As Single' For a = 0 To 360 Step 5' RotatePicture2 Picture1, Picture2, 50, 50, a' NextPrivate Sub RotatePicture2(sourcePB As PictureBox, destPB As PictureBox, _ xc As Long, yc As Long, degrees As Single) ' all angles are expressed in 1/10000ths of radians Const PI As Long = 31416 Const HALFPI As Long = 15707 Const DOUBLEPI As Long = 62831 Const SQRTABLE_MAX As Long = 40000 Static sinTable() As Single Static atnTable() As Long Static sqrTable() As Single Static initialized As Boolean ' these are used to address the pixel using matrices Dim pict1() As Byte Dim pict2() As Byte Dim p1 As SafeArray2, p2 As SafeArray2 Dim bmp1 As BITMAP, bmp2 As BITMAP ' these are used by the rotating algorithm Dim radians As Long Dim angle As Long Dim angle0 As Long Dim distance As Single Dim distanceSquared As Long Dim deltaX As Long, deltaY As Long Dim deltaXSquared As Single, deltaX10000 As Long Dim x As Long, y As Long Dim dx As Long, dy As Long Dim x0 As Long, y0 As Long Dim xx As Long, yy As Long Dim xStart As Long, xEnd As Long Dim yStart As Long, yEnd As Long Dim bmWidth1 As Long Dim bmHeight1 As Long ' Initialize sin,cos,sqr tables If Not initialized Then initialized = True Dim i As Long ' evaluate a table of sin for 360+90 degrees ' with a precision of 1/10000 of a radian ' this permits to reuse the same table for cosine, too ' since COX(x) = SIN(x + 90Â°) ReDim sinTable(0 To 62831 + 15709) As Single For i = 0 To UBound(sinTable) sinTable(i) = Sin(i / 10000) Next ' evaluate a table for Atn(x)*10000 for x=[0,1], with steps of 0,0001 ReDim atnTable(0 To 10000) As Long For i = LBound(atnTable) To UBound(atnTable) atnTable(i) = Atn(i / 10000) * 10000# Next ' evaluate a table for Sqr(i) ReDim sqrTable(SQRTABLE_MAX) As Single For i = 0 To SQRTABLE_MAX sqrTable(i) = Sqr(i) Next End If ' get bitmap info GetObjectAPI sourcePB.Picture, Len(bmp1), bmp1 GetObjectAPI destPB.Picture, Len(bmp2), bmp2 If bmp1.bmPlanes 1 Or bmp1.bmBitsPixel 8 Or bmp2.bmPlanes 1 Or _ bmp2.bmBitsPixel 8 Then MsgBox "This routine supports 256-color bitmaps only", vbCritical Exit Sub End If ' have the local matrices point to bitmap pixels With p1 .cbElements = 1 .cDims = 2 .lLbound1 = 0 .cElements1 = bmp1.bmHeight .lLbound2 = 0 .cElements2 = bmp1.bmWidthBytes .pvData = bmp1.bmBits End With CopyMemory ByVal VarPtrArray(pict1), VarPtr(p1), 4 With p2 .cbElements = 1 .cDims = 2 .lLbound1 = 0 .cElements1 = bmp2.bmHeight .lLbound2 = 0 .cElements2 = bmp2.bmWidthBytes .pvData = bmp2.bmBits End With CopyMemory ByVal VarPtrArray(pict2), VarPtr(p2), 4 ' convert the angle into 1/10000ths of radians ' subtracting 628310000 ensure that when radians is used in the ' subtraction in the loop, it produces a positive number radians = degrees / (180 / 3.14159) * 10000& - 628310000 ' we have several cases, depending on where XC falls ' compared to the center of the image If xc ' the main loop of this routine scans a squared portion ' of the image whose corners falls on the rotation center ' Of the four squares that touch the rotation center, here ' we choose the one with the highest number of pixels ' withing the image If xEnd - xStart > yEnd - yStart Then If yStart = 0 Then yStart = yEnd - (xEnd - xStart) Else yEnd = yStart + (xEnd - xStart) End If Else If xStart = 0 Then xStart = xEnd - (yEnd - yStart) Else xEnd = xStart + (yEnd - yStart) End If End If bmWidth1 = bmp1.bmWidth bmHeight1 = bmp1.bmHeight ' rotate the picture For x = xStart To xEnd ' these values are loop invariant for the following For-Next deltaX = x - xc deltaXSquared = deltaX * deltaX deltaX10000 = deltaX * 10000 For y = yStart To yEnd deltaY = y - yc ' evaluate the arc-tangent of (deltaY/deltaX) ' many IFs are required, since the atnTable() array only ' covers the range [0,1] - if (deltaY/deltaX) is > 1 we ' must use its reciprocal deltaX/deltaY If deltaX > 0 Then If deltaY >= 0 Then If deltaY 0 Then If deltaY deltaX Then angle = PI + atnTable((deltaY * 10000) deltaX) Else angle = -HALFPI - atnTable(deltaX10000 deltaY) End If End If Else If deltaY >= 0 Then angle = HALFPI Else angle = -HALFPI End If End If ' --- end of arc-tangent evaluation ' "angle" is the angle of the segment that goes from ' the center to (x,y) - since we wish to evaluate the ' color of this point, we must check the point in the ' original bitmap that has the same distance from the ' center but with a different angle ' evaluate the distance of (x,y) from the rotation ' center, using if possible the value already stored ' in sqrTable() distanceSquared = deltaXSquared + deltaY * deltaY If distanceSquared ' the old point in the original bitmap has same ' distance but a different angle angle0 = (angle - radians) Mod DOUBLEPI ' evaluate the x,y offset of the old point from ' the rotation center dx = distance * sinTable(angle0 + HALFPI) ' really cosine dy = distance * sinTable(angle0) ' if (x,y) falls within the image If x >= 0 And x = 0 And y ' (x0,y0) is the corresponding point in the original bitmap x0 = xc + dx y0 = yc + dy ' if (x0,y0) falls within the bitmap boundaries, copy the pixel ' else, set the (x,y) pixel to zero (background color) If x0 >= 0 And x0 = 0 And y0 ' this is the point simmetrical to the rotation center - this ' block is within the outer If clause because the simmetrical ' point can be within the bitmap only if (x,y) was within the ' bitmap too xx = xc - deltaX yy = yc - deltaY If xx >= 0 And xx = 0 And yy = 0 And x0 = 0 And y0 ' now deal with the pixel 90Â° ahead of the one in (x,y) xx = xc + deltaY yy = yc - deltaX If xx >= 0 And xx = 0 And yy = 0 And x0 = 0 And y0 ' now deal with the pixel 270Â° ahead of the one in (x,y) xx = xc - deltaY yy = yc + deltaX If xx >= 0 And xx = 0 And yy = 0 And x0 = 0 And y0 ' release arrays CopyMemory ByVal VarPtrArray(pict1), 0&, 4 CopyMemory ByVal VarPtrArray(pict2), 0&, 4 ' show the rotated bitmap destPB.Refresh End Sub' Support routinePrivate Function VarPtrArray(arr As Variant) As Long CopyMemory VarPtrArray, ByVal VarPtr(arr) + 8, 4End Function`