VB6: how rotate an image 2D using 3D formulas?

using an image, we can rotate the pixel using 3D math:

Code:

---

'Module1:
Option Explicit


Type POINTL
    X As Long
    Y As Long
End Type

Public Enum GP_Result
    GP_OK = 0
    GP_GenericError = 1
    GP_InvalidParameter = 2
    GP_OutOfMemory = 3
    GP_ObjectBusy = 4
    GP_InsufficientBuffer = 5
    GP_NotImplemented = 6
    GP_Win32Error = 7
    GP_WrongState = 8
    GP_Aborted = 9
    GP_FileNotFound = 10
    GP_ValueOverflow = 11
    GP_AccessDenied = 12
    GP_UnknownImageFormat = 13
    GP_FontFamilyNotFound = 14
    GP_FontStyleNotFound = 15
    GP_NotTrueTypeFont = 16
    GP_UnsupportedGDIPlusVersion = 17
    GP_GDIPlusNotInitialized = 18
    GP_PropertyNotFound = 19
    GP_PropertyNotSupported = 20
End Enum

Public Type GDIPlusStartupInput
    GDIPlusVersion          As Long
    DebugEventCallback      As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs  As Long
End Type

Public Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GDIPlusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Public Declare Function GdipLoadImageFromFile Lib "GdiPlus.dll" (ByVal mFilename As Long, ByRef mImage As Long) As Long
Public Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long
Public Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, hGraphics As Long) As Long
Public Declare Function GdipDrawImage Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mImage As Long, ByVal mX As Single, ByVal mY As Single) As Long
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Public Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Public Declare Function GdipDrawImageI Lib "gdiplus" (ByVal dstGraphics As Long, ByVal srcImage As Long, ByVal X As Long, ByVal Y As Long) As GP_Result
Public Declare Function GdipCreateFromHWND Lib "gdiplus" (ByVal hwnd As Long, Graphics As Long) As GP_Result
Public Declare Function GdipGraphicsClear Lib "gdiplus" (ByVal Graphics As Long, ByVal lColor As Long) As Long
Public Declare Function GetActiveWindow Lib "user32" () As Long

Public Enum StretchBltModes
    [_SBMFAILED] = 0
    BLACKONWHITE = 1
    WHITEONBLACK = 2
    COLORONCOLOR = 3
    HALFTONE = 4
End Enum

Public Declare Function SetStretchBltMode Lib "gdi32" ( _
    ByVal hDC As Long, _
    ByVal StretchMode As StretchBltModes) As StretchBltModes

Public Declare Function StretchBlt Lib "gdi32" ( _
    ByVal hdcDest As Long, _
    ByVal nXOriginDest As Long, _
    ByVal nYOriginDest As Long, _
    ByVal nWidthDest As Long, _
    ByVal nHeightDest As Long, _
    ByVal hdcSrc As Long, _
    ByVal nXOriginSrc As Long, _
    ByVal nYOriginSrc As Long, _
    ByVal nWidthSrc As Long, _
    ByVal nHeightSrc As Long, _
    Optional ByVal dwRop As RasterOpConstants = vbSrcCopy) As Long

Public Declare Function TransparentBlt Lib "msimg32" ( _
    ByVal hdcDest As Long, _
    ByVal nXOriginDest As Long, _
    ByVal nYOriginDest As Long, _
    ByVal nWidthDest As Long, _
    ByVal hHeightDest As Long, _
    ByVal hdcSrc As Long, _
    ByVal nXOriginSrc As Long, _
    ByVal nYOriginSrc As Long, _
    ByVal nWidthSrc As Long, _
    ByVal nHeightSrc As Long, _
    ByVal crTransparent As Long) As Long
   
Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Declare Function PlgBlt Lib "gdi32" (ByVal hdcDest As Long, lpPoint As POINTAPI, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hbmMask As Long, ByVal xMask As Long, ByVal yMask As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long

Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (ptr() As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)

'Get Key state:
Public Const KEY_DOWN As Integer = &H8000
Public Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As KeyCodeConstants) As Integer

'GDIPlus:

Public Const ImageLockModeRead        As Long = &H1
Public Const ImageLockModeWrite        As Long = &H2
Public Const PixelFormat32bppARGB      As Long = &H26200A

Public Type BitmapData
    Width              As Long
    Height              As Long
    Stride              As Long
    PixelFormat        As Long
    Scan0              As Long
    Reserved            As Long
End Type

