Author: Joaquim_5

how can i read a file to StdPicture?
and draw it on memory HDC?

Public Sub LoadImage(strPath As String)
    Dim myPic As New StdPicture
    Set myPic = LoadPicture(strPath)

    NewImage myPic.Width, myPic.Height
    BitBlt MemoryHDC, 0, 0, Width, Height, myPic.Handle, 0, 0, SRCCOPY 'i get only a black background color
End Sub

i use the RtlFillMemory():

Call RtlFillMemory(ByVal DataPtr, DIBInf.bmiHeader.biSizeImage, &H80)

the '&H80' is the mid-grey color.... what are the others colors code?

with CreateDIBSection() we create an array of DIB's pixels .. but it's a copy and not a pointer :(
when i change 1 pixel or draw a rectangle, i must re-create the DIB's and then draw the result.

Private bmpPtr() As Long
ReDim bmpPtr(ImageWidth * ImageHeight - 1)
  hBitmap = CreateDIBSection(hdc, bmpInfoHeader, BI_RGB, ByVal bmpPtr, 0, 0)

but when i do:

bmpPtr(PosY * Width + PosX) = color

the value is changed on 'bmpPtr' but not on Bitmap or HDC :(

on VB6 i have these code for create a memory DC:

Public Sub CreateMemoryBitmap(ByVal Width As Long, ByVal _
    Height As Long)

    If (ImageWidth > 0 Or ImageHeight > 0) Then DeleteMemoryBitmap
    ImageWidth = Width
    ImageHeight = Height
    ' Create the device context.

    hdc = CreateCompatibleDC(ByVal 0&)
    If (hdc = 0) Then Debug.Print "no HDC"

    ' Create the bitmap.
    HBitmap = CreateCompatibleBitmap(hdc, ImageWidth, _
        ImageHeight)
    If (HBitmap = 0) Then Debug.Print "no HBITMAP"
    ' Make the device context use the bitmap.
    OldHDC = SelectObject(hdc, HBitmap)
    DrawLine 0, 0, 100, 100, vbBlack

End Sub

i test if the hdc is created, but no error.. but i get bad results.. i belive the DC\HBitmap are created incorrectly :(

i can create a DDA algoritm.. but pixel a pixel.
so what is the best speed for it?

IncrementPixel = 2
    For RayAngle = StartAngle To EndAngle Step IncrementAngle
        Distance = 0
        Wall = 0
        RayActualX = RayX
        RayActualY = RayY
        IncrementStepSin = Sin(RayAngle) * IncrementPixel
        IncrementStepCos = Cos(RayAngle) * IncrementPixel
        Do While (Wall = 0)
            Wall = LevelMap(Floor(RayActualY / MapResolution))(Floor(RayActualX / MapResolution))
            If Wall <> 0 Then Exit Do
            RayActualX = RayActualX + IncrementStepCos
            RayActualY = RayActualY + IncrementStepSin
            Distance = Distance + IncrementPixel
        Loop

        ' Cast a ray from the player's position at this angle
        ' Check for collision with any walls
        ' Calculate the distance to the collision point
        ' Draw the wall section on the screen using the distance for perspective
        DrawLine CLng(RayX), CLng(RayY), CLng(RayActualX), CLng(RayActualY), vbCyan
        'Me.Line (CLng(RayX), CLng(RayY))-(CLng(RayActualX), CLng(RayActualY)), vbCyan
    Next RayAngle

these code ins't 100% completed, but what i need is just understand how can i speed up my calculations and win more speed.

VB6 : is possible convert radians to pixels?
the WindowViewe is 200 pixels.
so i need draw 200 lines between PlayerAngle(100 pixels) to 200. but how can i convert pixels to Radians... the PlayerAngle is the 100 pixel(the half of WindowViewe)

Private Sub rayCasting()
    Dim rayAngle As Double
    Dim IncreRayAngle As Double
    Dim RayX As Double
    Dim RayY As Double
    Dim rayCos As Double
    Dim raySin As Double

    'CamWidth is the viewe width... 
    IncreRayAngle = DegreeToRadians(PlayerFOV) / CamWidth 'getting the angle step

    'getting the player position to ray origin:
    RayX = PlayerX * MapResolution 
    RayY = PlayerY * MapResolution

    For rayAngle = PlayerAngle To 2 Step IncreRayAngle
        'draw the line with 50 of lenght thinking on it's angle:
        DrawLine Floor(RayX), Floor(RayY), Floor(RayX + Cos(rayAngle) * 50), Floor(RayY + Sin(rayAngle) * 50), vbRed
    Next rayAngle
End Sub

i did these code for create RayCasting:

Option Explicit

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Private Const PI As Double = 3.14159265358979

Dim LevelMap(12) As Variant
Dim CamWidth As Long
Dim CamHeight As Long
Dim CamHalfHeight As Long
Dim RayCastingPrecision As Long
Dim PlayerX As Double
Dim PlayerY As Double
Dim PlayerAngle As Long
Dim PlayerFOV As Long
Dim PlayerMovement As Double
Dim PlayerRotation As Double

Dim blnGameLoop As Boolean
Dim colors(3) As ColorConstants

Public Function Floor(ByVal x As Double) As Long
    Floor = (-Int(x) * (-1))
End Function

Private Function DegreeToRadians(degree As Long) As Double
    DegreeToRadians = degree * PI / 180
End Function

Private Sub DrawLine(X0 As Long, Y0 As Long, X1 As Long, Y1 As Long, Color As ColorConstants)
    Me.Line (X0, Y0)-(X1, Y1), Color
End Sub

Private Sub rayCasting()
    ' O RayAngle  o angulo atual do "raio".
    ' se ele comea olhando para angulo 90 e tem fov 60, ento o rayAngle vai de 60 at 120, sendo incrementado por fov/width
    Dim rayAngle As Long
    rayAngle = PlayerAngle - PlayerFOV / 2
    ' Para Cada coluna da tela
    Dim raycount As Long
    For raycount = 0 To CamWidth
        ' Player dados
        Dim RayX As Double
        Dim RayY As Double
        RayX = PlayerX
        RayY = PlayerY


        ' Com cosseno e seno do angulo conseguimos a direo do raio sobre o grid a partir do ponto de viso.
        ' Aqui teremos a direo do raio sobre a matriz e tambm o modulo (passo)
        Dim rayCos As Double
        Dim raySin As Double
        rayCos = Cos(DegreeToRadians(rayAngle)) / RayCastingPrecision
        raySin = Sin(DegreeToRadians(rayAngle)) / RayCastingPrecision

        ' Coliso do raio com as paredes
        Dim Wall As Long
        Wall = 0
        While (Wall = 0) ' Aqui o "raio" seria tipo uma progetil que sai do personagem at colidir com uma parede

            RayX = RayX + rayCos ' novo x do raio
            RayY = RayY + raySin ' novo y do raio
            Wall = LevelMap(Floor(RayY))(Floor(RayX)) ' verifica coliso com a parede (no nulo na matriz)
        Wend

        ' Distancia at a parede (teorema de pitagoras), uma vez que temos o (X,Y) do personagem e da parede
        Dim distance As Double
        distance = Sqr((PlayerX - RayX) ^ 2 + (PlayerY - RayY) ^ 2)

        ' Correo olho de peixe (sem coliso com a parede), melhora a vista em corredores ou proximo de paredes
        distance = distance * Cos(DegreeToRadians(rayAngle - PlayerAngle))

        'Altura da parede em consequncia a distancia
        'quando mais longe a parede est menor ela  e vice versa, so inversamente proporcionais
        Dim WallHeight As Long
        WallHeight = Floor(CamHalfHeight / distance)
        If (WallHeight > CamHalfHeight) Then WallHeight = CamHalfHeight


         'Desenhando as paredes usando os tamanhos calculados acima
        DrawLine raycount, 0, raycount, CamHalfHeight - WallHeight, ColorConstants.vbCyan 'cu
        If (Wall > 0) Then
            DrawLine raycount, CamHalfHeight - WallHeight, raycount, CamHalfHeight + WallHeight, colors(Wall) ' Parede
        End If
        DrawLine raycount, CamHalfHeight + WallHeight, raycount, CamHeight, vbMagenta ' cho
        Wall = 0
        ' Incremento da ray
        rayAngle = rayAngle + PlayerFOV / CamWidth
    Next raycount
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim playerCos As Double
    Dim playerSin As Double
    Dim newX As Double
    Dim newY As Double
    If (KeyCode = vbKeyEscape) Then
        blnGameLoop = False
        End
    ElseIf (KeyCode = vbKeyUp) Then

        playerCos = Cos(DegreeToRadians(PlayerAngle)) * PlayerMovement
        playerSin = Sin(DegreeToRadians(PlayerAngle)) * PlayerMovement
        newX = PlayerX + playerCos
        newY = PlayerY + playerSin

        ' Verficia coliso do player
        If (LevelMap(Floor(newY))(Floor(newX)) = 0) Then
            PlayerX = newX
            PlayerY = newY
        End If
    ElseIf (KeyCode = vbKeyDown) Then


        playerCos = Cos(DegreeToRadians(PlayerAngle)) * PlayerMovement
        playerSin = Sin(DegreeToRadians(PlayerAngle)) * PlayerMovement
        newX = PlayerX - playerCos
        newY = PlayerY - playerSin

        ' Verficia coliso do player
        If (LevelMap(Floor(newY))(Floor(newX)) = 0) Then
            PlayerX = newX
            PlayerY = newY
        End If
    ElseIf (KeyCode = vbKeyLeft) Then
        PlayerAngle = PlayerAngle - PlayerRotation
    ElseIf (KeyCode = vbKeyRight) Then
        PlayerAngle = PlayerAngle + PlayerRotation
    End If
End Sub

Private Sub Form_Load()
    CamWidth = 1028
    CamHeight = 720
    CamHalfHeight = CInt(CamHeight / 2)
    RayCastingPrecision = 100
    PlayerX = 2
    PlayerY = 3
    PlayerAngle = 0
    PlayerFOV = 60
    PlayerMovement = 0.1
    PlayerRotation = 0.8
    Me.Show
    LevelMap(0) = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    LevelMap(1) = Array(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
    LevelMap(2) = Array(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
    LevelMap(3) = Array(1, 0, 0, 0, 0, 0, 3, 3, 3, 0, 0, 0, 0, 0, 1)
    LevelMap(4) = Array(1, 0, 0, 0, 0, 0, 3, 3, 3, 0, 0, 0, 0, 0, 1)
    LevelMap(5) = Array(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
    LevelMap(6) = Array(1, 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 1)
    LevelMap(7) = Array(1, 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 1)
    LevelMap(8) = Array(1, 0, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 1)
    LevelMap(9) = Array(1, 0, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 1)
    LevelMap(10) = Array(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
    LevelMap(11) = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    blnGameLoop = True

    colors(0) = vbBlue
    colors(1) = vbGreen
    colors(2) = vbRed

    While (blnGameLoop = True)
        Me.Cls
        rayCasting
        blnGameLoop = True
        DoEvents
    Wend
End Sub

Private Sub Form_Unload(Cancel As Integer)
    blnGameLoop = False
End Sub

my problem is on these code:

 'Desenhando as paredes usando os tamanhos calculados acima
        DrawLine raycount, 0, raycount, CamHalfHeight - WallHeight, ColorConstants.vbCyan 'Sky
        If (Wall > 0) Then
            DrawLine raycount, CamHalfHeight - WallHeight, raycount, CamHalfHeight + WallHeight, colors(Wall) ' Wall
        End If
        DrawLine raycount, CamHalfHeight + WallHeight, raycount, CamHeight, vbMagenta ' floor
        Wall = 0

all vertical wall lines drawed have the same color even some are different color... i don't understand why :(