Testing code ...

[Fox]

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:

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

I've got an idea for the next version.....


Find all the user defined functions in a piece of code, then find all the calls to those functions and highlight them in red or something. Sound good?

[Fox]

Why not.. I'll put that on the Todo-list

[barrk]

I don't think we're in Kansas anymore TodoIs that the list you meant?

[Fox]

Not really

well here's the same code above improved with latest version of vB Tool

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 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

Hey Fox, whats up with your link to your program in your signiture, I get loads of windows opening and making themselves full screen and trying to take over my homepage!!!!!

[Fox]

The link says Save as because if you just click it you'll reach a 404 page It's vb Tool 1.1 btw, but v2.0 will be released soon.

Originally posted by Fox
The link says Save as because if you just click it you'll reach a 404 page It's vb Tool 1.1 btw, but v2.0 will be released soon.

Oh I get you now, Are you going to have options to stop it from highlighting strings etc?

[Fox]

Sure, you can a) turn all options off and b) change each color if you want

When will I be able to get a copy about?

[Fox]

As soon as the new update system is finished

Be sure I'll post a message in the Chit Chat forum...

[Static]

I have found in my tool...with huge chunks of code...
you can easily go over the 10000 charcter limit.

I have made mine stretch the color tags to include multiple words (like how the comments are done)

so instead of [ Color ]Private[ /color ] [ color ]Sub[ /color ]
it does
[ Color ]Private Sub[ /color ]

helps alot...

I must say...Fast tagging though! Mine takes about 7 seconds on your code. (but in my defense...the code window is a RichTextBox and it must actually check the Color of the word and then tag it.... kinda cool actually 'cause you get to see what it will look like before its posted)

one more suggestion....make the form sizable...so you dont get the word wrap...

(and I noticed the Variables are green like comments)

I must say..the GUI is very sharp! love the colors and buttons...The copy button should say copy & convert though...just so its a little more obvious


GOOD JOB FOX!

Great Idea to color the API's!

[Fox]

Thanks geoff, but did you try out version 1? (The one in my signature?)

Becuase the v2.0 GUI has a "convert" button, not "copy" and you can turn on optimization... also you can select all colors of course. The tested code in this thread is just to test, so it's also to see which colors look best... oh and did you notice it formats your self-defined functions and variables?

Example:

Original code:

public sub MySub()
   dim A as string
   
   a = "test"

   msgbox a
end sub

public sub Main
   mysub
end sub

Formatted code:

Public Sub MySub()
   Dim A As String
   
   A = "test"

   MsgBox A
End Sub

Public Sub Main
   MySub
End Sub

If the forums limits it to 10000 characters, does your program alert the user of the output is over that amount?

[Fox]

Of course, what a dumb question! *jk* (in fact vBT1.x doesn't )

Grrrrrrrrrrrrrrrrrrrr

[Static]

LOL

Yes I tried v1

I am trying an idea....

if over 10000 say so..then strip all tags but comments....if still over..strip all tags....if still over then say no way..

I am close...
for some reason..after 'undo' all tags and try to do just the comments tags...it missed on placement of a few open color tags...it put them about 3 words in..

But ONLY in some places... Its driving me nuts!

It would be easy if I was just doing the words...But since I had to do it the hard way. (Does it but the Color of the word in the RTFbax) it gets confused in a few spots and misses the color change!

GRRRRR

Nice Idea to color Functions....



WHen will v2 be up?

[Fox]

v2.0BETA is ready for release today, im working on last improvements...

I'd say in 2 or 3 days I'll update to version 2 definitely, users of v1 will receive it thru the update program