Option Explicit' 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'' 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'        RotatePicture Picture1, Picture2, 50, 50, a'    NextSub RotatePicture(sourcePB As PictureBox, destPB As PictureBox, xc As Long, _    yc As Long, degrees As Single)    Const PI As Single = 3.141592653    Dim pict1() As Byte    Dim pict2() As Byte    Dim p1 As SafeArray2, p2 As SafeArray2    Dim bmp1 As BITMAP, bmp2 As BITMAP        Dim radians As Single    Dim angle As Single, angle0 As Single    Dim distance As Single    Dim deltaX As Long, deltaY As Long    Dim x As Long, y As Long    Dim x0 As Long, y0 As Long        ' 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 radians    radians = degrees / (180 / PI)        ' rotate the picture            For x = 0 To bmp1.bmWidth - 1        For y = 0 To bmp1.bmHeight - 1            deltaX = x - xc            deltaY = y - yc            If deltaX > 0 Then                angle = Atn(deltaY / deltaX)            ElseIf deltaX < 0 Then                angle = PI + Atn(deltaY / deltaX)            Else                If deltaY > 0 Then angle = PI / 2 Else angle = PI * 3 / 2            End If            angle0 = angle - radians            distance = Sqr(deltaX * deltaX + deltaY * deltaY)                        x0 = xc + distance * Cos(angle0)            y0 = yc + distance * Sin(angle0)                        If x0 >= 0 And x0 <= UBound(pict1, 1) And y0 >= 0 And y0 <= UBound _                (pict1, 2) Then                pict2(x, y) = pict1(x0, y0)            Else                pict2(x, y) = 0            End If                    Next    Next        ' release arrays    CopyMemory ByVal VarPtrArray(pict1), 0&, 4    CopyMemory ByVal VarPtrArray(pict2), 0&, 4        ' show the rotated bitmap    destPB.RefreshEnd Sub' Support routinePrivate Function VarPtrArray(arr As Variant) As Long    CopyMemory VarPtrArray, ByVal VarPtr(arr) + 8, 4End Function