Ir ao conteúdo
  • Cadastre-se

Cambalinho

Membro Pleno
  • Posts

    941
  • Cadastrado em

  • Última visita

Tudo que Cambalinho postou

  1. ainda bem que testou o código.. tenho 1DLL criada no VB6, com funções API, e consigo o dobro mas penso conseguir mais desempenho(sempre que altero o Forecolor e FillColor, o brush e a pen são recriados e selecionados... estou a pensar mudar isso e usar variáveis para pen e brush... assim só crio 1 vez.. apenas estou confuso devido ao brush\pen de origem ou anterior... deveria o guardar ou ignorar?) agora tenho outro problema, por isso ontem criei o topico... queria resolver 1 bug gráfico
  2. em Visual Basic 2010, tenho esta função para fazer o RayCasting: Function GetPositionMap(ByVal valor As Double) As Integer If valor < 0 Then GetPositionMap = 0 ElseIf valor > MapWidth Then GetPositionMap = 9 Else GetPositionMap = valor \ ObjectSize 'square size End If End Function Private Sub DrawRays() Dim StepX As Double Dim StepY As Double Dim VertX As Double Dim VertY As Double Dim HorizX As Double Dim HorizY As Double Dim MapX As Long Dim MapY As Long Dim HorizDist As Double Dim VertDist As Double Dim WallDistance As Double Dim RayHeight As Double Dim RayRadians As Double Dim RadiansSteps As Double Dim RayCount As Long Dim RayCounts As Long Dim OffSetGrid As Long RayCount = imgverticalline.Width MapX = Player.MapX MapY = Player.MapY RadiansSteps = Radian60 / RayCount RayRadians = (Player.Radians - Radian30) RayCounts = 0 img.ForeColor(RGB(255, 0, 0)) Do While RayCounts < RayCount If (RayRadians > Radian360) Then RayRadians = 0.001 'Check for horizontal intersections: If RayRadians >= 0 And RayRadians <= Math.PI Then 'Facing down HorizY = (Fix(player.PosY / ObjectSize) * ObjectSize) + ObjectSize ' Calculate grid position HorizX = player.PosX + (HorizY - player.PosY) / Math.Tan(RayRadians) StepY = ObjectSize ElseIf RayRadians = 0 Or RayRadians = Math.PI Then HorizY = player.PosY HorizX = player.PosX Else 'Facing Up HorizY = (Fix(player.PosY / ObjectSize) * ObjectSize) - 1 HorizX = player.PosX + (HorizY - player.PosY) / Math.Tan(RayRadians) StepY = -ObjectSize End If StepX = StepY / Math.Tan(RayRadians) MapX = GetPositionMap(HorizX) MapY = GetPositionMap(HorizY) Do If MapX < 0 Or MapX > 9 Or MapY < 0 Or MapY > 9 Then Exit Do If levelmap0(MapY, MapX) = Color.Black Then Exit Do HorizX = HorizX + StepX HorizY = HorizY + StepY MapX = HorizX \ ObjectSize MapY = HorizY \ ObjectSize Loop HorizDist = Math.Abs((player.PosX - HorizX) / Math.Cos(RayRadians)) 'Check for vertical intersections: If RayRadians < Radian90 Or RayRadians > Radian270 Then 'Facing right VertX = (Fix(Player.PosX / ObjectSize) * ObjectSize) + ObjectSize ' Calculate grid position VertY = player.PosY + (player.PosX - VertX) * -Math.Tan(RayRadians) StepX = ObjectSize ElseIf RayRadians = Radian90 Or RayRadians = Radian270 Then VertY = Player.PosY VertX = Player.PosX Else 'Facing left VertX = (Fix(Player.PosX / ObjectSize) * ObjectSize) - 1 VertY = player.PosY + (player.PosX - VertX) * -Math.Tan(RayRadians) StepX = -ObjectSize End If StepY = StepX * Math.Tan(RayRadians) MapX = GetPositionMap(VertX) MapY = GetPositionMap(VertY) Do If MapX < 0 Or MapX > 9 Or MapY < 0 Or MapY > 9 Then Exit Do If levelmap0(MapY, MapX) = Color.Black Then Exit Do VertX = VertX + StepX VertY = VertY + StepY MapX = VertX \ ObjectSize MapY = VertY \ ObjectSize Loop VertDist = Math.Abs((player.PosX - VertX) / Math.Cos(RayRadians)) Dim VertColor As Color If VertDist < HorizDist Then WallDistance = VertDist OffSetGrid = VertY Mod ObjectSize VertColor = Color.Blue Else OffSetGrid = HorizX Mod ObjectSize WallDistance = HorizDist VertColor = Color.DarkBlue End If WallDistance = WallDistance * Math.Cos(RayRadians - player.Radians) 'avoiding the Fish Effect RayHeight = (ObjectSize / WallDistance) * 200 ' is the height screen\ 'If (OffSetGrid < 0 Or OffSetGrid >= picWall1.Width) Then OffSetGrid = 0 'picWall1.DrawTextureVerticalLine(img.MemoryHDC, OffSetGrid, Fix(RayHeight * 4), RayCounts, 5) imgverticalline.ForeColor(RGB(VertColor.R, VertColor.G, VertColor.B)) imgverticalline.DrawLine(RayCounts, imgverticalline.Height / 2 - RayHeight \ 2, RayCounts, imgverticalline.Height / 2 + RayHeight \ 2) RayRadians = RayRadians + RadiansSteps RayCounts = RayCounts + 1 Loop End Sub eis o resultado: sim ainda não estou a usar textura, porque quero resolver esse bug gráfico: na parede da esquerda(azul escuro) temos 1 linha vertical(azul claro) de 32 em 32(o tamanho de 1 parte da parede).... nem sei onde escontrar e corrigir este bug gráfico... alguém me pode auxiliar? PS: eu ainda não avaliei o tempo exato, mas gostava de perguntar: cada vez que limpo a imagem, crio 1 brush e seleciono, e sempre que desenho 1 linha\figura, crio e seleciono 1 pen.... se criar os brush's e as pen's e só as selecionar, quando preciso, ganho tempo?(falando em ciclos\loops) se sim, como posso guardar e usar a pen\brush antiga ou a posso ignorar?(sim ainda estou a pensar antes deste grande update)
  3. em VB2010, como posso fazer 1 game loop e timers com precisão? o máximo que consigo é 100FPS e só desenhar 2 circulos preenchido com 1 cor Public Class Form1 Dim blnGameloop As Boolean = True Dim FrameCount As Integer Dim FPS As Integer Dim result As New Bitmap(900, 500) Dim gresult As Graphics = Graphics.FromImage(result) Dim g As Graphics Dim tmr As Integer Dim PosX As Integer Dim PosY As Integer Private Sub ClearMemory() blnGameloop = False result.Dispose() g.Dispose() gresult.Dispose() End End Sub Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed ClearMemory() End Sub Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown If (e.KeyCode = Keys.Escape) Then ClearMemory() ElseIf (e.KeyCode = Keys.Up) Then PosY -= 1 ElseIf (e.KeyCode = Keys.Down) Then PosY += 1 ElseIf (e.KeyCode = Keys.Left) Then PosX -= 1 ElseIf (e.KeyCode = Keys.Right) Then PosX += 1 End If End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.Show() Me.Focus() tmr = TimeOfDay.Second Do Application.DoEvents() g = Me.CreateGraphics gresult.FillRectangle(Brushes.Blue, 0, 0, Me.Width, Me.Height) gresult.FillEllipse(Brushes.Aqua, PosX, PosY, 100, 100) gresult.FillEllipse(Brushes.Brown, PosX + 50, PosY + 50, 100, 100) gresult.DrawString("FPS: " & CStr(FPS), Me.Font, Brushes.Black, 10, 10) g.DrawImage(result, 0, 0) FrameCount += 1 If (tmr <> TimeOfDay.Second) Then FPS = FrameCount FrameCount = 0 tmr = TimeOfDay.Second End If Loop While (blnGameloop = True) End Sub End Class parecem 2 tópicos, mas 1 depende do outro
  4. basicamente é multiplicar por -1, a velocidade muito obrigado
  5. sabendo que a bola: - direção é 45º; - velocidade é 1... como se calcula a direção da bola, após 1 colisão? (se existem mais parâmetros, me corrigem) 'sem código
  6. ok. muito obrigado por tudo... este caso me fez pensar o que posso adicionar na minha linguagem muito obrigado
  7. eis o código para desenhar 1 linha: WallDistance = WallDistance * Cos(RayRadians - Player.Radians) 'avoiding the Fish Effect RayHeight = (ObjectSize / WallDistance) * 200 ' is the height screen\ a.drawline(x0,y0,x1,y1) A.DrawLine 475 + 50 + RayCounts, 200 / 2 - RayHeight / 2, 475 + 50 + RayCounts, 200 / 2 + RayHeight / 2 a linha vertical aparece sem problemas... agora queria mostrar com textura: 'obter o a linha mais curta(horizontal ou vertical): If VertDist < HorizDist Then ' Draw the vertical ray: A.DrawLine Fix(Player.PosX), Fix(Player.PosY), Fix(VertX), Fix(VertY) WallDistance = VertDist GridX = VertX Mod ObjectSize GridY = VertY Mod ObjectSize Else ' Draw the horizontal ray: A.DrawLine Fix(Player.PosX), Fix(Player.PosY), Fix(HorizX), Fix(HorizY) WallDistance = HorizDist GridX = HorizX Mod ObjectSize GridY = HorizY Mod ObjectSize End If 'Debug.Print GridX & " " & GridY WallDistance = WallDistance * Cos(RayRadians - Player.Radians) 'avoiding the Fish Effect RayHeight = (ObjectSize / WallDistance) * 200 ' is the height screen\ 'a.drawline(x0,y0,x1,y1) A.DrawLine 475 + 50 + RayCounts, 200 / 2 - RayHeight / 2, 475 + 50 + RayCounts, 200 / 2 + RayHeight / 2 If (GridX = 0) Then StretchBlt A.MemoryHDC, 475 + 50 + RayCounts, 200 / 2 - RayHeight / 2, 475 + 50 + RayCounts, 200 / 2 + RayHeight / 2, picWall1.hdc, 0, GridY, 1, picWall1.Height, SRCCOPY Else StretchBlt A.MemoryHDC, 475 + 50 + RayCounts, 200 / 2 - RayHeight / 2, 475 + 50 + RayCounts, 200 / 2 + RayHeight / 2, picWall1.hdc, GridX, 0, picWall1.Width, 1, SRCCOPY End If mas não desenha nada de jeito os calculos podem estar errados sem me aparecer: onde errei para obter a linha da imagem?
  8. do estilo 'pre-processor' do C.... converter 'AndAlso' a 'then if'
  9. esse teste simples pode usar 'and'? (só para dizer que os valores de X e Y ficam entre zero e 100) exemplo: If (X >=0 and x<=100) Then If (Y >= 0 and Y<=100) Then if(array(y,x)=10) then msgbox "the number is 10" este exemplo é válido?
  10. muito obrigado não se pode usar 1 operador similar ao 'AndAlso' e 'OrAlso', como o .NET?
  11. veja este 'if': If ((MapX <= 9 Or MapX >= 0 Or MapY <= 9 Or MapY >= 0) Or (LevelMap0(MapY, MapX) <> vbBlue)) Then o objetivo é evitar que o 'MapX' e 'MapY' sejam inferiores a zero e superiores a 9.... e depois verificar no array LevelMap0() seja 'Blue'... eu uso o 'on Error Resume Next', mas quero evitar isso.... o que tenho de errado neste 'if'? parece simples, mas estava-me a fazer muita confusão, porque obtenho 1 erro de index do array("out of range")
  12. vejam este print errado eis o código actual: Private Sub DrawRays2() Dim AY As Double Dim AX As Double Dim StepX As Double Dim StepY As Double Dim VertX As Double Dim VertY As Double Dim HorizX As Double Dim HorizY As Double Dim MapX As Long Dim MapY As Long Dim HorizDist As Double Dim VertDist As Double Dim WallDistance As Double Dim RayHeight As Double MapX = Player.MapX MapY = Player.MapY On Error Resume Next ' 'Check for horizontal intersections: If ((Player.Radians > 0 And Player.Radians < PI)) Then 'Facing down AY = (Int(Player.PosY / ObjectSize) * ObjectSize) + ObjectSize ' Calculate grid position AX = Player.PosX + (AY - Player.PosY) / Tan(Player.Radians) StepY = ObjectSize ElseIf ((Player.Radians = 0 And Player.Radians = PI)) Then AY = Player.PosY AX = Player.PosX Else 'Facing Up AY = (Int(Player.PosY / ObjectSize) * ObjectSize) - 1 AX = Player.PosX + (AY - Player.PosY) / Tan(Player.Radians) StepY = -ObjectSize End If HorizX = AX HorizY = AY StepX = StepY / Tan(Player.Radians) MapX = Fix((HorizX) / ObjectSize) MapY = Fix((HorizY) / ObjectSize) A.SetPixel (Fix(HorizX)), (Fix(HorizY)), ColorConstants.vbCyan If LevelMap0(MapY, MapX) <> vbBlue Then Do HorizX = HorizX + StepX HorizY = HorizY + StepY MapX = Fix((HorizX) / ObjectSize) MapY = Fix((HorizY) / ObjectSize) A.SetPixel (Fix(HorizX)), (Fix(HorizY)), ColorConstants.vbCyan If LevelMap0(MapY, MapX) = vbBlue Then Exit Do End If DoEvents Loop End If HorizDist = Sqr(((HorizX - Player.PosX) * (HorizX - Player.PosX)) + ((HorizY - Player.PosY) * (HorizY - Player.PosY))) 'Check for vertical intersections: If ((Player.Radians < PI / 2 Or Player.Radians > 3 * PI / 2)) Then 'Facing right AX = (Int(Player.PosX / ObjectSize) * ObjectSize) + ObjectSize ' Calculate grid position AY = Player.PosY + (Player.PosX - AX) * -Tan(Player.Radians) StepX = ObjectSize ElseIf ((Player.Radians = PI / 2 Or Player.Radians = 3 * PI / 2)) Then AY = Player.PosY AX = Player.PosX Else 'Facing left AX = (Int(Player.PosX / ObjectSize) * ObjectSize) - 1 AY = Player.PosY + (Player.PosX - AX) * -Tan(Player.Radians) StepX = -ObjectSize End If VertX = AX VertY = AY StepY = StepX * Tan(Player.Radians) MapX = Fix((VertX) / ObjectSize) MapY = Fix((VertY) / ObjectSize) A.SetPixel (Fix(VertX)), (Fix(VertY)), vbYellow If LevelMap0(MapY, MapX) <> vbBlue Then Do VertX = VertX + StepX VertY = VertY + StepY MapX = Fix((VertX) / ObjectSize) MapY = Fix((VertY) / ObjectSize) A.SetPixel (Fix(VertX)), (Fix(VertY)), vbYellow If LevelMap0(MapY, MapX) = vbBlue Then Exit Do End If DoEvents Loop End If VertDist = Sqr(((VertX - Player.PosX)) * ((VertX - Player.PosX))) + (((VertY - Player.PosY)) * ((VertY - Player.PosY))) A.ForeColor vbRed 'obter o a linha mais curta(horizontal ou vertical): If VertDist < HorizDist Then ' Draw the vertical ray: A.DrawLine Fix(Player.PosX), Fix(Player.PosY), Fix(VertX), Fix(VertY) WallDistance = VertDist Debug.Print VertDist & vbTab & "Draw Vertical" & vbTab & HorizDist & vbTab & "Horizontal line" Else ' Draw the horzontal ray: A.DrawLine Fix(Player.PosX), Fix(Player.PosY), Fix(HorizX), Fix(HorizY) WallDistance = HorizDist Debug.Print HorizDist & vbTab & " Draw Horizontal" & vbTab & VertDist & vbTab & "vertical line" End If WallDistance = WallDistance * Cos(Player.Radians) RayHeight = ObjectSize / WallDistance * 320 A.ForeColor vbBlue A.DrawLine 475 + 50, 200 / 2 - RayHeight / 2, 475 + 50, 200 / 2 + RayHeight / 2 End Sub printed:"334,308881610545 Draw Horizontal 1816,56277706662 vertical line" porque a linha vertical é 1816? se o limite é 9*33= 297 e sim noto mais bugs, mas tudo na interceção vertical PS: o numero de frames é aproximadamente 1500.... mas o 'Debug.Print' usa imensos recursos... mas é para testar os valores, nada mais
  13. tenho esta função para fazer o RayCasting usando a Trignometria(estou a testar os pontos Horizontais: Private Sub DrawRays2() Dim AY As Double Dim AX As Double Dim StepX As Double Dim StepY As Double Dim VertX As Double Dim VertY As Double Dim HorizX As Double Dim HorizY As Double Dim MapX As Long Dim MapY As Long Dim HorizDist As Double Dim VertDist As Double Dim WallDistance As Double Dim RayHeight As Double MapX = Player.MapX MapY = Player.MapY On Error Resume Next 'Check for horizontal intersections: If ((Player.Radians >= 0 And Player.Radians <= PI)) Then 'Facing down AY = (Int(Player.PosY / ObjectSize) * ObjectSize) + ObjectSize ' Calculate grid position StepY = ObjectSize Else 'Facing Up AY = (Int(Player.PosY / ObjectSize) * ObjectSize) - 1 StepY = -ObjectSize End If AX = Player.PosX + (AY - Player.PosY) / Tan(Player.Radians) HorizX = AX HorizY = AY StepX = StepY / Tan(Player.Radians) MapX = Fix((HorizX) / ObjectSize) MapY = Fix((HorizY) / ObjectSize) A.SetPixel (Fix(HorizX)), (Fix(HorizY)), ColorConstants.vbCyan Do HorizX = HorizX + StepX HorizY = HorizY + StepY MapX = Fix((HorizX + 1) / ObjectSize) MapY = Fix((HorizY + 1) / ObjectSize) A.SetPixel (Fix(HorizX)), (Fix(HorizY)), ColorConstants.vbCyan If LevelMap0(MapY, MapX) = vbBlue Then Exit Do End If DoEvents Loop HorizDist = Sqr(((HorizX - Player.PosX) * (HorizX - Player.PosX)) + ((HorizY - Player.PosY) * (HorizY - Player.PosY))) end sub porque não termina quando chega á parede?(dependendo do Radiano)
  14. ao grafico: 'Check for horizontal intersections: If ((Player.Radians >= 0 And Player.Radians <= PI)) Then 'Facing down mas deveria ser para cima e não para baixo, certo? eu rodasse para a direita ou esquerda o Radianos são os mesmos ou negativos? parecem correções básicas, mas noto diferenças entre a Matemática(sentido anti-horário) e a Computação(sentido horário).
  15. como fazer o RayCasting em VB6? eu tenho esta função para desenhar 1 linha do RayCasting: Private Sub DrawRays2() Dim AY As Double Dim AX As Double Dim StepX As Double Dim StepY As Double Dim VertX As Double Dim VertY As Double Dim HorizX As Double Dim HorizY As Double Dim MapX As Long Dim MapY As Long Dim HorizDist As Double Dim VertDist As Double Dim WallDistance As Double Dim RayHeight As Double On Error Resume Next ' Check for horizontal intersections: If (Player.Radians >= 0 And Player.Radians <= PI) Then ' Facing down AY = (Int(Player.PosY / ObjectSize) * ObjectSize) + ObjectSize ' Calculate grid position StepY = ObjectSize Else 'Facing Up AY = (Int(Player.PosY / ObjectSize) * ObjectSize) - 1 StepY = -ObjectSize End If AX = Player.PosX + (AY - Player.PosY) / Tan(Player.Radians) HorizX = AX HorizY = AY StepX = StepY / Tan(Player.Radians) MapX = Fix((HorizX) / ObjectSize) MapY = Fix((HorizY) / ObjectSize) A.SetPixel (Fix(HorizX)), (Fix(HorizY)), ColorConstants.vbCyan If ((MapY < 9 Or MapY >= 0) Or (MapX < 9 Or MapX >= 0)) Then If LevelMap0(MapY, MapX) <> vbBlue Then Do HorizX = HorizX + StepX HorizY = HorizY + StepY A.SetPixel (Fix(HorizX)), (Fix(HorizY)), ColorConstants.vbCyan MapX = Fix((HorizX) / ObjectSize) MapY = Fix((HorizY) / ObjectSize) If ((MapY > 9 Or MapY < 0) Or (MapX > 9 Or MapX < 0)) Then Exit Do If LevelMap0(MapY, MapX) = vbBlue Then A.SetPixel (Fix(HorizX)), (Fix(HorizY)), ColorConstants.vbCyan Exit Do End If DoEvents Loop End If End If HorizDist = Sqr(((HorizX - Player.PosX) * (HorizX - Player.PosX)) + ((HorizY - Player.PosY) * (HorizY - Player.PosY))) ' Check for vertical intersections: If (Player.Radians >= (PI / 2) And Player.Radians <= (3 * PI / 2)) Then ' Facing right AX = (Int(Player.PosX / ObjectSize) * ObjectSize) - 1 ' Calculate grid position StepX = -ObjectSize Else 'Facing left AX = (Int(Player.PosX / ObjectSize) * ObjectSize) + ObjectSize StepX = ObjectSize End If AY = Player.PosY + (Player.PosX - AX) * -Tan(Player.Radians) VertX = AX VertY = AY StepY = StepX * Tan(Player.Radians) MapX = Fix((VertX) / ObjectSize) MapY = Fix((VertY) / ObjectSize) A.SetPixel (Fix(VertX)), (Fix(VertY)), vbYellow If LevelMap0(MapY, MapX) <> vbBlue Then Do VertX = VertX + StepX VertY = VertY + StepY If (VertX < 0 Or VertX > (9 * ObjectSize) Or VertY < 0 Or VertY > (9 * ObjectSize)) Then Exit Sub A.SetPixel (Fix(VertX)), (Fix(VertY)), vbYellow MapX = Fix((VertX) / ObjectSize) MapY = Fix((VertY) / ObjectSize) If ((MapY > 9 And MapY < 0) Or (MapX > 9 And MapX < 0)) Then Exit Do If LevelMap0(MapY, MapX) = vbBlue Then A.SetPixel (Fix(VertX)), (Fix(VertY)), vbYellow Exit Do End If DoEvents Loop End If VertDist = Sqr((VertX - Player.PosX) * (VertX - Player.PosX)) + ((VertY - Player.PosY) * (VertY - Player.PosY)) A.ForeColor vbRed WallDistance = Max(VertDist, HorizDist) * Cos(Player.Radians) If (WallDistance = VertDist) Then A.DrawLine Fix(Player.PosX), Fix(Player.PosY), Fix(VertX), Fix(VertY) Else A.DrawLine Fix(Player.PosX), Fix(Player.PosY), Fix(HorizX), Fix(HorizY) End If RayHeight = ObjectSize / WallDistance * 320 A.ForeColor vbBlue A.DrawLine 475 + 50, 200 / 2 - RayHeight / 2, 475 + 50, 200 / 2 + RayHeight / 2 End Sub mas noto alguns erros: 1 - a linha desenhada pode ultrapassar o tamanho da tabela\array(9*ObjectSize); 2 - dependendo de alguns angulos,a linha não é desenhada... eu tenho os if's para tentar evitar esses erros, mas parecem ignorados onde estou a errar?
  16. como funciona o Cartesiano Gráfico no Computador? em Matemática o Y positivo é para cima e no Computador é para baixo.... qual é o sentido dos Graus\Radianos? é sentido Horário ou Anti-Horário? em programação estou a obter resultados inesperados, por isso estou a perguntar hello world 'tenho de inserir 1 código, mas não precisa agora
  17. consegui, na linha horizontal para baixo, mas erra para cima If (Player.Radians < PI And Player.Radians > 0) Then 'facing down YA = ((Player.PosY \ ObjectSize) * ObjectSize) + ObjectSize XA = Player.PosX + (Player.PosY - YA) / -Tan(Player.Radians) Else If (Player.Radians > PI / 2 And Player.Radians > 0) Then 'facing up YA = ((Player.PosY \ ObjectSize) * ObjectSize) - ObjectSize XA = Player.PosX + (Player.PosY - YA) / -Tan(Player.Radians) End If ok... agora o codigo não é C... mas não interessa... preciso de saber: 1 - como verifico se o radiano esta para cima ou para baixo? 2 - como calcular para obter o ponto A(é o quadrado seguinte ao jogador mantendo o radiano)? Moderador: porque falham as teclas direcionais ao escrever?
  18. nunca pensei que este erro meu podesse influenciar este erro: sempre que usamos 'set' ou 'new', temos de igual a variavel a 'nothing' com 'set'... e foi este meu erro, que causava o erro número 8. muito obrigado
  19. eu tenho 1 classe em VB6 para criar DIB's: Private Function AlignScan(ByVal inWidth As Long, ByVal inDepth As Integer) As Long AlignScan = (((inWidth * inDepth) + &H1F) And Not &H1F&) \ &H8 End Function Public Function NewImage(ByVal ImageWidth As Long, ByVal ImageHeight As Long, Optional color As ColorConstants = vbBlack) As Long If (Width > 0 Or Height > 0 Or hBitmap > 0 Or PointerPixelData > 0) Then DeleteImage Width = ImageWidth Height = ImageHeight 'Criar HDC MemoryHDC = CreateCompatibleDC(0) With bmiInfo.bmiHeader .biSize = Len(bmiInfo.bmiHeader) .biWidth = Width .biHeight = -Height ' is negative for start on top left pixel image .biPlanes = 1 .biBitCount = 32 .biCompression = BI_RGB .biSizeImage = AlignScan(bmiInfo.bmiHeader.biWidth, bmiInfo.bmiHeader.biBitCount) * bmiInfo.bmiHeader.biHeight End With If MemoryHDC = 0 Then MsgBox "error: HDC not created!!!" hBitmap = CreateDIBSection(0&, bmiInfo, DIB_RGB_COLORS, PointerPixelData, 0&, 0&) If hBitmap = 0 Then MsgBox "error: " & GetLastError() oldBitmap = SelectObject(MemoryHDC, hBitmap) 'using pointers: ' Get the bits in the from DIB section: With tSA .fFeatures = FADF_FIXEDSIZE Or FADF_AUTO .cbElements = 4 .cDims = 1 .Bounds(0).lLbound = 0 .Bounds(0).cElements = bmiInfo.bmiHeader.biHeight * bmiInfo.bmiHeader.biWidth .pvData = PointerPixelData End With 'Erase bDib ' Make the bDib() array point to the memory addresses: CopyMemory ByVal VarPtrArray(bDib()), VarPtr(tSA), 4 CopyMemory ByVal VarPtrArray(bDibBGRA()), VarPtr(tSA), 4 'Clear color End Function 'e como limpar: Public Sub DeleteImage() 'Clear pointer: Dim z As Long CopyMemory ByVal VarPtrArray(bDib), VarPtr(z), 4 Erase bDib Dim s As Long CopyMemory ByVal VarPtrArray(bDibBGRA), VarPtr(z), 4 Erase bDibBGRA SelectObject MemoryHDC, OldBrush DeleteObject NewBrush SelectObject MemoryHDC, OldPen DeleteObject NewPen SelectObject MemoryHDC, oldBitmap DeleteObject hBitmap 'ReleaseDC 0, MemoryHDC DeleteDC MemoryHDC End Sub o meu problema é: após 4 execuções no IDE(mas não acontece no EXE), eu obtenho 1 erro nesta linha: Public Function NewImage(ByVal ImageWidth As Long, ByVal ImageHeight As Long, Optional color As ColorConstants = vbBlack) As Long If (Width > 0 Or Height > 0 Or hBitmap > 0 Or PointerPixelData > 0) Then DeleteImage Width = ImageWidth Height = ImageHeight 'Criar HDC MemoryHDC = CreateCompatibleDC(0) With bmiInfo.bmiHeader .biSize = Len(bmiInfo.bmiHeader) .biWidth = Width .biHeight = -Height ' is negative for start on top left pixel image .biPlanes = 1 .biBitCount = 32 .biCompression = BI_RGB .biSizeImage = AlignScan(bmiInfo.bmiHeader.biWidth, bmiInfo.bmiHeader.biBitCount) * bmiInfo.bmiHeader.biHeight End With If MemoryHDC = 0 Then MsgBox "error: HDC not created!!!" hBitmap = CreateDIBSection(0&, bmiInfo, DIB_RGB_COLORS, PointerPixelData, 0&, 0&) If hBitmap = 0 Then MsgBox "error: " & GetLastError() 'ERRO: não cria o DIB... erro 8: "ERROR_NOT_ENOUGH_MEMORY 8 (0x8) Not enough memory resources are available to process this command." https://learn.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499- porquê este erro? porque só aparece após executar 4 vezes no IDE e não no EXE? para voltar a executar, eu tenho de terminar\fechar o IDE e voltar a executar... estranho este erro
  20. finalmente consegui resultados mais corretos: Public Function BresenhamLine(X0 As Long, Y0 As Long, X1 As Long, Y1 As Long, ByRef Map() As Long, ObjectSize As Long, angle_rad As Double) As Long Dim dx As Long Dim dy As Long Dim steps As Double Dim Xincrement As Double Dim Yincrement As Double Dim x As Double Dim y As Double Dim MapX As Integer Dim MapY As Integer Dim LineWidth As Long x = X0 y = Y0 dx = X1 - X0 dy = Y1 - Y0 LineWidth = 0 If (Abs(dx) > Abs(dy)) Then steps = Abs(dx) Else steps = Abs(dy) End If Xincrement = dx / (steps) Yincrement = dy / (steps) Dim v As Integer For v = 0 To steps x = x + Xincrement y = y + Yincrement MapX = Int(x / ObjectSize) MapY = Int(y / ObjectSize) LineWidth = LineWidth + 1 If (Map(MapY, MapX) = vbBlue) Then Exit For End If Next v ForeColor vbRed DrawLine X0, Y0, Int(x), Int(y) 'Calculate the Distance between Origin and Destination line: 'CatetoAdjacente=(x - X0) 'CatetoOposto=(y - Y0) 'Hip = RaizQuadrada(CatetoAdjacente ^ 2 + CatetoOposto ^ 2) LineWidth = Sqr((x - X0) * (x - X0) + (y - Y0) * (y - Y0)) BresenhamLine = LineWidth End Function Public Function DrawLineWithAngleAndLength(X1 As Long, Y1 As Long, angle_rad As Double, Length As Long, Map() As Long, ObjectSize As Long) As Long ' Calcular as coordenadas finais da linha Dim X2 As Long Dim Y2 As Long X2 = X1 + Length * Cos(angle_rad) Y2 = Y1 + Length * Sin(angle_rad) ' Chame a função BresenhamLine com as coordenadas finais DrawLineWithAngleAndLength = BresenhamLine(X1, Y1, X2, Y2, Map(), ObjectSize, angle_rad) End Function Private Sub DrawRays(StartRadians As Double, EndRadians As Double, VisionRadians As Double, ScreenWidth As Long, Optional Precision As Long = 1) Dim RayCount As Long Dim RaySteps As Double Dim RayWay As Long Dim RayWidth As Long Dim RayAngle As Double Dim RayHeight As Double 'number of rays: RayCount = ScreenWidth / CLng(VisionRadians) * Precision 'getting increment ray: RaySteps = (EndRadians - StartRadians) / CDbl(RayCount) Do While (RayWay < RayCount) 'calcule the ray angle\radians: RayAngle = StartRadians + (RaySteps * RayWay) 'draw ray and get ray width: RayWidth = A.DrawLineWithAngleAndLength(Int(Player.PosX), Int(Player.PosY), RayAngle, 300, LevelMap0(), 33) RayHeight = 66 / RayWidth * ScreenWidth A.ForeColor vbBlue A.DrawLine 475 + 50 + RayWay, 200 / 2 - RayHeight / 2, 475 + 50 + RayWay, 200 / 2 + RayHeight / 2 RayWay = RayWay + 1 Loop End Sub eu sei que os cálculos estão corretos, porque agora obtenho resultados esperados... eis como obtenho a altura de linha: 'draw ray and get ray width: RayWidth = A.DrawLineWithAngleAndLength(Int(Player.PosX), Int(Player.PosY), RayAngle, 300, LevelMap0(), 33) RayHeight = 66 / RayWidth * ScreenWidth a partir daqui, como evito o Efeito de Peixe? demorei imenso chegar aqui... ao menos aprendi mas usei pixel a pixel e não o triangulo para percorrer a linha... sim é mais lento.... mas agora quero corrigir o Efeito de Peixe
  21. eis o código todo mesmo... não esquecer de mudar o nome do ficheiro no form_load(). Public Function BresenhamLine(X0 As Long, Y0 As Long, X1 As Long, Y1 As Long, ByRef Map() As Long, ObjectSize As Long, angle_rad As Double) As Long Dim dx As Long Dim dy As Long Dim steps As Double Dim Xincrement As Double Dim Yincrement As Double Dim x As Double Dim y As Double Dim MapX As Integer Dim MapY As Integer Dim LineWidth As Long x = X0 y = Y0 dx = X1 - X0 dy = Y1 - Y0 LineWidth = 0 If (Abs(dx) > Abs(dy)) Then steps = Abs(dx) Else steps = Abs(dy) End If Xincrement = dx / (steps) Yincrement = dy / (steps) Dim v As Integer For v = 0 To steps x = x + Xincrement y = y + Yincrement MapX = Int(x / ObjectSize) MapY = Int(y / ObjectSize) LineWidth = LineWidth + 1 If (Map(MapY, MapX) = vbBlue) Then Exit For End If Next v ForeColor vbRed DrawLine X0, Y0, Int(x), Int(y) LineWidth = LineWidth / Cos(angle_rad) BresenhamLine = LineWidth End Function Public Function DrawLineWithAngleAndLength(X1 As Long, Y1 As Long, angle_rad As Double, Length As Long, Map() As Long, ObjectSize As Long) As Long ' Calcular as coordenadas finais da linha Dim X2 As Long Dim Y2 As Long X2 = X1 + Length * Cos(angle_rad) Y2 = Y1 + Length * Sin(angle_rad) ' Chame a função BresenhamLine com as coordenadas finais DrawLineWithAngleAndLength = BresenhamLine(X1, Y1, X2, Y2, Map(), ObjectSize, angle_rad) End Function Private Sub DrawRays(StartRadians As Double, EndRadians As Double, VisionRadians As Double, ScreenWidth As Long, Optional Precision As Long = 1) Dim RayCount As Long Dim RaySteps As Double Dim RayWay As Long Dim RayWidth As Long Dim RayAngle As Double Dim RayHeight As Double 'number of rays: RayCount = ScreenWidth / CLng(VisionRadians) * Precision 'getting increment ray: RaySteps = (EndRadians - StartRadians) / CDbl(RayCount) Do While (RayWay < RayCount) 'calcule the ray angle\radians: RayAngle = StartRadians + (RaySteps * RayWay) 'draw ray and get ray width: RayWidth = A.DrawLineWithAngleAndLength(Int(Player.PosX), Int(Player.PosY), RayAngle, 300, LevelMap0(), 33) RayHeight = 66 / RayWidth * ScreenWidth / 2 'Debug.Print RayHeight A.ForeColor vbBlue A.DrawLine 475 + 50 + RayWay, 200 / 2 - RayHeight / 2, 475 + 50 + RayWay, 200 / 2 + RayHeight / 2 RayWay = RayWay + 1 Loop End Sub RayCasting3.7z
  22. ao desenhar o raio, obtenho o comprimento do raio... ao saber o comprimento do raio, como calculo a altura da linha? como posso evitar o efeito de peixe? Dim RayAngle As Double Do While (RayWay < RayCount) RayAngle = StartRadians + (RaySteps * RayWay) RayWidth = A.DrawLineWithAngleAndLength(Int(Player.PosX), Int(Player.PosY), RayAngle, 300, LevelMap0(), 33) lineHeight = 200 / RayWidth * 2 drawStart = -lineHeight / 2 + 200 / 2 If drawStart < 0 Then drawStart = 0 drawEnd = lineHeight / 2 + 200 / 2 If drawEnd >= 200 Then drawEnd = 200 - 1 Me.Line (A.Width + RayWay, drawStart)-(A.Width + RayWay, drawEnd), vbWhite RayWay = RayWay + 1 Loop
  23. no windows 10, temos alguma configuração para mostrar a 1ª página de algum documento(doc, pdf, imagens), mas sem alterar o 'abrir'?

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...