RotateBitmap – Rotate a 256-color bitmap by any angle

RotateBitmap – Rotate a 256-color bitmap by any angle

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

Share the Post:
XDR solutions

The Benefits of Using XDR Solutions

Cybercriminals constantly adapt their strategies, developing newer, more powerful, and intelligent ways to attack your network. Since security professionals must innovate as well, more conventional endpoint detection solutions have evolved

AI is revolutionizing fraud detection

How AI is Revolutionizing Fraud Detection

Artificial intelligence – commonly known as AI – means a form of technology with multiple uses. As a result, it has become extremely valuable to a number of businesses across

AI innovation

Companies Leading AI Innovation in 2023

Artificial intelligence (AI) has been transforming industries and revolutionizing business operations. AI’s potential to enhance efficiency and productivity has become crucial to many businesses. As we move into 2023, several

data fivetran pricing

Fivetran Pricing Explained

One of the biggest trends of the 21st century is the massive surge in analytics. Analytics is the process of utilizing data to drive future decision-making. With so much of

kubernetes logging

Kubernetes Logging: What You Need to Know

Kubernetes from Google is one of the most popular open-source and free container management solutions made to make managing and deploying applications easier. It has a solid architecture that makes

ransomware cyber attack

Why Is Ransomware Such a Major Threat?

One of the most significant cyber threats faced by modern organizations is a ransomware attack. Ransomware attacks have grown in both sophistication and frequency over the past few years, forcing

data dictionary

Tools You Need to Make a Data Dictionary

Data dictionaries are crucial for organizations of all sizes that deal with large amounts of data. they are centralized repositories of all the data in organizations, including metadata such as