' 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 < bmp2.bmWidth  2 Then        xStart = xc        xEnd = bmp2.bmWidth - 1    Else        xStart = 0        xEnd = xc    End If    If yc < bmp2.bmHeight  2 Then        yStart = yc        yEnd = bmp2.bmWidth - 1    Else        yStart = 0        yEnd = yc    End If        ' 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 < deltaX Then                        angle = atnTable((deltaY * 10000)  deltaX)                    Else                        angle = HALFPI - atnTable(deltaX10000  deltaY)                    End If                Else                    If -deltaY < deltaX Then                        angle = -atnTable((deltaY * -10000)  deltaX)                    Else                        angle = -HALFPI + atnTable(-deltaX10000  deltaY)                    End If                End If            ElseIf deltaX < 0 Then                If deltaY > 0 Then                    If deltaY < -deltaX Then                        angle = PI - atnTable((deltaY * -10000)  deltaX)                    Else                        angle = HALFPI + atnTable(-deltaX10000  deltaY)                    End If                Else                    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 <= SQRTABLE_MAX Then                distance = sqrTable(distanceSquared)            Else                distance = Sqr(distanceSquared)            End If                        ' 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 < bmWidth1 And y >= 0 And y < bmHeight1 Then                ' (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 < bmWidth1 And y0 >= 0 And y0 < bmHeight1 Then                    pict2(x, y) = pict1(x0, y0)                Else                    pict2(x, y) = 0                End If                            ' 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 < bmWidth1 And yy >= 0 And yy < bmHeight1 Then                    x0 = xc - dx                    y0 = yc - dy                    If x0 >= 0 And x0 < bmWidth1 And y0 >= 0 And y0 < bmHeight1 _                        Then                        pict2(xx, yy) = pict1(x0, y0)                    Else                        pict2(xx, yy) = 0                    End If                End If                        End If                        ' now deal with the pixel 90° ahead of the one in (x,y)            xx = xc + deltaY            yy = yc - deltaX            If xx >= 0 And xx < bmWidth1 And yy >= 0 And yy < bmHeight1 Then                x0 = xc + dy                y0 = yc - dx                If x0 >= 0 And x0 < bmWidth1 And y0 >= 0 And y0 < bmHeight1 Then                    pict2(xx, yy) = pict1(x0, y0)                Else                    pict2(xx, yy) = 0                End If            End If            ' now deal with the pixel 270° ahead of the one in (x,y)            xx = xc - deltaY            yy = yc + deltaX            If xx >= 0 And xx < bmWidth1 And yy >= 0 And yy < bmHeight1 Then                x0 = xc - dy                y0 = yc + dx                If x0 >= 0 And x0 < bmWidth1 And y0 >= 0 And y0 < bmHeight1 Then                    pict2(xx, yy) = pict1(x0, y0)                Else                    pict2(xx, yy) = 0                End If            End If        Next    Next        ' 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