Results 1 to 2 of 2

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

  1. #1

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,904

    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?
    Attached Images Attached Images  
    Last edited by joaquim; Nov 18th, 2020 at 04:01 PM.
    VB6 2D Sprite control

    To live is difficult, but we do it.

  2. #2

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,904

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

    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?
    VB6 2D Sprite control

    To live is difficult, but we do it.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width