Public Declare Function GdipBitmapLockBits Lib "gdiplus" (ByVal hBitmap As Long, lpRect As Any, ByVal lFlags As Long, ByVal lPixelFormat As Long, uLockedBitmapData As BitmapData) As Long
Public Declare Function GdipBitmapUnlockBits Lib "gdiplus" (ByVal hBitmap As Long, uLockedBitmapData As BitmapData) As Long
Public Declare Function GdipBitmapGetPixel Lib "GdiPlus.dll" (ByVal bitmap As Long, ByVal X As Long, ByVal Y As Long, ByRef color As Long) As GpStatus
Public Declare Function GdipBitmapSetPixel Lib "gdiplus" (ByVal bitmap As Long, ByVal X As Long, ByVal Y As Long, ByVal color As Long) As GpStatus
Public Declare Function GdipGetImageHeight Lib "GdiPlus.dll" (ByVal Image As Long, Height As Long) As Long
Public Declare Function GdipGetImageWidth Lib "GdiPlus.dll" (ByVal Image As Long, Width As Long) As Long

'Draw array Vertices:


Public Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

'Faux "TrapezoidBlt" operation.
'
'Quick and dirty: Two PictureBox controls AutoRedraw = True to use their DCs.
'                Picture1 prefilled with a bitmap to blit.


   
Public Enum Coordenates
    None
    Z
    X
    Y
End Enum

Public Type Position3D
    X As Double
    Y As Double
    Z As Double
End Type

Public Type Angle3D
    X As Double
    Y As Double
    Z As Double
    RotationPosition3D As Position3D
End Type

Public Type Size3D
    Width As Double
    Height As Double
    ZDepth As Double
    distance As Double
End Type

Public Type Player
    Position As Position3D
    Movement As Position3D
    size As Size3D
    Angle As Angle3D
    MoveCoordenates As Coordenates
End Type

Public Type Camera
    Position As Position3D
    size As Size3D
End Type

Public Const Pi As Double = 3.14159265358979


Public Function ConvertDegreesToRadians(rotation As Angle3D) As Angle3D
    Dim deg2Rad As Double
    deg2Rad = Pi / 180
   
    ConvertDegreesToRadians.X = rotation.X * deg2Rad
    ConvertDegreesToRadians.Y = rotation.Y * deg2Rad
    ConvertDegreesToRadians.Z = rotation.Z * deg2Rad
End Function

Public Function Rotate(Position As Position3D, rotation As Angle3D) As Position3D
    Dim ConvertedPosition As Position3D
    Dim RotationInRads As Angle3D
   
    RotationInRads = ConvertDegreesToRadians(rotation)
    ConvertedPosition = Position
    ConvertedPosition.X = Position.X - rotation.RotationPosition3D.X
    ConvertedPosition.Y = Position.Y - rotation.RotationPosition3D.Y  'reversed because Y increments down
    ConvertedPosition.Z = Position.Z - rotation.RotationPosition3D.Z
    Dim T As Position3D
   
    'Z axis  (Roll)
    T = ConvertedPosition
        ConvertedPosition.X = T.X * Cos(RotationInRads.Z) - T.Y * Sin(RotationInRads.Z)
        ConvertedPosition.Y = T.X * Sin(RotationInRads.Z) + T.Y * Cos(RotationInRads.Z)
   
    'X axis  (Pitch)
    T = ConvertedPosition
        ConvertedPosition.Y = T.Y * Cos(RotationInRads.X) - T.Z * Sin(RotationInRads.X)
        ConvertedPosition.Z = T.Y * Sin(RotationInRads.X) + T.Z * Cos(RotationInRads.X)
 
    'Y axis  (Yaw)
    T = ConvertedPosition
        ConvertedPosition.X = T.Z * Sin(RotationInRads.Y) + T.X * Cos(RotationInRads.Y)
        ConvertedPosition.Z = T.Z * Cos(RotationInRads.Y) - T.X * Sin(RotationInRads.Y)
       
        'Go back to the new position:
        ConvertedPosition.X = ConvertedPosition.X + rotation.RotationPosition3D.X
        ConvertedPosition.Y = ConvertedPosition.Y + rotation.RotationPosition3D.Y
        ConvertedPosition.Z = ConvertedPosition.Z + rotation.RotationPosition3D.Z
       
    Rotate = ConvertedPosition
End Function


Public Function ConvertPositon3DTo2D(Position As Position3D, World3DSize As Size3D) As POINTAPI
   
    Dim ConvertedPosition As POINTAPI
    Dim PosZZDepth As Long
   
    Dim Width As Double
    Dim Height As Double
   
    'sum Z position with cam world distance:
    PosZZDepth = Position.Z + World3DSize.distance
    If (PosZZDepth = 0) Then PosZZDepth = 1 'avoiding division by zero
   
    'getting center of the screen center:
    If (World3DSize.Width = 0) Then World3DSize.Width = 1 'avoiding division by zero
    Width = World3DSize.Width / 2
    If (World3DSize.Height = 0) Then World3DSize.Height = 1 'avoiding division by zero
    Height = World3DSize.Height / 2
   
   
    'avoid drawing on back of the camera:
    If (PosZZDepth <= World3DSize.distance) Then
        PosZZDepth = 1
        'World3DSize.distance = 1
    End If
   
    'convert 3D(X, Y, Z) to 2D(X,Y):
    'ConvertedX = (ActualX * CamDistance /(CamDistance + ZPosition)) + HalfCenterOfWidth
    'ConvertedY = (ActualY * CamDistance /(CamDistance + ZPosition)) + HalfCenterOfHeight
    ConvertedPosition.X = (Position.X * World3DSize.distance / PosZZDepth) + Width
    ConvertedPosition.Y = (Position.Y * World3DSize.distance / PosZZDepth) + Height
   
    ConvertPositon3DTo2D = ConvertedPosition
