Ok, I'm just doing a little code test.
Wow, it took 2 seconds to convert... (I activated everything, checking API codes, optimizing code...)
*phew* well here it is:
Code:Sub Game()
Dim Temp As Long
' PlaySound "Back.wav", True, 0
'Main loop
Active = True
While Active
Temp = GetTickCount
If ClearBuffer Then: ClearBackBuffer
If InGameEdit Then
'Input
CheckKeys
'Game stuff
mObjects.UpdatePosition
Else
'Input
CheckEditorKeys
End If
'Animate
mTiles.AnimateTiles
mObjects.AnimateObjects
'Draw
mLevel.Draw
mObjects.Draw
mMouse.Draw
'Clear memory
RemoveDeathObjects
'Slowdown before continue
While (Temp + (1000 / MaxFPS)) > GetTickCount
DoEvents
Wend
'Flip
mCamera.Flip
'Calculate FPS
If StartTime < GetTickCount Then
FPS = FrameCount
frmMain.lblFPS.Caption = "FPS: " & FPS
FrameCount = 0
StartTime = GetTickCount + 1000
End If
FrameCount = FrameCount + 1
DoEvents
Wend
frmMain.mnuRun.Checked = False
End Sub
Sub InstallWavMix()
If Dir(SysDir & "wavmix32.dll") = "" Then
'WaveMix dll not found in system directory
If MsgBox("wavmix32.dll was not found in your system directory.u" & NL2 & "Install it now?", vbQuestion Or vbYesNo, "WaveMix dll not found") = vbYes Then
If Dir(Path & "wavmix32.dl_") = "" Then
'File not found
MsgBox "wavmix32.dl_ was not found in current directory.", vbCritical, "Error installing WaveMix"
Else
'Install dll
FileCopy Path & "wavmix32.dl_", SysDir & "wavmix32.dll"
End If
Else
MsgBox "The program may not run properly.", vbInformation, "Warning"
End If
End If
'Check application directory
If Not Dir(Path & "wavmix32.dll") = "" Then
If MsgBox("Found wavmix32.dll in current directory." & NL2 & "Do you want to rename it to wavmix32.dl_ ?", vbQuestion Or vbYesNo, "Warning") = vbYes Then
'Found WaveMix dll
Name Path & "wavmix32.dll" As Path & "wavmix32.dl_"
Else
MsgBox "The program may not run properly.", vbInformation, "Warning"
End If
End If
End Sub
Sub Load(iFileName As String)
Dim FileNumber As Integer
Dim Temp As Long
'Reset
Reset
'Verify filename
If GetFile(iFileName) = "" Then
MsgBox "File not found:" & NL2 & iFileName, vbCritical, "Error loading"
Exit Sub
End If
'Load level
FileNumber = FreeFile
Open GetFile(iFileName) For Binary As FileNumber
'Level
With Level
'Map size
Get FileNumber, , .w
Get FileNumber, , .h
'Resize memory
ReDim .Sky(.w * .h)
ReDim .Back(.w * .h)
ReDim .Floor(.w * .h)
ReDim .Object(.w * .h)
'Load maps
Get FileNumber, , Level
End With
'Tileset
Get FileNumber, , TileCount
ReDim Tile(TileCount)
Get FileNumber, , Tile
'Objects
Get FileNumber, , SrcObjectCount
ReDim SrcObject(SrcObjectCount)
Get FileNumber, , SrcObject
Close FileNumber
'Load graphics
LoadTiles
LoadSrcObjects
mObjects.Reset
End Sub
Sub ExitProgram()
Settings.Save
ShutDown
End
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
KD(KeyCode) = True
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
KD(KeyCode) = False
End Sub
Private Sub Form_Load()
'Variables
Cpt = Me.Caption
'Settings
Settings.GetObjectPos frmEdit
Settings.GetObjectPos frmPreview
'Show windows
frmEdit.Show
frmPreview.Show
frmPreview.Title.SetOnTop True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Settings.SetObjectPos Me
Unload frmEdit
Unload frmPreview
ExitProgram
End Sub
Private Sub mnuAbout_Click()
Settings.GetObjectPos frmAbout
frmAbout.Show
frmAbout.Title.SetOnTop True
frmAbout.ShowCredits
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuExport_Click()
DoExportLevel
End Sub
Private Sub mnuHelp_Click()
Settings.GetObjectPos frmHelp
frmHelp.Show
End Sub
Private Sub mnuImport_Click()
DoImportLevel
End Sub
Private Sub mnuRun_Click()
mnuRun.Checked = Not mnuRun.Checked
If Level.Name = "" Then
'No level loaded
mnuRun.Checked = False
DoLoadLevel
Else
If mnuRun.Checked = True Then
'Run game
Game
Else
'Stop game
Active = False
End If
End If
End Sub
