26-09-2007, 07:28 PM
I made the mistake of starting 3 years ago on es, and ive built a pretty awesome game, and hopefully i can redo the gameloop and not have to lose all the work.
im hoping you guys can point out some things i can do to get rid of this mess.
ok this is my horrid ES gameloop
any ideas ? i know its a hell of alot bigger than MS thats for sure
im hoping you guys can point out some things i can do to get rid of this mess.
ok this is my horrid ES gameloop
Code:
Sub GameLoop()
Dim Tick As Long
Dim TickFPS As Long
Dim FPS As Long
Dim x As Long
Dim y As Long
Dim I As Long
Dim rec_back As RECT
Dim FlashCntr As Long
Dim FlashSwitch As Byte
' Set the focus
frmMirage.picScreen.SetFocus
' Set font
Call SetFont("Fixedsys", 18, 0, 0, 0, 0)
' Fixedsys's size can't be changed and bold doesn't seem to work
' Used for calculating fps
TickFPS = GetTickCount
FPS = 0
FlashCntr = GetTickCount
FlashSwitch = 0
' Just need to call this once at game loop so everything runs smoothly..
DD.RestoreAllSurfaces
Call InitSurfaces
'Clear out the backbuffer
' Blit out the map animations if it is time to.
If MapAnim 0 Then
'Call BltAnimations
End If
Do While InGame
Tick = GetTickCount
rec.Top = 0
rec.Bottom = frmMirage.picScreen.Height
rec.Left = 0
rec.Right = frmMirage.picScreen.Width
Call DD_BackBuffer.BltColorFill(rec, RGB(0, 0, 0))
'Clear out the middle buffer for drawing
With rec
.Top = 0
.Bottom = frmMirage.picScreen.Height
.Left = 0
.Right = frmMirage.picScreen.Width
End With
DD_MiddleBuffer.BltColorFill rec, RGB(0, 0, 0)
' Check to make sure they aren't trying to auto do anything
If GetAsyncKeyState(VK_UP) >= 0 And DirUp = True Then DirUp = False
If GetAsyncKeyState(VK_DOWN) >= 0 And DirDown = True Then DirDown = False
If GetAsyncKeyState(VK_LEFT) >= 0 And DirLeft = True Then DirLeft = False
If GetAsyncKeyState(VK_RIGHT) >= 0 And DirRight = True Then DirRight = False
If GetAsyncKeyState(VK_CONTROL) >= 0 And ControlDown = True Then ControlDown = False
If GetAsyncKeyState(VK_SHIFT) >= 0 And ShiftDown = True Then ShiftDown = False
' Check to make sure we are still connected
If Not IsConnected Then InGame = False
' Check if we need to restore surfaces
If NeedToRestoreSurfaces Then
DD.RestoreAllSurfaces
Call InitSurfaces
End If
If GettingMap = False Then
If GetPlayerPOINTS(MyIndex) > 0 Then
frmMirage.AddStr.Visible = True
frmMirage.AddDef.Visible = True
frmMirage.AddSpeed.Visible = True
frmMirage.AddMagi.Visible = True
Else
frmMirage.AddStr.Visible = False
frmMirage.AddDef.Visible = False
frmMirage.AddSpeed.Visible = False
frmMirage.AddMagi.Visible = False
End If
' Visual Inventory
Dim Q As Long
Dim Qq As Long
Dim IT As Long
If GetTickCount > IT + 500 And frmMirage.picInv3.Visible = True Then
For Q = 0 To MAX_INV - 1
Qq = Player(MyIndex).Inv(Q + 1).Num
If frmMirage.picInv(Q).Picture LoadPicture() Then
frmMirage.picInv(Q).Picture = LoadPicture()
Else
If Qq = 0 Then
frmMirage.picInv(Q).Picture = LoadPicture()
Else
Call BitBlt(frmMirage.picInv(Q).hDC, 0, 0, PIC_X, PIC_Y, frmMirage.picItems.hDC, (Item(Qq).pic - Int(Item(Qq).pic / 6) * 6) * PIC_X, Int(Item(Qq).pic / 6) * PIC_Y, SRCCOPY)
End If
End If
Next Q
End If
' Icons
Dim M As Long
Dim Mm As Long
Dim TI As Long
If GetTickCount > TI + 500 And frmMirage.picPlayerSpells.Visible = True Then
For M = 0 To MAX_PLAYER_SPELLS - 1
Mm = Player(MyIndex).Spell(M + 1)
If frmMirage.picSpell(M).Picture LoadPicture() Then
frmMirage.picSpell(M).Picture = LoadPicture()
Else
If Mm = 0 Then
frmMirage.picSpell(M).Picture = LoadPicture()
Else
Call BitBlt(frmMirage.picSpell(M).hDC, 0, 0, PIC_X, PIC_Y, frmMirage.picSpellIcons.hDC, (Spell(Mm).pic - Int(Spell(Mm).pic / 6) * 6) * PIC_X, Int(Spell(Mm).pic / 6) * PIC_Y, SRCCOPY)
End If
End If
Next M
End If
NewX = 10
NewY = 7
NewPlayerY = Player(MyIndex).y - NewY
NewPlayerX = Player(MyIndex).x - NewX
NewX = NewX * PIC_X
NewY = NewY * PIC_Y
NewXOffset = Player(MyIndex).XOffset
NewYOffset = Player(MyIndex).YOffset
If Player(MyIndex).y - 7 < 1 Then
NewY = Player(MyIndex).y * PIC_Y + Player(MyIndex).YOffset
NewYOffset = 0
NewPlayerY = 0
If Player(MyIndex).y = 7 And Player(MyIndex).Dir = DIR_UP Then
NewPlayerY = Player(MyIndex).y - 7
NewY = 7 * PIC_Y
NewYOffset = Player(MyIndex).YOffset
End If
ElseIf Player(MyIndex).y + 8 > MAX_MAPY + 1 Then
NewY = (Player(MyIndex).y - 16) * PIC_Y + Player(MyIndex).YOffset
NewYOffset = 0
NewPlayerY = MAX_MAPY - 13
If Player(MyIndex).y = 24 And Player(MyIndex).Dir = DIR_DOWN Then
NewPlayerY = Player(MyIndex).y - 7
NewY = 7 * PIC_Y
NewYOffset = Player(MyIndex).YOffset
End If
End If
If Player(MyIndex).x - 10 < 1 Then
NewX = Player(MyIndex).x * PIC_X + Player(MyIndex).XOffset
NewXOffset = 0
NewPlayerX = 0
If Player(MyIndex).x = 10 And Player(MyIndex).Dir = DIR_LEFT Then
NewPlayerX = Player(MyIndex).x - 10
NewX = 10 * PIC_X
NewXOffset = Player(MyIndex).XOffset
End If
ElseIf Player(MyIndex).x + 11 > MAX_MAPX + 1 Then
NewX = (Player(MyIndex).x - 11) * PIC_X + Player(MyIndex).XOffset
NewXOffset = 0
NewPlayerX = MAX_MAPX - 19
If Player(MyIndex).x = 21 And Player(MyIndex).Dir = DIR_RIGHT Then
NewPlayerX = Player(MyIndex).x - 10
NewX = 10 * PIC_X
NewXOffset = Player(MyIndex).XOffset
End If
End If
sx = 32
If MAX_MAPX = 19 Then
NewX = Player(MyIndex).x * PIC_X + Player(MyIndex).XOffset
NewXOffset = 0
NewPlayerX = 0
NewY = Player(MyIndex).y * PIC_Y + Player(MyIndex).YOffset
NewYOffset = 0
NewPlayerY = 0
sx = 0
End If
If ScreenMode = 0 Then
' Blit out the items
For I = 1 To MAX_MAP_ITEMS
If MapItem(I).Num > 0 Then
Call BltItem(I)
End If
Next I
' Blit out NPC hp bars
For I = 1 To MAX_MAP_NPCS
If GetTickCount < MapNpc(I).LastAttack + 5000 Then
Call BltNpcBars(I)
End If
Next I
' Blit players bar
For I = 1 To MAX_PLAYERS
If IsPlaying(I) Then
If GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
'If GetTickCount < Player(MyIndex).LastAttack + 5000 Then
Call BltPlayerBars(I)
'End If
End If
If Player(I).Pet.Map = GetPlayerMap(MyIndex) And Player(I).Pet.Alive = YES Then
If GetTickCount < Player(MyIndex).Pet.LastAttack + 5000 Then
Call BltPetBars(I)
End If
End If
End If
Next I
' Blit out the sprite change attribute
For y = 0 To MAX_MAPY
For x = 0 To MAX_MAPX
Call BltSpriteChange(x, y)
Next x
Next y
' Blit out the furniture attribute
For y = 0 To MAX_MAPY
For x = 0 To MAX_MAPX
Call BltFurniture(x, y)
Next x
Next y
' Blit out arrows
For I = 1 To MAX_PLAYERS
If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
Call BltArrow(I)
End If
Next I
' XCORPSEX
For I = 1 To MAX_PLAYERS
If IsPlaying(I) Then
If Player(I).CorpseMap = GetPlayerMap(MyIndex) Then
Call BltPlayerCorpse(I)
End If
End If
Next I
' XCORPSEX
' Blit out the npcs
For I = 1 To MAX_MAP_NPCS
Call BltNpc(I)
Next I
' Blit out players
For I = 1 To MAX_PLAYERS
If GetPlayerSpriteAccess(I) < 1 Then
If IsPlaying(I) Then
If GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
If Player(I).Pet.Alive = YES Then
Call BltPet(I)
End If
Call BltPlayer(I)
End If
End If
End If
Next I
For I = 1 To MAX_PLAYERS
If GetPlayerSpriteAccess(I) > 0 Then
If IsPlaying(I) Then
If GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
If Player(I).Pet.Alive = YES Then
Call BltPet(I)
End If
Call BltAdmin(I)
End If
End If
End If
Next I
If SIZE_Y > PIC_Y Then
For I = 1 To MAX_PLAYERS
If GetPlayerSpriteAccess(I) < 1 Then
If IsPlaying(I) Then
If GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
If Player(I).Pet.Alive = YES Then
Call BltPetTop(I)
End If
Call BltPlayerTop(I)
End If
End If
End If
Next I
End If
If SIZE_Y > PIC_Y Then
For I = 1 To MAX_PLAYERS
If GetPlayerSpriteAccess(I) > 0 Then
If IsPlaying(I) Then
If GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
If Player(I).Pet.Alive = YES Then
Call BltPetTop(I)
End If
Call BltAdminTop(I)
End If
End If
End If
Next I
End If
' Blit the spells
For I = 1 To MAX_PLAYERS
If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
Call BltSpell(I)
End If
Next I
' Blit out the sprite change attribute
For y = 0 To MAX_MAPY
For x = 0 To MAX_MAPX
Call BltSpriteChange2(x, y)
Next x
Next y
' Blit out the npc's top
For I = 1 To MAX_MAP_NPCS
Call BltNpcTop(I)
Next I
End If
If InEditor = True Then
Call BltTile
Call BltFringeTile
Call BltFringeTile2
End If
If ScreenMode = 0 Then
' Blit out the npcs
For I = 1 To MAX_MAP_NPCS
If Map(GetPlayerMap(MyIndex)).Tile(MapNpc(I).x, MapNpc(I).y).Fringe < 1 Then
If Map(GetPlayerMap(MyIndex)).Tile(MapNpc(I).x, MapNpc(I).y).FAnim < 1 Then
If Map(GetPlayerMap(MyIndex)).Tile(MapNpc(I).x, MapNpc(I).y).Fringe2 < 1 Then
If Map(GetPlayerMap(MyIndex)).Tile(MapNpc(I).x, MapNpc(I).y).F2Anim < 1 Then
Call BltNpcTop(I)
End If
End If
End If
End If
Next I
End If
For I = 1 To MAX_PLAYERS
If IsPlaying(I) = True Then
If Player(I).LevelUpT + 3000 > GetTickCount Then
rec.Top = Int(32 / TilesInSheets) * PIC_Y
rec.Bottom = rec.Top + PIC_Y
rec.Left = (32 - Int(32 / TilesInSheets) * TilesInSheets) * PIC_X
rec.Right = rec.Left + 96
If I = MyIndex Then
x = NewX + sx
y = NewY + sx
Call DD_BackBuffer.BltFast(x - 32, y - 10 - Player(I).LevelUp, DD_TileSurf(6), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
Else
x = GetPlayerX(I) * PIC_X + sx + Player(I).XOffset
y = GetPlayerY(I) * PIC_Y + sx + Player(I).YOffset
Call DD_BackBuffer.BltFast(x - (NewPlayerX * PIC_X) - 32 - NewXOffset, y - (NewPlayerY * PIC_Y) - 10 - Player(I).LevelUp - NewYOffset, DD_TileSurf(6), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
End If
If Player(I).LevelUp >= 3 Then
Player(I).LevelUp = Player(I).LevelUp - 1
ElseIf Player(I).LevelUp >= 1 Then
Player(I).LevelUp = Player(I).LevelUp + 1
End If
Else
Player(I).LevelUpT = 0
End If
End If
Next I
If GettingMap = False Then
If GameTime = TIME_NIGHT And Map(GetPlayerMap(MyIndex)).Indoors = 0 And InEditor = False Then
Call Night
End If
If frmMapEditor.chkDayNight.Value = 1 And InEditor = True Then
Call Night
End If
If Map(GetPlayerMap(MyIndex)).Indoors = 0 Then Call BltWeather
End If
If InEditor = True And Val(GetVar(App.Path & "\Main\Config\config.ini", "CONFIG", "MapGrid")) = 1 Then
For y = 0 To MAX_MAPY
For x = 0 To MAX_MAPX
Call BltTile2(x * 32, y * 32, 0, 5)
Next x
Next y
End If
End If
If InEditor = True And SelectorWidth 0 And SelectorHeight 0 And frmMapEditor.fraLayers.Visible = True Then
For y = 0 To SelectorHeight - 1
For x = 0 To SelectorWidth - 1
Call BltTile2(MouseX + (x * PIC_X), MouseY + (y * PIC_Y), ((EditorTileY + y) * TilesInSheets) + (EditorTileX + x), EditorSet)
Next x
Next y
End If
rec.Top = 0
rec.Bottom = frmMirage.picScreen.Height
rec.Left = 0
rec.Right = frmMirage.picScreen.Width
Call DD_BackBuffer.BltFast(0, 0, DD_LowerBuffer, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
Call DD_BackBuffer.BltFast(0, 0, DD_MiddleBuffer, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
Call DD_BackBuffer.BltFast(0, 0, DD_UpperBuffer, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
' Lock the backbuffer so we can draw text and names
TexthDC = DD_BackBuffer.GetDC
If GettingMap = False Then
If ScreenMode = 0 Then
If Val(GetVar(App.Path & "\Main\Config\config.ini", "CONFIG", "NPCDamage")) = 1 Then
If Val(GetVar(App.Path & "\Main\Config\config.ini", "CONFIG", "PlayerName")) = 0 Then
If GetTickCount < NPCDmgTime + 2000 Then
Call DrawText(TexthDC, (Int(Len(NPCDmgDamage)) / 2) * 3 + NewX + sx, NewY - 22 - ii + sx, NPCDmgDamage, QBColor(BrightRed))
End If
Else
If GetPlayerGuild(MyIndex) "" Then
If GetTickCount < NPCDmgTime + 2000 Then
Call DrawText(TexthDC, (Int(Len(NPCDmgDamage)) / 2) * 3 + NewX + sx, NewY - 42 - ii + sx, NPCDmgDamage, QBColor(BrightRed))
End If
Else
If GetTickCount < NPCDmgTime + 2000 Then
Call DrawText(TexthDC, (Int(Len(NPCDmgDamage)) / 2) * 3 + NewX + sx, NewY - 22 - ii + sx, NPCDmgDamage, QBColor(BrightRed))
End If
End If
End If
ii = ii + 1
End If
If Val(GetVar(App.Path & "\Main\Config\config.ini", "CONFIG", "PlayerDamage")) = 1 Then
If NPCWho > 0 Then
If MapNpc(NPCWho).Num > 0 Then
If Val(GetVar(App.Path & "\Main\Config\config.ini", "CONFIG", "NPCName")) = 0 Then
If Npc(MapNpc(NPCWho).Num).Big = 0 Then
If GetTickCount < DmgTime + 2000 Then
Call DrawText(TexthDC, (MapNpc(NPCWho).x - NewPlayerX) * PIC_X + sx + (Int(Len(DmgDamage)) / 2) * 3 + MapNpc(NPCWho).XOffset - NewXOffset, (MapNpc(NPCWho).y - NewPlayerY) * PIC_Y + sx - 20 + MapNpc(NPCWho).YOffset - NewYOffset - iii, DmgDamage, QBColor(White))
End If
Else
If GetTickCount < DmgTime + 2000 Then
Call DrawText(TexthDC, (MapNpc(NPCWho).x - NewPlayerX) * PIC_X + sx + (Int(Len(DmgDamage)) / 2) * 3 + MapNpc(NPCWho).XOffset - NewXOffset, (MapNpc(NPCWho).y - NewPlayerY) * PIC_Y + sx - 47 + MapNpc(NPCWho).YOffset - NewYOffset - iii, DmgDamage, QBColor(White))
End If
End If
Else
If Npc(MapNpc(NPCWho).Num).Big = 0 Then
If GetTickCount < DmgTime + 2000 Then
Call DrawText(TexthDC, (MapNpc(NPCWho).x - NewPlayerX) * PIC_X + sx + (Int(Len(DmgDamage)) / 2) * 3 + MapNpc(NPCWho).XOffset - NewXOffset, (MapNpc(NPCWho).y - NewPlayerY) * PIC_Y + sx - 30 + MapNpc(NPCWho).YOffset - NewYOffset - iii, DmgDamage, QBColor(White))
End If
Else
If GetTickCount < DmgTime + 2000 Then
Call DrawText(TexthDC, (MapNpc(NPCWho).x - NewPlayerX) * PIC_X + sx + (Int(Len(DmgDamage)) / 2) * 3 + MapNpc(NPCWho).XOffset - NewXOffset, (MapNpc(NPCWho).y - NewPlayerY) * PIC_Y + sx - 57 + MapNpc(NPCWho).YOffset - NewYOffset - iii, DmgDamage, QBColor(White))
End If
End If
End If
iii = iii + 1
End If
End If
End If
'Draw NPC Names
If Val(GetVar(App.Path & "\Main\Config\config.ini", "CONFIG", "NPCName")) = 1 Then
For I = LBound(MapNpc) To UBound(MapNpc)
If MapNpc(I).Num > 0 Then
Call BltMapNPCName(I)
End If
Next I
End If
' Draw Player Names
If Val(GetVar(App.Path & "\Main\Config\config.ini", "CONFIG", "PlayerName")) = 1 Then
For I = 1 To MAX_PLAYERS
If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
Call BltPlayerGuildName(I)
Call BltPlayerMarriageName(I)
If GetTickCount > FlashCntr + 250 Then
If FlashSwitch = 1 Then
FlashSwitch = 0
Else
FlashSwitch = 1
End If
FlashCntr = GetTickCount
End If
Call BltPlayerName(I, FlashSwitch)
If Player(I).Pet.Alive = YES And Player(I).Pet.Map = GetPlayerMap(MyIndex) Then
Call BltPetName(I)
End If
' XCORPSEX
If Player(I).CorpseMap = GetPlayerMap(MyIndex) Then
Call BltPlayerCorpseName(I)
End If
' XCORPSEX
End If
Next I
End If
' speech bubble stuffs
If Val(GetVar(App.Path & "\Main\Config\config.ini", "CONFIG", "SpeechBubbles")) = 1 Then
For I = 1 To MAX_PLAYERS
If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
If Bubble(I).Text "" Then
Call BltPlayerText(I)
End If
If GetTickCount() > Bubble(I).Created + DISPLAY_BUBBLE_TIME Then
Bubble(I).Text = ""
End If
End If
Next I
End If
' Blit out attribs if in editor
If InEditor Then
For y = 0 To MAX_MAPY
For x = 0 To MAX_MAPX
With Map(GetPlayerMap(MyIndex)).Tile(x, y)
If .Type = TILE_TYPE_BLOCKED Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "B", QBColor(BrightRed))
If .Type = TILE_TYPE_WARP Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "W", QBColor(BrightBlue))
If .Type = TILE_TYPE_ITEM Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "I", QBColor(White))
If .Type = TILE_TYPE_NPCAVOID Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "N", QBColor(White))
If .Type = TILE_TYPE_KEY Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "K", QBColor(White))
If .Type = TILE_TYPE_KEYOPEN Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "O", QBColor(White))
If .Type = TILE_TYPE_HEAL Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "H", QBColor(BrightGreen))
If .Type = TILE_TYPE_KILL Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "K", QBColor(BrightRed))
If .Type = TILE_TYPE_SHOP Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "S", QBColor(Yellow))
If .Type = TILE_TYPE_CBLOCK Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "CB", QBColor(Black))
If .Type = TILE_TYPE_ARENA Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "A", QBColor(BrightGreen))
If .Type = TILE_TYPE_SOUND Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "PS", QBColor(Yellow))
If .Type = TILE_TYPE_SPRITE_CHANGE Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "SC", QBColor(Grey))
If .Type = TILE_TYPE_SIGN Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "SI", QBColor(Yellow))
If .Type = TILE_TYPE_DOOR Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "D", QBColor(Black))
If .Type = TILE_TYPE_NOTICE Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "N", QBColor(BrightGreen))
If .Type = TILE_TYPE_CHEST Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "C", QBColor(Brown))
If .Type = TILE_TYPE_CLASS_CHANGE Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "CG", QBColor(White))
If .Type = TILE_TYPE_SCRIPTED Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "SC", QBColor(Yellow))
If .Type = TILE_TYPE_BANK Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "BANK", QBColor(BrightRed))
If .Type = TILE_TYPE_HOUSE_BUY Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "PHB", QBColor(Yellow))
If .Type = TILE_TYPE_HOUSE Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "PH", QBColor(White))
If .Type = TILE_TYPE_FURNITURE Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "F", QBColor(BrightRed))
If .Type = TILE_TYPE_FISH Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "FISH", QBColor(Blue))
If .Type = TILE_TYPE_MINE Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "MINE", QBColor(Yellow))
If .Type = TILE_TYPE_LJACKING Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "LJACK", QBColor(Yellow))
If .Type = TILE_TYPE_ROOF Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "RF", QBColor(Red))
If .Type = TILE_TYPE_ROOFBLOCK Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "RFB", QBColor(BrightRed))
If .Type = TILE_TYPE_WALKTHRU Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "WT", QBColor(Red))
If .Type = TILE_TYPE_LOWER_STAT Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "-S", QBColor(BrightRed))
If .Type = TILE_TYPE_FORAGING Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "IF", QBColor(Blue))
If .Type = TILE_TYPE_SMITH Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "Sm", QBColor(BrightGreen))
If .Type = TILE_TYPE_JAILRELEASE Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "JAIL", QBColor(BrightGreen))
If .Type = TILE_TYPE_SPAWNGATE Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "GATE", QBColor(BrightGreen))
If .Type = TILE_TYPE_CTF Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "CTF", QBColor(BrightCyan))
If .Type = TILE_TYPE_GUILDHOUSE_BUY Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "GHB", QBColor(Yellow))
If .Type = TILE_TYPE_GUILDHOUSE Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "GH", QBColor(White))
If .Type = TILE_TYPE_WATER Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "WATER", QBColor(White))
If .Type = TILE_TYPE_SOAEXPANSIONPACK Then Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, "SoA", QBColor(White))
If .Light > 0 Then Call DrawText(TexthDC, x * PIC_X + sx + 18 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 14 - (NewPlayerY * PIC_Y) - NewYOffset, "L", QBColor(Yellow))
End With
If InSpawnEditor Then
For I = 1 To MAX_MAP_NPCS
If TempNpcSpawn(I).Used = YES Then
If x = TempNpcSpawn(I).x And y = TempNpcSpawn(I).y Then
Call DrawText(TexthDC, x * PIC_X + sx + 8 - (NewPlayerX * PIC_X) - NewXOffset, y * PIC_Y + sx + 8 - (NewPlayerY * PIC_Y) - NewYOffset, I, QBColor(White))
End If
End If
Next I
End If
Next x
Next y
End If
' Blit out there FPS
If Val(GetVar(App.Path & "\Main\Config\config.ini", "CONFIG", "FPS")) = 1 Then
Call DrawText(TexthDC, 560, 5, "FPS: " & GameFPS, QBColor(BrightCyan))
End If
' Draw map name
If Map(GetPlayerMap(MyIndex)).Moral = MAP_MORAL_NONE Then
Call DrawText(TexthDC, Int((20.5) * PIC_X / 2) - (Int(Len(Trim(Map(GetPlayerMap(MyIndex)).Name)) / 2) * 8) + sx, 2 + sx, Trim(Map(GetPlayerMap(MyIndex)).Name), QBColor(BrightRed))
ElseIf Map(GetPlayerMap(MyIndex)).Moral = MAP_MORAL_SAFE Then
Call DrawText(TexthDC, Int((20.5) * PIC_X / 2) - (Int(Len(Trim(Map(GetPlayerMap(MyIndex)).Name)) / 2) * 8) + sx, 2 + sx, Trim(Map(GetPlayerMap(MyIndex)).Name), QBColor(White))
ElseIf Map(GetPlayerMap(MyIndex)).Moral = MAP_MORAL_NO_PENALTY Then
Call DrawText(TexthDC, Int((20.5) * PIC_X / 2) - (Int(Len(Trim(Map(GetPlayerMap(MyIndex)).Name)) / 2) * 8) + sx, 2 + sx, Trim(Map(GetPlayerMap(MyIndex)).Name), QBColor(Black))
ElseIf Map(GetPlayerMap(MyIndex)).Moral = MAP_MORAL_HOUSE Then
Call DrawText(TexthDC, Int((20.5) * PIC_X / 2) - (Int(Len(Trim(Map(GetPlayerMap(MyIndex)).Name)) / 2) * 8) + sx, 2 + sx, Trim(Map(GetPlayerMap(MyIndex)).Name), QBColor(Yellow))
ElseIf Map(GetPlayerMap(MyIndex)).Moral = MAP_MORAL_INN Then
Call DrawText(TexthDC, Int((20.5) * PIC_X / 2) - (Int(Len(Trim(Map(GetPlayerMap(MyIndex)).Name)) / 2) * 8) + sx, 2 + sx, Trim(Map(GetPlayerMap(MyIndex)).Name), QBColor(Green))
End If
' Battle messages
For I = 1 To MAX_BLT_LINE
If BattlePMsg(I).Index > 0 Then
If BattlePMsg(I).Time + 7000 > GetTickCount Then
Call DrawText(TexthDC, 1 + sx, BattlePMsg(I).y + frmMirage.picScreen.Height - 15 + sx, Trim(BattlePMsg(I).Msg), QBColor(BattlePMsg(I).Color))
Else
BattlePMsg(I).done = 0
End If
End If
If BattleMMsg(I).Index > 0 Then
If BattleMMsg(I).Time + 7000 > GetTickCount Then
Call DrawText(TexthDC, (frmMirage.picScreen.Width - (Len(BattleMMsg(I).Msg) * 8)) + sx, BattleMMsg(I).y + frmMirage.picScreen.Height - 15 + sx, Trim(BattleMMsg(I).Msg), QBColor(BattleMMsg(I).Color))
Else
BattleMMsg(I).done = 0
End If
End If
Next I
End If
End If
' Check if we are getting a map, and if we are tell them so
If GettingMap = True Then
Call DrawText(TexthDC, 36, 36, "...Receiving map...", QBColor(BrightCyan))
End If
' Release DC
Call DD_BackBuffer.ReleaseDC(TexthDC)
' Blit out emoticons
For I = 1 To MAX_PLAYERS
If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
Call BltEmoticons(I)
End If
Next I
' Get the rect for the back buffer to blit from
rec.Top = 0
rec.Bottom = (MAX_MAPY + 1) * PIC_Y
rec.Left = 0
rec.Right = (MAX_MAPX + 1) * PIC_X
' Get the rect to blit to
Call DX.GetWindowRect(frmMirage.picScreen.hwnd, rec_pos)
rec_pos.Bottom = rec_pos.Top - sx + ((MAX_MAPY + 1) * PIC_Y)
rec_pos.Right = rec_pos.Left - sx + ((MAX_MAPX + 1) * PIC_X)
rec_pos.Top = rec_pos.Bottom - ((MAX_MAPY + 1) * PIC_Y)
rec_pos.Left = rec_pos.Right - ((MAX_MAPX + 1) * PIC_X)
' Blit the backbuffer
Call DD_PrimarySurf.Blt(rec_pos, DD_BackBuffer, rec, DDBLT_WAIT)
If XToGo -1 Or YToGo -1 Then
Dim XDif As Long
Dim YDif As Long
XDif = Abs(GetPlayerX(MyIndex) - XToGo)
YDif = Abs(GetPlayerY(MyIndex) - YToGo)
If XToGo = GetPlayerX(MyIndex) Or XToGo = -1 Then
XToGo = -1
XDif = 0
Else
XDif = Abs(GetPlayerX(MyIndex) - XToGo)
End If
If YToGo = GetPlayerY(MyIndex) Or YToGo = -1 Then
YToGo = -1
YDif = 0
Else
YDif = Abs(GetPlayerY(MyIndex) - YToGo)
End If
Debug.Print (XDif & " " & YDif)
If XDif > YDif Then
If GetPlayerX(MyIndex) - XToGo > 0 Then
DirLeft = True
Else
DirRight = True
End If
End If
If YDif > XDif Then
If GetPlayerY(MyIndex) - YToGo > 0 Then
DirUp = True
Else
DirDown = True
End If
End If
If XDif = YDif And XDif 0 And YDif 0 Then
' I'll be nice and give you the non-directional movement code
'If Int(Rnd * 2) = 0 Then
If GetPlayerX(MyIndex) - XToGo > 0 Then
DirLeft = True
Else
DirRight = True
End If
' Else
If GetPlayerY(MyIndex) - YToGo > 0 Then
DirUp = True
Else
DirDown = True
End If
'End If
End If
End If
' Check if player is trying to move
Call CheckMovement
' Check to see if player is trying to attack
Call CheckAttack
' Process player and pet movements (actually move them)
For I = 1 To MAX_PLAYERS
If IsPlaying(I) Then
Call ProcessMovement(I)
If Player(I).Pet.Alive = YES Then
Call ProcessPetMovement(I)
End If
End If
Next I
' Process npc movements (actually move them)
For I = 1 To MAX_MAP_NPCS
If Map(GetPlayerMap(MyIndex)).Npc(I) > 0 Then
Call ProcessNpcMovement(I)
End If
Next I
' Change map animation every 250 milliseconds
If GetTickCount > MapAnimTimer + 250 Then
If MapAnim = 0 Then
MapAnim = 1
Else
MapAnim = 0
End If
MapAnimTimer = GetTickCount
End If
' Calculate fps
If GetTickCount > TickFPS + 1000 Then
GameFPS = FPS
TickFPS = GetTickCount
FPS = 0
Else
FPS = FPS + 1
End If
Call MakeMidiLoop
DoEvents
Loop
frmMirage.Visible = False
frmSendGetData.Visible = True
Call SetStatus("Destroying game data...")
' Shutdown the game
Call GameDestroy
' Report disconnection if server disconnects
If IsConnected = False Then
Call MsgBox("Thank you for playing " & GAME_NAME & "!", vbOKOnly, GAME_NAME)
End If
End Subany ideas ? i know its a hell of alot bigger than MS thats for sure