End Function

---

how i rotate the image using 3D Math:

Code:

---

'Rotate an image:
Public Sub RotationImage(ByRef HDCDestination As Long, ByRef HDCSource As Long, ByVal AngleX As Double, ByVal AngleY As Double, ByVal AngleZ As Double, ByVal ImageWidth As Double, ByVal ImageHeight As Double)
    Dim X As Double, Y As Double, Z As Double
    Dim PosX As Double, PosY As Double
    Dim tmpColor As Long
    Dim pos As Position3D
    Dim ang As Angle3D
   
    Dim worldsize As Size3D
   
    ang.X = AngleX
    ang.Y = AngleY
    ang.Z = AngleZ
    ang.RotationPosition3D.X = ImageWidth / 2
    ang.RotationPosition3D.Y = ImageHeight / 2
    ang.RotationPosition3D.Z = 500
    worldsize.distance = 100
    worldsize.Height = ImageHeight
    worldsize.Width = ImageWidth
    worldsize.ZDepth = 10
    Dim apipos As POINTAPI
    'run a loop through the picture to change every pixel
    For PosX = 0 To ImageWidth - 1
        For PosY = 0 To ImageHeight - 1
            pos.X = PosX
            pos.Y = PosY
            'Get the color (using GetPixel):
            tmpColor = GetPixel(HDCSource, pos.X, pos.Y)
            If (tmpColor = CLR_INVALID) Then Exit For
            pos = Rotate(pos, ang)
            apipos = ConvertPositon3DTo2D(pos, worldsize)
            'Now set that data using the SetPixelV command
            If (SetPixelV(HDCDestination, apipos.X, apipos.Y, tmpColor) = CLR_INVALID) Then Exit For
           
        Next PosY
    Next PosX
End Sub

---

how i use it:

Code:

---

RotationImage Me.hDC, Picture1.hDC, 0, 0, RotationY.Value, Picture1.Width, Picture1.Height

---

the image isn't drawed... only on C\C++ compiler :(
what i'm doing wrong for the image isn't drawed?

that's impossible rotate an image correctly.
so i had learned another way.
we can get the line points:

Code:

---

'if the line don't use Z, the Z value must be zero
Public Function GetLinePoints(ByRef Origin As Position3D, ByRef Destiny As Position3D) As Position3D()
    Dim Steps As Double
    Dim Points() As Position3D
   
    Steps = Math.Sqr(Math.Abs(Destiny.X - Origin.X) ^ 2 + Math.Abs(Destiny.Y - Origin.Y) ^ 2 + Math.Abs(Destiny.Z - Origin.Z) ^ 2)
    Steps = Ceil(Steps)
   
    Dim increment As Position3D
    If (Steps = 0) Then Steps = 1
    increment.X = (Destiny.X - Origin.X) / Steps
    increment.Y = (Destiny.Y - Origin.Y) / Steps
    increment.Z = (Destiny.Z - Origin.Z) / Steps
   
    Dim nextpoint As Position3D
    nextpoint = Origin
    Dim i As Integer
   
    Dim inter As Position3D
    Dim size As Size3D
    ReDim Points(Steps)
    For i = 1 To Steps
        nextpoint.X = nextpoint.X + increment.X
        nextpoint.Y = nextpoint.Y + increment.Y
        nextpoint.Z = nextpoint.Z + increment.Z
        inter.X = Math.Round(nextpoint.X)
        inter.Y = Math.Round(nextpoint.Y)
        inter.Z = Math.Round(nextpoint.Z)
        Points(i).X = inter.X
        Points(i).Y = inter.Y
        Points(i).Z = inter.Z
        'Debug.Print "X: " + CStr(inter.X) + vbTab + "Y: " + CStr(inter.Y) + vbTab + "Z: " + CStr(inter.Z)
    Next i
    GetLinePoints = Points
End Function

---

if we use 2 vertical lines and get their points, we can get the horizontal line points for we draw pixels from the image.
these is the best choice that i had learned.
#passel just for finish the function for get the right results: how can i convert ARGB to RGB?