├── BasicBoy ├── Res.res ├── db.frx ├── Render.frx ├── frmJoy.frx ├── frmAbout.frm ├── frmAbout.frx ├── frmCheat.frx ├── frmMain.frx ├── frmSplash.frx ├── frmSpeed.frx ├── MSSCCPRJ.SCC ├── xeonchangelog.txt ├── ReadMe.txt ├── ReadMe2.txt ├── Render.frm ├── CLS │ ├── DirectInput8.cls │ ├── clsDialog.cls │ ├── rtc.cls │ ├── clsDik2.cls │ └── DIKeyboard8.cls ├── DirectInput8.cls ├── frmOptions.frm ├── BasicBoy.vbw ├── modAppComm.bas ├── soundDebug.frm ├── modComLine.bas ├── clsSStream.frm ├── BasicBoy.VBP ├── clsSStream.cls ├── clsDialog.cls ├── frmSplash.frm ├── JOY.bas ├── rtc.cls ├── modLink.bas ├── dxEngine.bas ├── modRLECompression.bas ├── modVars.bas ├── clsDik2.cls ├── DIKeyboard8.cls ├── help.html ├── frmSpeed.frm ├── modSaveState.bas ├── frmCheat.frm ├── z80cmd.BAS ├── Sound.bas ├── frmDebugger.frm ├── db.frm ├── debugger.bas ├── modSoundEngine.bas └── frmJoy.frm ├── bnet ├── bnet.client │ ├── Client.exe │ ├── Client.vbw │ ├── Client.vbp │ └── frmClient.frm ├── bnet.server │ ├── Server.exe │ ├── Server.vbw │ ├── Server.vbp │ └── frmMain.frm ├── HowTo.txt ├── ReadMe_original.txt ├── modAppComm.bas └── bbAC.bas ├── README.md └── LICENSE /BasicBoy/Res.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/BasicBoy/Res.res -------------------------------------------------------------------------------- /BasicBoy/db.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/BasicBoy/db.frx -------------------------------------------------------------------------------- /BasicBoy/Render.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/BasicBoy/Render.frx -------------------------------------------------------------------------------- /BasicBoy/frmJoy.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/BasicBoy/frmJoy.frx -------------------------------------------------------------------------------- /BasicBoy/frmAbout.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/BasicBoy/frmAbout.frm -------------------------------------------------------------------------------- /BasicBoy/frmAbout.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/BasicBoy/frmAbout.frx -------------------------------------------------------------------------------- /BasicBoy/frmCheat.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/BasicBoy/frmCheat.frx -------------------------------------------------------------------------------- /BasicBoy/frmMain.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/BasicBoy/frmMain.frx -------------------------------------------------------------------------------- /BasicBoy/frmSplash.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/BasicBoy/frmSplash.frx -------------------------------------------------------------------------------- /bnet/bnet.client/Client.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/bnet/bnet.client/Client.exe -------------------------------------------------------------------------------- /bnet/bnet.server/Server.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/skmp/BasicBoy/HEAD/bnet/bnet.server/Server.exe -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | BasicBoy 2 | =============== 3 | 4 | A Gameboy/Gameboy Color emulator I wrote in VB6 a long, long time ago 5 | -------------------------------------------------------------------------------- /bnet/bnet.server/Server.vbw: -------------------------------------------------------------------------------- 1 | frmMain = 44, 44, 226, 390, , 22, 22, 394, 368, C 2 | bbAC = 66, 87, 627, 393, Z 3 | modAppComm = 44, 58, 605, 364, 4 | -------------------------------------------------------------------------------- /bnet/bnet.client/Client.vbw: -------------------------------------------------------------------------------- 1 | frmMain = 66, 66, 248, 412, , 44, 44, 416, 390, C 2 | bbAC = 44, 58, 605, 364, Z 3 | modAppComm = 88, 116, 649, 422, 4 | -------------------------------------------------------------------------------- /BasicBoy/frmSpeed.frx: -------------------------------------------------------------------------------- 1 | Underclocking will make the emulator run faster (less cycles for each vsync).Overclocking will decrese loading time (if any) but will make the emulator slower (more cycles for each vsync) Warning:Using this may make the game unstable -------------------------------------------------------------------------------- /BasicBoy/MSSCCPRJ.SCC: -------------------------------------------------------------------------------- 1 | [SCC] 2 | SCC=This is a source code control file 3 | [PROJECT1.VBP] 4 | SCC_Project_Name=this project is not under source code control 5 | SCC_Aux_Path= 6 | [BasicBoy.VBP] 7 | SCC_Project_Name=this project is not under source code control 8 | SCC_Aux_Path= 9 | -------------------------------------------------------------------------------- /BasicBoy/xeonchangelog.txt: -------------------------------------------------------------------------------- 1 | This is stuff xeon has changed or added to the emulator 2 | to make it better than what was ever thought possible :P. 3 | 4 | - Redid About Box 5 | - Re-arranged menu's and added more menu options, Sound, etc. 6 | - Added Save States, 8 slots for EACH GAME!! (Works Pretty Good) 7 | - Redid ROM Info Dialog, now shows if rom is GBC! 8 | - Made Complete Help Document for BasicBoy -------------------------------------------------------------------------------- /bnet/HowTo.txt: -------------------------------------------------------------------------------- 1 | This will not work with Firewalls/NAT's(on the server side) 2 | load bnet.client/server, connect, 3 | press reinit link connection, 4 | open basicboy ,click options-> 5 | emulated hardware->emulate link. 6 | The emulator should link with the chat 7 | (hehe this sounds a bit strange...). 8 | 9 | Notes: 10 | ***The speed is Realy bad*** 11 | It may not work with slow connections/some 12 | roms...It is olny tested with Pokemon Gold 13 | 14 | -------------------------------------------------------------------------------- /BasicBoy/ReadMe.txt: -------------------------------------------------------------------------------- 1 | disclaimer: 2 | no warranty of any kind, use at your own risk. 3 | This program is guaranteed to do nothing but 4 | taking disk space. Don't blame me if it damages 5 | your computer, or erases your hard drive, etc. 6 | Using copyrighted roms with this emulator is 7 | ILLEGAL, especially if you don't own the real 8 | cartridge. If you choose to do so, that is 9 | your responsibility. 10 | 11 | The included roms are public domain 12 | wich means that they are LEGAL. -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Licensed under the Apache License, Version 2.0 (the "License"); 2 | You may not use this file except in compliance with the License. 3 | You may obtain a copy of the license at: 4 | http://www.apache.org/licenses/LICENSE-2.0 5 | 6 | Unless required by applicable law or agreed to in writing, 7 | software distributed under the License is distributed on an "AS IS" BASIS, 8 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 9 | See the License for the specific language governing permissions and limitations under the license. -------------------------------------------------------------------------------- /BasicBoy/ReadMe2.txt: -------------------------------------------------------------------------------- 1 | BasicBoy is A gameboy emulator coded in Visual Basic (+Api+dx). 2 | Currently it Suports GameBoy(95%) /GameBoy Color(95%) and MBC1,MBC3(with RTC),MBC5.It has link(100%) and sound (90%) support. 3 | New in this version (2.0.0): 4 | Sound Channel 4 emulation,New sound generation system 5 | optimized cpu code,Better GUI 6 | Bugs: 7 | hmmm It seems that all my roms run corectly ..;) 8 | You can download legal roms at www.pdroms.com . 9 | Please leave coments and vote 10 | 11 | Update :2.0.1 Some Frame limiting fixes 12 | Update#2 : 2.0.2 Some cpu bugs fixed,Over-Underclock cpu,More sound options 13 | Update#3 :2.0.3 Better sound -------------------------------------------------------------------------------- /BasicBoy/Render.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmRender 3 | AutoRedraw = -1 'True 4 | BorderStyle = 0 'None 5 | ClientHeight = 1305 6 | ClientLeft = 0 7 | ClientTop = 0 8 | ClientWidth = 1080 9 | Icon = "Render.frx":0000 10 | LinkTopic = "Form2" 11 | ScaleHeight = 1305 12 | ScaleWidth = 1080 13 | ShowInTaskbar = 0 'False 14 | StartUpPosition = 3 'Windows Default 15 | End 16 | Attribute VB_Name = "frmRender" 17 | Attribute VB_GlobalNameSpace = False 18 | Attribute VB_Creatable = False 19 | Attribute VB_PredeclaredId = True 20 | Attribute VB_Exposed = False 21 | Private Sub Form_Click() 22 | End 23 | End Sub 24 | 25 | Private Sub Form_Initialize() 26 | Call InitCommonControls 27 | End Sub 28 | 29 | Private Sub Form_Load() 30 | Call InitCommonControls 31 | End Sub 32 | -------------------------------------------------------------------------------- /bnet/ReadMe_original.txt: -------------------------------------------------------------------------------- 1 | Title: Client-Server Example using VB's Winsock control 2 | Description: This completely-commented project demonstrates the use of Winsock in a server-client connection. Demonstrates how to use the connection as a remote, similar to Sub7 (client sends commands to the server, server responds with API calls, etc.), as well as a private chat connection between the server and client. **Developers who are not familiar with VB's winsock control: This download is a must! 3 | Note: This is my 8th project uploaded since Sunday morning :D 4 | This file came from Planet-Source-Code.com...the home millions of lines of source code 5 | You can view comments on this code/and or vote on it at: http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=12421&lngWId=1 6 | 7 | The author may have retained certain copyrights to this code...please observe their request and the law by reviewing all copyright conditions at the above URL. 8 | -------------------------------------------------------------------------------- /BasicBoy/CLS/DirectInput8.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "clsDirectInput8" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | Option Base 0 16 | 17 | Dim objDI As DirectInput8 18 | 19 | Private Sub Class_Terminate() 20 | Set objDI = Nothing 21 | End Sub 22 | 23 | Public Property Get DIObj() As DirectInput8 24 | Set DIObj = objDI 25 | End Property 26 | 27 | Public Property Get DXObj() As DirectX8 28 | Set DXObj = dx8 29 | End Property 30 | 31 | Public Sub Startup(ByRef lWindowHandle As Long) 32 | 'initialize DirectInput 33 | Set objDI = dx8.DirectInputCreate 34 | End Sub 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /BasicBoy/DirectInput8.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "clsDirectInput8" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | Option Base 0 16 | 17 | Dim objDI As DirectInput8 18 | 19 | Private Sub Class_Terminate() 20 | Set objDI = Nothing 21 | End Sub 22 | 23 | Public Property Get DIObj() As DirectInput8 24 | Set DIObj = objDI 25 | End Property 26 | 27 | Public Property Get DXObj() As DirectX8 28 | Set DXObj = dx8 29 | End Property 30 | 31 | Public Sub Startup(ByRef lWindowHandle As Long) 32 | 'initialize DirectInput 33 | Set objDI = dx8.DirectInputCreate 34 | End Sub 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /bnet/bnet.client/Client.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINDOWS\System32\stdole2.tlb#OLE Automation 3 | Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCK.OCX 4 | Form=frmClient.frm 5 | Module=bbAC; ..\bbAC.bas 6 | Module=modAppComm; ..\modAppComm.bas 7 | IconForm="frmMain" 8 | Startup="frmMain" 9 | HelpFile="" 10 | Title="Client-Server Example" 11 | ExeName32="Client.exe" 12 | Command32="" 13 | Name="Client" 14 | HelpContextID="0" 15 | CompatibleMode="0" 16 | MajorVer=1 17 | MinorVer=0 18 | RevisionVer=0 19 | AutoIncrementVer=0 20 | ServerSupportFiles=0 21 | VersionCompanyName="Patrick Moore (Zelda)" 22 | CompilationType=0 23 | OptimizationType=0 24 | FavorPentiumPro(tm)=0 25 | CodeViewDebugInfo=0 26 | NoAliasing=0 27 | BoundsCheck=0 28 | OverflowCheck=0 29 | FlPointCheck=0 30 | FDIVCheck=0 31 | UnroundedFP=0 32 | StartMode=0 33 | Unattended=0 34 | Retained=0 35 | ThreadPerObject=0 36 | MaxNumberOfThreads=1 37 | -------------------------------------------------------------------------------- /bnet/bnet.server/Server.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=frmMain.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINDOWS\System32\stdole2.tlb#OLE Automation 4 | Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCK.OCX 5 | Module=bbAC; ..\bbAC.bas 6 | Module=modAppComm; ..\modAppComm.bas 7 | IconForm="frmMain" 8 | Startup="frmMain" 9 | HelpFile="" 10 | Title="Client-Server Example" 11 | ExeName32="Server.exe" 12 | Command32="" 13 | Name="Server" 14 | HelpContextID="0" 15 | CompatibleMode="0" 16 | MajorVer=1 17 | MinorVer=0 18 | RevisionVer=0 19 | AutoIncrementVer=0 20 | ServerSupportFiles=0 21 | VersionCompanyName="Patrick Moore (Zelda)" 22 | CompilationType=0 23 | OptimizationType=0 24 | FavorPentiumPro(tm)=0 25 | CodeViewDebugInfo=0 26 | NoAliasing=0 27 | BoundsCheck=0 28 | OverflowCheck=0 29 | FlPointCheck=0 30 | FDIVCheck=0 31 | UnroundedFP=0 32 | StartMode=0 33 | Unattended=0 34 | Retained=0 35 | ThreadPerObject=0 36 | MaxNumberOfThreads=1 37 | -------------------------------------------------------------------------------- /BasicBoy/frmOptions.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmOptions 3 | Caption = "Configure" 4 | ClientHeight = 5445 5 | ClientLeft = 60 6 | ClientTop = 450 7 | ClientWidth = 6255 8 | LinkTopic = "Form1" 9 | ScaleHeight = 5445 10 | ScaleWidth = 6255 11 | StartUpPosition = 3 'Windows Default 12 | Begin VB.CheckBox chkSound 13 | Caption = "Emulate Sound" 14 | Height = 195 15 | Left = 1080 16 | TabIndex = 1 17 | Top = 1020 18 | Width = 2055 19 | End 20 | Begin VB.CheckBox chkEGBC 21 | Caption = "Emulate GameBoy Color" 22 | Height = 375 23 | Left = 1080 24 | TabIndex = 0 25 | Top = 720 26 | Width = 2055 27 | End 28 | End 29 | Attribute VB_Name = "frmOptions" 30 | Attribute VB_GlobalNameSpace = False 31 | Attribute VB_Creatable = False 32 | Attribute VB_PredeclaredId = True 33 | Attribute VB_Exposed = False 34 | -------------------------------------------------------------------------------- /BasicBoy/BasicBoy.vbw: -------------------------------------------------------------------------------- 1 | modz80 = 22, 29, 721, 290, 2 | modMem = 44, 58, 602, 364, 3 | modGrfx = 0, 0, 699, 261, 4 | frmRomInfo = 0, 0, 0, 0, C, 88, 116, 660, 377, C 5 | Declares = 22, 29, 576, 328, 6 | clsDIKeyboard8 = 0, 0, 0, 0, C 7 | clsDirectInput8 = 0, 0, 0, 0, C 8 | frmRender = 0, 0, 0, 0, C, 66, 87, 638, 348, C 9 | modSoundInterface = 44, 58, 598, 357, 10 | frmCheat = 88, 116, 642, 490, , 22, 29, 594, 290, C 11 | modAppComm = 22, 29, 576, 328, 12 | modLink = 66, 87, 620, 386, 13 | clsDialog = 44, 58, 743, 319, 14 | modJOY = 44, 58, 598, 357, 15 | frmJoy = 0, 0, 0, 0, C, 44, 58, 616, 319, C 16 | clsDik2 = 0, 0, 0, 0, C 17 | frmMain = 22, 29, 580, 334, , 66, 87, 638, 348, C 18 | modDXEngine = 0, 0, 685, 306, 19 | rtc = 0, 0, 0, 0, C 20 | modVars = 88, 116, 541, 422, 21 | clsSStream = 0, 0, 0, 0, C, 88, 116, 660, 377, C 22 | modSoundChip = 0, 0, 554, 299, 23 | frmAbout = 56, 205, 614, 511, , 0, 0, 572, 261, C 24 | frmSplash = 88, 116, 787, 377, , 22, 29, 594, 290, C 25 | modSaveState = 110, 145, 664, 444, 26 | modRLECompression = 88, 116, 642, 415, 27 | modZ80cmd = 22, 29, 576, 328, 28 | modComLine = 66, 87, 624, 393, 29 | frmSpeed = 66, 87, 645, 371, , 88, 116, 667, 400, C 30 | -------------------------------------------------------------------------------- /BasicBoy/modAppComm.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modAppComm" 2 | 'This is a part of the BasicBoy emulator 3 | 'You are not allowed to release modified(or unmodified) versions 4 | 'without asking me (Raziel). 5 | 'For Suggestions ect please e-mail at :stef_mp@yahoo.gr 6 | 'To download the latest version/source goto basicboy.emuhost.com 7 | '(I know the emulator is NOT OPTIMIZED AT ALL) 8 | 9 | 10 | 11 | 'v1.1.1 12 | 'App comm function (based on Black Tornado's Trainer Maker Kit) 13 | 'I'm using direct memory writes 14 | 'Comments added 15 | 'hmm,This can be done with subclassing too 16 | 17 | 'Sory for my bad english ... 18 | Option Explicit 19 | Public BBhWnd As Long, MemAddr As Long, wlen As Integer 20 | Sub init(InitData As String, Length As Integer, ptr As Long) 'Init the MemIo system 21 | BBhWnd = InitData 22 | MemAddr = ptr 23 | wlen = Length 24 | End Sub 25 | 26 | Public Function Send(value() As Byte) As Boolean 'Send a value 27 | Dim ProcessID As Long 28 | Dim ProcessHandle As Long 29 | If BBhWnd = False Then Send = False: Exit Function 30 | GetWindowThreadProcessId BBhWnd, ProcessID 31 | ProcessHandle = OpenProcess(2035711, False, ProcessID) 32 | Call WriteProcessMemory(ProcessHandle, MemAddr, value(0), wlen, 0&) 33 | CloseHandle ProcessHandle 34 | Send = True 35 | End Function 36 | -------------------------------------------------------------------------------- /BasicBoy/soundDebug.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form Form1 3 | Caption = "Form1" 4 | ClientHeight = 8670 5 | ClientLeft = 60 6 | ClientTop = 450 7 | ClientWidth = 6855 8 | LinkTopic = "Form1" 9 | ScaleHeight = 8670 10 | ScaleWidth = 6855 11 | StartUpPosition = 3 'Windows Default 12 | Begin VB.Timer Timer1 13 | Interval = 10 14 | Left = 2400 15 | Top = 3600 16 | End 17 | Begin VB.Label Label1 18 | Caption = "Label1" 19 | Height = 8535 20 | Left = 0 21 | TabIndex = 0 22 | Top = 120 23 | Width = 6855 24 | End 25 | End 26 | Attribute VB_Name = "Form1" 27 | Attribute VB_GlobalNameSpace = False 28 | Attribute VB_Creatable = False 29 | Attribute VB_PredeclaredId = True 30 | Attribute VB_Exposed = False 31 | Private Sub Timer1_Timer() 32 | Dim i As Long 33 | clsc 34 | prt "GB sound regs:" 35 | For i = 65296 To 65318 36 | prt Hex$(i) & " : " & "value = " & RAM(i, 0) 37 | Next i 38 | 39 | prt CStr(wave3.MCount) 40 | prt CStr(((1 / (65536 / (2048 - (RAM(65309, 0) + (RAM(65310, 0) And 7) * 256)))) * 44100) / 32) '32 wave phases 41 | 42 | End Sub 43 | Sub prt(str As String) 44 | Label1.Caption = Label1.Caption & str & vbNewLine 45 | End Sub 46 | Sub clsc() 47 | Label1.Caption = "" 48 | End Sub 49 | 50 | 51 | -------------------------------------------------------------------------------- /BasicBoy/modComLine.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modComLine" 2 | 'Command Line boot (exename romname) 3 | 'Added by Christopher 4 | Option Explicit 5 | Sub Main() 6 | Dim strtemp As String, bol As Boolean, tls As String, i As Long 7 | Dim f As String 8 | framedelay = 16 9 | 'Form1.Show 10 | frmMain.Show 11 | frmSplash.Show 12 | 13 | On Local Error GoTo ErrorHandler 14 | If InStr(command$, ".g") Or InStr(command$, ".c") Then 15 | 16 | f = Replace(command$, """", "") 17 | 18 | If loadrom(f) Then 19 | initCI 20 | rdRam 21 | If mm = 2 Then 22 | initGxMode2 frmMain.Picture1, zm 23 | Else 24 | initGxMode1 zm, frmMain.full.Checked 25 | End If 26 | If TGBC Then 27 | If ROM(&H143, 0) = 192 Then strtemp = "(GBC) ": GBM = 1 Else If ROM(&H143, 0) <> 0 Then strtemp = "(GB/GBC) ": GBM = 1 Else strtemp = "(GB) ": GBM = 0 28 | Else 29 | If ROM(&H143, 0) = 192 Then strtemp = "(GBC) " Else If ROM(&H143, 0) <> 0 Then strtemp = "(GB/GBC) " Else strtemp = "(GB) " 30 | GBM = 0 31 | End If 32 | frmMain.resize 33 | reset 34 | tls = "" 35 | For i = 0 To 15 36 | If rominfo.titleB(i) = 0 Then GoTo tiend 37 | tls = tls & Chr(rominfo.titleB(i)) 38 | Next i 39 | tiend: 40 | rominfo.Title = tls 41 | frmMain.Caption = "BasicBoy - " & tls & " " & strtemp 42 | initWave 43 | frmMain.rp_Click 44 | End If 45 | End If 46 | 47 | 48 | 49 | 50 | 51 | err.Clear 52 | ErrorHandler: 53 | If err.Number <> 0 Then 54 | MsgBox "An Error Occurred trying to load your ROM:" & vbCrLf & vbCrLf & err.Description, vbCritical, "Error " & err.Number 55 | End If 56 | End Sub 57 | 58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /bnet/modAppComm.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modAppComm" 2 | 'This is a part of the BasicBoy emulator 3 | 'You are not allowed to release modified(or unmodified) versions 4 | 'without asking me (Raziel). 5 | 'For Suggestions ect please e-mail at :stef_mp@yahoo.gr 6 | 'To download the latest version/source goto basicboy.emuhost.com 7 | '(I know the emulator is NOT OPTIMIZED AT ALL) 8 | 9 | 10 | 11 | 'v1.1.1 12 | 'App comm function (based on Black Tornado's Trainer Maker Kit) 13 | 'I'm using direct memory writes 14 | 'Comments added 15 | 'hmm,This can be done with subclassing too 16 | 17 | 'Sory for my bad english ... 18 | Option Explicit 19 | Public BBhWnd As Long, MemAddr As Long, wlen As Integer 20 | Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessID As Long) As Long 21 | Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 22 | Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long 23 | Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 24 | Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long 25 | Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long 26 | 27 | Sub init(InitData As String, Length As Integer, ptr As Long) 'Init the MemIo system 28 | BBhWnd = InitData 29 | MemAddr = ptr 30 | wlen = Length 31 | End Sub 32 | 33 | Public Function Send(value() As Byte) As Boolean 'Send a value 34 | Dim ProcessID As Long 35 | Dim ProcessHandle As Long 36 | If BBhWnd = False Then Send = False: Exit Function 37 | GetWindowThreadProcessId BBhWnd, ProcessID 38 | ProcessHandle = OpenProcess(2035711, False, ProcessID) 39 | Call WriteProcessMemory(ProcessHandle, MemAddr, value(0), wlen, 0&) 40 | CloseHandle ProcessHandle 41 | Send = True 42 | End Function 43 | -------------------------------------------------------------------------------- /BasicBoy/clsSStream.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form clsSStream 3 | Caption = "Form1" 4 | ClientHeight = 3090 5 | ClientLeft = 60 6 | ClientTop = 450 7 | ClientWidth = 4680 8 | LinkTopic = "Form1" 9 | ScaleHeight = 3090 10 | ScaleWidth = 4680 11 | StartUpPosition = 3 'Windows Default 12 | End 13 | Attribute VB_Name = "clsSStream" 14 | Attribute VB_GlobalNameSpace = False 15 | Attribute VB_Creatable = False 16 | Attribute VB_PredeclaredId = True 17 | Attribute VB_Exposed = False 18 | 'implements a Streamed sound buffer with dynamicaly generated data 19 | Option Explicit 20 | Option Base 0 21 | Public bufflen As Long, halfbuf As Long 22 | Public ev0 As Long, ev1 As Long 23 | Public ch As DirectSoundSecondaryBuffer8 24 | Dim bd As DSBUFFERDESC 25 | Dim i As Long 26 | Dim pn(1) As DSBPOSITIONNOTIFY 27 | Implements DirectXEvent8 28 | Sub init(buflen As Long) 29 | bufflen = buflen 30 | Set dx8 = New DirectX8 31 | ev0 = dx8.CreateEvent(Me) 32 | ev1 = dx8.CreateEvent(Me) 33 | Set dsound = dx8.DirectSoundCreate("") 34 | dsound.SetCooperativeLevel frmMain.hwnd, DSSCL_NORMAL 35 | 36 | bd.fxFormat.nFormatTag = WAVE_FORMAT_PCM 37 | bd.fxFormat.nChannels = 1 38 | bd.fxFormat.lSamplesPerSec = 44100 39 | bd.fxFormat.nBitsPerSample = 8 40 | bd.fxFormat.nBlockAlign = 1 41 | bd.fxFormat.lAvgBytesPerSec = bd.fxFormat.lSamplesPerSec * bd.fxFormat.nBlockAlign 42 | bd.lFlags = DSBCAPS_GETCURRENTPOSITION2 Or DSBCAPS_CTRLPOSITIONNOTIFY Or DSBCAPS_STATIC Or (DSBCAPS_LOCSOFTWARE * ssound) 43 | '**********************If sound is bad try increasing the buffer here*********************** 44 | bd.lBufferBytes = bufflen ' x ms buffer , x\2 ms delay 45 | Set ch = dsound.CreateSoundBuffer(bd) 46 | pn(0).hEventNotify = ev0 47 | pn(0).lOffset = bd.lBufferBytes / 2 + 1 48 | pn(1).hEventNotify = ev1 49 | pn(1).lOffset = 1 50 | ch.SetNotificationPositions 2, pn 51 | End Sub 52 | Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) 53 | Select Case eventid 54 | Case ev0 'play >half write 0 (0-half-1) 55 | generate 0 56 | Case ev1 'Play wlen Then si = si - wlen 56 | Next i 57 | End Sub 58 | Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) 59 | Select Case eventid 60 | Case ev0 'write from 0 to midle 61 | createWave bufflen / 2 62 | ch.WriteBuffer 0, bufflen / 2, buff(0), DSBLOCK_DEFAULT 63 | Case ev1 'write from midle to end 64 | createWave bufflen / 2 65 | ch.WriteBuffer bufflen / 2, bufflen / 2, buff(0), DSBLOCK_DEFAULT 66 | End Select 67 | End Sub 68 | 69 | -------------------------------------------------------------------------------- /bnet/bbAC.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "bbAC" 2 | 'This is a part of the BasicBoy emulator 3 | 'You are not allowed to release modified(or unmodified) versions 4 | 'without asking me (Raziel). 5 | 'For Suggestions ect please e-mail at :stef_mp@yahoo.gr 6 | 'To download the latest version/source goto basicboy.emuhost.com 7 | '(I know the emulator is NOT OPTIMIZED AT ALL) 8 | 9 | 10 | 11 | 'v2.0.1 12 | 'Link emulation ... 13 | 'Almost full emulation (no speed limitation) 14 | 'comments added 15 | 16 | 'Sory for my bad english ... 17 | 18 | Option Explicit 19 | Public LinkState As Long 20 | Public TdataB(1) As Byte, tmp As Long, id As String, t2(1) As Byte, Bs As Long, sent As Boolean, tmpdat(255) As Byte 21 | Sub Con() ' connect 22 | Dim tset As Long 23 | tset = GetSetting("BasicBoy", "link", "COP", "0") 24 | If tset And 1 Then 'we are at slot 1 25 | If tset = 3 Then Exit Sub 26 | tset = 3: SaveSetting "BasicBoy", "link", "LID2", frmMain.hwnd 27 | SaveSetting "BasicBoy", "link", "ptr2", VarPtr(TdataB(0)) 28 | LinkState = 3 29 | ElseIf tset And 2 Then 'we are at slot 2 30 | tset = 3: SaveSetting "BasicBoy", "link", "LID1", frmMain.hwnd 31 | SaveSetting "BasicBoy", "link", "ptr1", VarPtr(TdataB(0)) 32 | LinkState = 2 33 | Else 'well, we can chose slot 1 or 2 34 | tset = 1: SaveSetting "BasicBoy", "link", "LID1", frmMain.hwnd 35 | SaveSetting "BasicBoy", "link", "ptr1", VarPtr(TdataB(0)) 36 | LinkState = 2 37 | End If 38 | SaveSetting "BasicBoy", "link", "COP", tset 39 | End Sub 40 | Sub check_link_connection() 41 | If GetSetting("BasicBoy", "link", "COP", "0") = 3 And LinkState > 1 Then 42 | Select Case LinkState 43 | Case 2 44 | init GetSetting("BasicBoy", "link", "LID2"), 2, GetSetting("BasicBoy", "link", "ptr2") 45 | frmMain.Caption = frmMain.Caption & "*Conected (BB1)*" 46 | LinkState = 1 47 | Case 3 48 | init GetSetting("BasicBoy", "link", "LID1"), 2, GetSetting("BasicBoy", "link", "ptr1") 49 | frmMain.Caption = frmMain.Caption & "*Conected (BB2)*" 50 | LinkState = 1 51 | End Select 52 | End If 53 | End Sub 54 | Sub link_kill() 55 | SaveSetting "BasicBoy", "link", "LID1", 0 56 | SaveSetting "BasicBoy", "link", "ptr1", 0 57 | SaveSetting "BasicBoy", "link", "LID2", 0 58 | SaveSetting "BasicBoy", "link", "ptr2", 0 59 | SaveSetting "BasicBoy", "link", "COP", 0 60 | End Sub 61 | 62 | Sub Check() 'check the link state 63 | If TdataB(0) = 1 Then ' is this a recieve msg?? 64 | 'send the data 65 | frmMain.SendData2 Chr$(9) & Chr$(TdataB(1)) 66 | 'reset the data 67 | TdataB(0) = 0 68 | TdataB(1) = 0 69 | End If 70 | End Sub 71 | 72 | 73 | 74 | -------------------------------------------------------------------------------- /BasicBoy/clsDialog.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "clsDialog" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Private cdlg As OPENFILENAME 17 | Private LastFileName As String 18 | 19 | Public Function ShowOpen(ByVal Form_hWnd As Long, ByVal Title As String, ByVal InitDir As String, ByVal Filter As String) As String 20 | Dim i As Integer 21 | If Filter = "" Then Filter = "All Files (*.*)" 22 | Filter = Replace(Filter, "|", Chr(0)) 23 | If Right(Filter, 1) <> Chr(0) Then Filter = Filter & Chr(0) 24 | If InitDir = "" Then InitDir = LastFileName & Chr(0) 25 | cdlg.lStructSize = Len(cdlg) 26 | cdlg.hwndOwner = Form_hWnd 27 | cdlg.hInstance = App.hInstance 28 | cdlg.lpstrFilter = Filter 29 | cdlg.lpstrFile = Space(254) 30 | cdlg.nMaxFile = 255 31 | cdlg.lpstrFileTitle = Space(254) 32 | cdlg.nMaxFileTitle = 255 33 | cdlg.lpstrInitialDir = InitDir & Chr(0) 34 | cdlg.lpstrTitle = Title 35 | cdlg.Flags = OFN_LONGNAMES Or OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST 36 | ShowOpen = IIf(GetOpenFileName(cdlg), Trim(cdlg.lpstrFile), "") 37 | If Len(ShowOpen) > 0 Then LastFileName = ShowOpen 38 | End Function 39 | 40 | Public Function ShowSave(ByVal Form_hWnd As Long, ByVal Title As String, ByVal InitDir As String, ByVal Filter As String, ByVal DefExt As String) As String 41 | If Filter = "" Then Filter = "All Files (*.*)" 42 | Dim i As Integer 43 | For i = 1 To Len(Filter) 44 | If Mid(Filter, i, 1) = "|" Then Mid(Filter, i, 1) = Chr(0) 45 | Next i 46 | If Mid(Filter, Len(Filter), 1) <> Chr(0) Then Filter = Filter & Chr(0) 47 | If InitDir = "" Then InitDir = LastFileName 48 | cdlg.lStructSize = Len(cdlg) 49 | cdlg.lpstrTitle = Title 50 | cdlg.hwndOwner = Form_hWnd 51 | cdlg.hInstance = App.hInstance 52 | cdlg.lpstrFilter = Filter 53 | cdlg.lpstrDefExt = DefExt 54 | cdlg.lpstrFile = Space(254) 55 | cdlg.nMaxFile = 255 56 | cdlg.lpstrFileTitle = Space(254) 57 | cdlg.nMaxFileTitle = 255 58 | cdlg.lpstrInitialDir = InitDir 59 | cdlg.Flags = OFN_OVERWRITEPROMPT Or OFN_LONGNAMES Or OFN_NODEREFERENCELINKS Or OFN_PATHMUSTEXIST 60 | ShowSave = IIf(GetSaveFileName(cdlg), Trim(cdlg.lpstrFile), "") 61 | If Len(ShowSave) > 0 Then LastFileName = ShowSave 62 | End Function 63 | 64 | Public Property Let FileName(szFileName) 65 | LastFileName = szFileName 66 | End Property 67 | 68 | Public Property Get FileName() 69 | FileName = LastFileName 70 | End Property 71 | 72 | -------------------------------------------------------------------------------- /BasicBoy/CLS/clsDialog.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "clsDialog" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Private cdlg As OPENFILENAME 17 | Private LastFileName As String 18 | 19 | Public Function ShowOpen(ByVal Form_hWnd As Long, ByVal Title As String, ByVal InitDir As String, ByVal Filter As String) As String 20 | Dim i As Integer 21 | If Filter = "" Then Filter = "All Files (*.*)" 22 | Filter = Replace(Filter, "|", Chr(0)) 23 | If Right(Filter, 1) <> Chr(0) Then Filter = Filter & Chr(0) 24 | If InitDir = "" Then InitDir = LastFileName & Chr(0) 25 | cdlg.lStructSize = Len(cdlg) 26 | cdlg.hwndOwner = Form_hWnd 27 | cdlg.hInstance = App.hInstance 28 | cdlg.lpstrFilter = Filter 29 | cdlg.lpstrFile = Space(254) 30 | cdlg.nMaxFile = 255 31 | cdlg.lpstrFileTitle = Space(254) 32 | cdlg.nMaxFileTitle = 255 33 | cdlg.lpstrInitialDir = InitDir & Chr(0) 34 | cdlg.lpstrTitle = Title 35 | cdlg.Flags = OFN_LONGNAMES Or OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST 36 | ShowOpen = IIf(GetOpenFileName(cdlg), Trim(cdlg.lpstrFile), "") 37 | If Len(ShowOpen) > 0 Then LastFileName = ShowOpen 38 | End Function 39 | 40 | Public Function ShowSave(ByVal Form_hWnd As Long, ByVal Title As String, ByVal InitDir As String, ByVal Filter As String, ByVal DefExt As String) As String 41 | If Filter = "" Then Filter = "All Files (*.*)" 42 | Dim i As Integer 43 | For i = 1 To Len(Filter) 44 | If Mid(Filter, i, 1) = "|" Then Mid(Filter, i, 1) = Chr(0) 45 | Next i 46 | If Mid(Filter, Len(Filter), 1) <> Chr(0) Then Filter = Filter & Chr(0) 47 | If InitDir = "" Then InitDir = LastFileName 48 | cdlg.lStructSize = Len(cdlg) 49 | cdlg.lpstrTitle = Title 50 | cdlg.hwndOwner = Form_hWnd 51 | cdlg.hInstance = App.hInstance 52 | cdlg.lpstrFilter = Filter 53 | cdlg.lpstrDefExt = DefExt 54 | cdlg.lpstrFile = Space(254) 55 | cdlg.nMaxFile = 255 56 | cdlg.lpstrFileTitle = Space(254) 57 | cdlg.nMaxFileTitle = 255 58 | cdlg.lpstrInitialDir = InitDir 59 | cdlg.Flags = OFN_OVERWRITEPROMPT Or OFN_LONGNAMES Or OFN_NODEREFERENCELINKS Or OFN_PATHMUSTEXIST 60 | ShowSave = IIf(GetSaveFileName(cdlg), Trim(cdlg.lpstrFile), "") 61 | If Len(ShowSave) > 0 Then LastFileName = ShowSave 62 | End Function 63 | 64 | Public Property Let FileName(szFileName) 65 | LastFileName = szFileName 66 | End Property 67 | 68 | Public Property Get FileName() 69 | FileName = LastFileName 70 | End Property 71 | 72 | -------------------------------------------------------------------------------- /BasicBoy/frmSplash.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmSplash 3 | BorderStyle = 0 'None 4 | ClientHeight = 3930 5 | ClientLeft = 210 6 | ClientTop = 1365 7 | ClientWidth = 7380 8 | ClipControls = 0 'False 9 | ControlBox = 0 'False 10 | BeginProperty Font 11 | Name = "Tahoma" 12 | Size = 8.25 13 | Charset = 0 14 | Weight = 400 15 | Underline = 0 'False 16 | Italic = 0 'False 17 | Strikethrough = 0 'False 18 | EndProperty 19 | Icon = "frmSplash.frx":0000 20 | KeyPreview = -1 'True 21 | LinkTopic = "Form2" 22 | MaxButton = 0 'False 23 | MinButton = 0 'False 24 | Picture = "frmSplash.frx":000C 25 | ScaleHeight = 3930 26 | ScaleWidth = 7380 27 | ShowInTaskbar = 0 'False 28 | StartUpPosition = 2 'CenterScreen 29 | Begin VB.Timer Timer1 30 | Interval = 3000 31 | Left = 6840 32 | Top = 120 33 | End 34 | Begin VB.Label Label1 35 | Alignment = 1 'Right Justify 36 | BackStyle = 0 'Transparent 37 | Caption = "Coded by Raziel" 38 | BeginProperty Font 39 | Name = "Tahoma" 40 | Size = 8.25 41 | Charset = 0 42 | Weight = 700 43 | Underline = 0 'False 44 | Italic = 0 'False 45 | Strikethrough = 0 'False 46 | EndProperty 47 | ForeColor = &H00FFFFFF& 48 | Height = 255 49 | Left = 4320 50 | TabIndex = 1 51 | Top = 3480 52 | Width = 2775 53 | End 54 | Begin VB.Label lblVersion 55 | Alignment = 1 'Right Justify 56 | BackStyle = 0 'Transparent 57 | Caption = "Version" 58 | BeginProperty Font 59 | Name = "Tahoma" 60 | Size = 8.25 61 | Charset = 0 62 | Weight = 700 63 | Underline = 0 'False 64 | Italic = 0 'False 65 | Strikethrough = 0 'False 66 | EndProperty 67 | ForeColor = &H00FFFFFF& 68 | Height = 255 69 | Left = 4320 70 | TabIndex = 0 71 | Top = 3240 72 | Width = 2775 73 | End 74 | End 75 | Attribute VB_Name = "frmSplash" 76 | Attribute VB_GlobalNameSpace = False 77 | Attribute VB_Creatable = False 78 | Attribute VB_PredeclaredId = True 79 | Attribute VB_Exposed = False 80 | 81 | Option Explicit 82 | 83 | Private intLoaded As Integer 84 | 85 | Private Sub Form_Load() 86 | lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision 87 | End Sub 88 | 89 | Private Sub Timer1_Timer() 90 | Unload Me 91 | frmMain.Show 92 | End Sub 93 | 94 | -------------------------------------------------------------------------------- /BasicBoy/JOY.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modJOY" 2 | 'This is a part of the BasicBoy emulator 3 | 'You are not allowed to release modified(or unmodified) versions 4 | 'without asking me (Raziel). 5 | 'For Suggestions ect please e-mail at :stef_mp@yahoo.gr 6 | 'To download the latest version/source goto basicboy.emuhost.com 7 | '(I know the emulator is NOT OPTIMIZED AT ALL) 8 | 9 | 10 | 11 | 'v3.0.1 12 | 'Joypad emulation ... 13 | 'Full emulation 14 | 'Using DierctInput now 15 | 'Moved from the form 16 | 'You can configure the keys now 17 | 'comments added 18 | 19 | 'Sory for my bad english ... 20 | Option Explicit 21 | 22 | Public Sub KeyDown(KeyCode As Byte) 23 | Dim temp As Long, old As Long 24 | Select Case KeyCode 25 | Case Lf 'Left 26 | joyval1 = joyval1 Or 2 27 | Case Up 'Up 28 | joyval1 = joyval1 Or 4 29 | Case Rg 'Right 30 | joyval1 = joyval1 Or 1 31 | Case Dn 'Down 32 | joyval1 = joyval1 Or 8 33 | Case ABut 'Z - A Button 34 | joyval2 = joyval2 Or 1 35 | Case BBut 'X - B button 36 | joyval2 = joyval2 Or 2 37 | Case St1, St2, St3 ' - Start 38 | joyval2 = joyval2 Or 8 39 | Case Sl1, Sl2 ' - Select 40 | joyval2 = joyval2 Or 4 41 | Case 66 42 | SrceenShot 'take a screenshot 43 | 'Case -1 44 | 'SS 'Save Stage-not working 45 | 'Case -2 46 | 'LS 'Load Stage-not working 47 | Case SpeedKeyD 48 | slfp = lfp 49 | lfp = False 'Set fullspeed 50 | If stpsnd Then 51 | ssnd = snd 52 | snd = 0 53 | initWave 54 | End If 55 | If stpsk Then 56 | ofskip = fskip 57 | ofmode = fmode 58 | fskip = 20 59 | fmode = 0 60 | End If 61 | End Select 62 | If old <> joyval1 * 16 + joyval2 Then RAM(65295, 0) = RAM(65295, 0) Or 16 'update joy reg 63 | End Sub 64 | Public Sub KeyUp(KeyCode As Byte) 65 | Dim temp As Long, old As Long 66 | old = joyval1 * 16 + joyval2 67 | Select Case KeyCode 68 | Case Lf 'Left 69 | joyval1 = joyval1 And 253 70 | Case Up 'Up 71 | joyval1 = joyval1 And 251 72 | Case Rg 'Right 73 | joyval1 = joyval1 And 254 74 | Case Dn 'Down 75 | joyval1 = joyval1 And 247 76 | Case ABut 'Z - A Button 77 | joyval2 = joyval2 And 254 78 | Case BBut 'X - B button 79 | joyval2 = joyval2 And 253 80 | Case St1, St2, St3 ' - Start 81 | joyval2 = joyval2 And 247 82 | Case Sl1, Sl2 ' - Select 83 | joyval2 = joyval2 And 251 84 | Case SpeedKeyU 'set normal speed 85 | lfp = slfp 86 | If stpsnd Then 87 | snd = ssnd 88 | initWave 89 | End If 90 | If stpsk Then 91 | If ofskip Then 92 | fskip = ofskip 93 | fmode = ofmode 94 | End If 95 | End If 96 | End Select 97 | If old <> joyval1 * 16 + joyval2 Then RAM(65295, 0) = RAM(65295, 0) Or 16 'update joy reg 98 | End Sub 99 | -------------------------------------------------------------------------------- /BasicBoy/rtc.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "rtc" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | 'Well yes this is bad writen 15 | 'But i'm getting booooored with Gameboy.. 16 | 'It's a 5 mins work :) 17 | 18 | Option Explicit 19 | Public act As Long 20 | Dim Secs As Long, halt As Long, dccb As Long 21 | Dim dat As Date, tim As Date 22 | 23 | Public Property Get S() As Long 24 | update 25 | S = Secs Mod 60 26 | End Property 27 | Public Property Let S(ByVal value As Long) 28 | Secs = Secs - S + value 29 | End Property 30 | 31 | Public Property Get M() As Long 32 | update 33 | M = (Secs \ 60) Mod 60 34 | End Property 35 | Public Property Let M(ByVal value As Long) 36 | Secs = Secs - M * 60 + value * 60 37 | End Property 38 | 39 | Public Property Get H() As Long 40 | update 41 | H = (Secs \ 3600) Mod 24 42 | End Property 43 | Public Property Let H(ByVal value As Long) 44 | Secs = Secs - H * 3600 + value * 3600 45 | End Property 46 | 47 | Public Property Get DL() As Long 48 | update 49 | DL = (Secs / 86400) And 255 50 | End Property 51 | Public Property Let DL(value As Long) 52 | Secs = Secs - DL * 86400 + value * 86400 53 | End Property 54 | 55 | Public Property Get DH() As Long 56 | update 57 | DH = (Secs / 22118400) And 1 + ((Secs / 22118400) And 2) * 32 + halt * 32 58 | End Property 59 | Public Property Let DH(value As Long) 60 | Secs = Secs - ((S / 22118400) And 1) * 22118400 + (value And 1) * 22118400 61 | If (value And 64) = 0 Then Secs = Secs - ((S / 22118400) And 2) * 22118400 62 | End Property 63 | 64 | Public Sub save(flname As String) 65 | Dim ssv As Long 66 | ssv = FreeFile 67 | Open flname & ".rtc" For Binary As ssv 68 | Put ssv, , Secs 69 | Put ssv, , halt 70 | Put ssv, , dat 71 | Put ssv, , tim 72 | Close ssv 73 | End Sub 74 | Public Sub load(flname As String) 75 | Dim ssv As Long 76 | ssv = FreeFile 77 | Open flname & ".rtc" For Binary As ssv 78 | If LOF(ssv) = 0 Then Exit Sub 79 | Get ssv, , Secs 80 | Get ssv, , halt 81 | Get ssv, , dat 82 | Get ssv, , tim 83 | Close ssv 84 | update 85 | End Sub 86 | 87 | Private Sub Class_Initialize() 88 | dat = Date 89 | tim = time 90 | End Sub 91 | Private Sub update() 92 | Dim ssc As Long 93 | ssc = (Date - dat) * 86400 94 | ssc = ssc + (time - tim) * 86400 95 | Secs = Secs + ssc 96 | dat = Date 97 | tim = time 98 | End Sub 99 | Public Function readReg() As Long 100 | Select Case act 101 | Case &H8 102 | readReg = S 103 | Case &H9 104 | readReg = M 105 | Case &HA 106 | readReg = H 107 | Case &HB 108 | readReg = DL 109 | Case &HC 110 | readReg = DH 111 | End Select 112 | End Function 113 | 114 | Public Sub writeReg(val As Long) 115 | Select Case act 116 | Case &H8 117 | S = val 118 | Case &H9 119 | M = val 120 | Case &HA 121 | H = val 122 | Case &HB 123 | DL = val 124 | Case &HC 125 | DH = val 126 | End Select 127 | End Sub 128 | -------------------------------------------------------------------------------- /BasicBoy/CLS/rtc.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "rtc" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | 'Well yes this is bad writen 15 | 'But i'm getting booooored with Gameboy.. 16 | 'It's a 5 mins work :) 17 | 18 | Option Explicit 19 | Public act As Long 20 | Dim Secs As Long, halt As Long, dccb As Long 21 | Dim dat As Date, tim As Date 22 | 23 | Public Property Get S() As Long 24 | update 25 | S = Secs Mod 60 26 | End Property 27 | Public Property Let S(ByVal value As Long) 28 | Secs = Secs - S + value 29 | End Property 30 | 31 | Public Property Get M() As Long 32 | update 33 | M = (Secs \ 60) Mod 60 34 | End Property 35 | Public Property Let M(ByVal value As Long) 36 | Secs = Secs - M * 60 + value * 60 37 | End Property 38 | 39 | Public Property Get H() As Long 40 | update 41 | H = (Secs \ 3600) Mod 24 42 | End Property 43 | Public Property Let H(ByVal value As Long) 44 | Secs = Secs - H * 3600 + value * 3600 45 | End Property 46 | 47 | Public Property Get DL() As Long 48 | update 49 | DL = (Secs / 86400) And 255 50 | End Property 51 | Public Property Let DL(value As Long) 52 | Secs = Secs - DL * 86400 + value * 86400 53 | End Property 54 | 55 | Public Property Get DH() As Long 56 | update 57 | DH = (Secs / 22118400) And 1 + ((Secs / 22118400) And 2) * 32 + halt * 32 58 | End Property 59 | Public Property Let DH(value As Long) 60 | Secs = Secs - ((S / 22118400) And 1) * 22118400 + (value And 1) * 22118400 61 | If (value And 64) = 0 Then Secs = Secs - ((S / 22118400) And 2) * 22118400 62 | End Property 63 | 64 | Public Sub save(flname As String) 65 | Dim ssv As Long 66 | ssv = FreeFile 67 | Open flname & ".rtc" For Binary As ssv 68 | Put ssv, , Secs 69 | Put ssv, , halt 70 | Put ssv, , dat 71 | Put ssv, , tim 72 | Close ssv 73 | End Sub 74 | Public Sub load(flname As String) 75 | Dim ssv As Long 76 | ssv = FreeFile 77 | Open flname & ".rtc" For Binary As ssv 78 | If LOF(ssv) = 0 Then Exit Sub 79 | Get ssv, , Secs 80 | Get ssv, , halt 81 | Get ssv, , dat 82 | Get ssv, , tim 83 | Close ssv 84 | update 85 | End Sub 86 | 87 | Private Sub Class_Initialize() 88 | dat = Date 89 | tim = time 90 | End Sub 91 | Private Sub update() 92 | Dim ssc As Long 93 | ssc = (Date - dat) * 86400 94 | ssc = ssc + (time - tim) * 86400 95 | Secs = Secs + ssc 96 | dat = Date 97 | tim = time 98 | End Sub 99 | Public Function readReg() As Long 100 | Select Case act 101 | Case &H8 102 | readReg = S 103 | Case &H9 104 | readReg = M 105 | Case &HA 106 | readReg = H 107 | Case &HB 108 | readReg = DL 109 | Case &HC 110 | readReg = DH 111 | End Select 112 | End Function 113 | 114 | Public Sub writeReg(val As Long) 115 | Select Case act 116 | Case &H8 117 | S = val 118 | Case &H9 119 | M = val 120 | Case &HA 121 | H = val 122 | Case &HB 123 | DL = val 124 | Case &HC 125 | DH = val 126 | End Select 127 | End Sub 128 | -------------------------------------------------------------------------------- /BasicBoy/modLink.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modLink" 2 | 'This is a part of the BasicBoy emulator 3 | 'You are not allowed to release modified(or unmodified) versions 4 | 'without asking me (Raziel). 5 | 'For Suggestions ect please e-mail at :stef_mp@yahoo.gr 6 | 'To download the latest version/source goto basicboy.emuhost.com 7 | '(I know the emulator is NOT OPTIMIZED AT ALL) 8 | 9 | 10 | 11 | 'v2.0.1 12 | 'Link emulation ... 13 | 'Almost full emulation (no speed limitation) 14 | 'comments added 15 | 16 | 'Sory for my bad english ... 17 | 18 | Option Explicit 19 | Public LinkState As Long 20 | Public TdataB(1) As Byte, tmp As Long, id As String, TZero(255) As Byte, t2(1) As Byte, Bs As Long, sent As Boolean, tmpdat(255) As Byte 21 | Sub Con() ' connect 22 | Dim tset As Long 23 | tset = GetSetting("BasicBoy", "link", "COP", "0") 24 | If tset And 1 Then 'we are at slot 1 25 | If tset = 3 Then Exit Sub 26 | tset = 3: SaveSetting "BasicBoy", "link", "LID2", frmMain.hwnd 27 | SaveSetting "BasicBoy", "link", "ptr2", VarPtr(TdataB(0)) 28 | LinkState = 3 29 | ElseIf tset And 2 Then 'we are at slot 2 30 | tset = 3: SaveSetting "BasicBoy", "link", "LID1", frmMain.hwnd 31 | SaveSetting "BasicBoy", "link", "ptr1", VarPtr(TdataB(0)) 32 | LinkState = 2 33 | Else 'well, we can chose slot 1 or 2 34 | tset = 1: SaveSetting "BasicBoy", "link", "LID1", frmMain.hwnd 35 | SaveSetting "BasicBoy", "link", "ptr1", VarPtr(TdataB(0)) 36 | LinkState = 2 37 | End If 38 | SaveSetting "BasicBoy", "link", "COP", tset 39 | End Sub 40 | Sub check_link_connection() 41 | If GetSetting("BasicBoy", "link", "COP", "0") = 3 And LinkState > 1 Then 42 | Select Case LinkState 43 | Case 2 44 | init GetSetting("BasicBoy", "link", "LID2"), 2, GetSetting("BasicBoy", "link", "ptr2") 45 | frmMain.Caption = frmMain.Caption & "*Conected (BB1)*" 46 | LinkState = 1 47 | Case 3 48 | init GetSetting("BasicBoy", "link", "LID1"), 2, GetSetting("BasicBoy", "link", "ptr1") 49 | frmMain.Caption = frmMain.Caption & "*Conected (BB2)*" 50 | LinkState = 1 51 | End Select 52 | End If 53 | End Sub 54 | Sub link_kill() 55 | SaveSetting "BasicBoy", "link", "LID1", 0 56 | SaveSetting "BasicBoy", "link", "ptr1", 0 57 | SaveSetting "BasicBoy", "link", "LID2", 0 58 | SaveSetting "BasicBoy", "link", "ptr2", 0 59 | SaveSetting "BasicBoy", "link", "COP", 0 60 | End Sub 61 | 62 | Sub Check() 'check the link state 63 | If (RAM(65282, 0) And 128) And (LinkState = 1) Then 'sio is on 64 | If RAM(65282, 0) And 1 Then 65 | 'Internal send then get 66 | If sent = False Then 67 | 'send 68 | t2(0) = 1 'assemble msg 69 | t2(1) = RAM(65281, 0) 70 | Send t2 ' no comment 71 | sent = True 72 | Else 73 | 'get 74 | If TdataB(0) = 1 Then ' is this a recieve msg?? 75 | RAM(65281, 0) = TdataB(1) 76 | TdataB(0) = 0 77 | TdataB(1) = 0 78 | sent = False 79 | RAM(65282, 0) = RAM(65282, 0) And 127 'transfer completed 80 | RAM(65295, 0) = RAM(65295, 0) Or 8 81 | End If 82 | End If 83 | Else 84 | sent = False 85 | 'external 86 | 'get then send 87 | If TdataB(0) = 1 Then ' is this a recieve msg?? 88 | 'get 89 | Bs = TdataB(1) 'get the data 90 | TdataB(0) = 0 91 | TdataB(1) = 0 92 | 'out 93 | t2(0) = 1 'and send our data 94 | t2(1) = RAM(65281, 0) 95 | Send t2 96 | RAM(65281, 0) = Bs 97 | RAM(65282, 0) = RAM(65282, 0) And 127 'transfer completed 98 | RAM(65295, 0) = RAM(65295, 0) Or 8 99 | End If 100 | End If 101 | 102 | Else 103 | 'no Serial IO 104 | sent = False 105 | End If 106 | End Sub 107 | 108 | 109 | -------------------------------------------------------------------------------- /BasicBoy/dxEngine.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modDXEngine" 2 | 'This is a part of the BasicBoy emulator 3 | 'You are not allowed to release modified(or unmodified) versions 4 | 'without asking me (Raziel). 5 | 'For Suggestions ect please e-mail at :stef_mp@yahoo.gr 6 | 'To download the latest version/source goto basicboy.emuhost.com 7 | '(I know the emulator is NOT OPTIMIZED AT ALL) 8 | 9 | 'This is a complete rewrite of the DX interface 10 | 'I liked more the vb.net way so i decided to 11 | 'rewrite the dx interface in VB6 too :) 12 | 'Rewrite of the sound interface 13 | 'v 1.3.0 14 | Option Explicit 15 | 'DirectX Stuff 16 | 'DX7 vars 17 | Public dx7 As DirectX7 18 | Public DDraw As DirectDraw7 19 | Public clipper As DirectDrawClipper 20 | Public primary As DirectDrawSurface7 21 | Public backbuffer As DirectDrawSurface7 22 | Public surfaceRect As dxvblib.RECT 23 | 'DX8 vars 24 | Public dx8 As DirectX8 25 | Public dsound As DirectSound8 26 | 'Everything else 27 | Public dHandle As Long, wHandle As Long 28 | Sub InitDirectX(ByVal whwnd As Long, ByVal dhwnd As Long) 29 | dHandle = dhwnd 30 | wHandle = whwnd 31 | Set dx7 = New DirectX7 32 | Set dx8 = New DirectX8 33 | initDirectDraw 34 | End Sub 35 | Sub initDirectDraw() 36 | Dim ddsd As DDSURFACEDESC2 37 | On Error GoTo create_error 38 | Set DDraw = dx7.DirectDrawCreate("") 39 | DDraw.SetCooperativeLevel dHandle, DDSCL_NORMAL 40 | 'create the primary display surface 41 | ddsd.lFlags = DDSD_CAPS 'Or DDSD_WIDTH Or DDSD_HEIGHT 42 | ddsd.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE 43 | 'create the surface 44 | Set primary = DDraw.CreateSurface(ddsd) 45 | 'Craete a clipper 46 | Set clipper = DDraw.CreateClipper(0) 47 | 'assoiciate the window handle with the clipper 48 | clipper.SetHWnd dHandle 49 | 'clip blitting routines to the window 50 | primary.SetClipper clipper 51 | 'create a normal surface 52 | ddsd.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT Or DDSD_PIXELFORMAT 53 | ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN 54 | 'set surface resolution 55 | ddsd.lWidth = 160 56 | ddsd.lHeight = 144 57 | ddsd.ddpfPixelFormat.lFlags = DDPF_RGB 58 | ddsd.ddpfPixelFormat.lRGBBitCount = 16 59 | ddsd.ddpfPixelFormat.lRBitMask = 31744 60 | ddsd.ddpfPixelFormat.lGBitMask = 992 61 | ddsd.ddpfPixelFormat.lBBitMask = 31 62 | Set backbuffer = DDraw.CreateSurface(ddsd) 63 | 'surface rectangle 64 | surfaceRect.Bottom = ddsd.lHeight 65 | surfaceRect.Right = ddsd.lWidth 66 | Exit Sub 67 | create_error: 68 | MsgBox "Direct Draw Error : " & err.Description & " " 69 | mode1 = 0 70 | End Sub 71 | Sub fullSc() 72 | Dim ddsd As DDSURFACEDESC2 73 | On Error GoTo create_error 74 | dHandle = frmRender.hwnd 75 | Set primary = Nothing 76 | Set backbuffer = Nothing 77 | Set DDraw = Nothing 78 | Set DDraw = dx7.DirectDrawCreate("") 79 | DDraw.SetCooperativeLevel dHandle, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE 80 | DDraw.SetDisplayMode 800, 600, 32, 75, DDSDM_DEFAULT 81 | 'create the primary display surface 82 | ddsd.lFlags = DDSD_CAPS 'Or DDSD_WIDTH Or DDSD_HEIGHT 83 | ddsd.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE 84 | 'create the surface 85 | Set primary = DDraw.CreateSurface(ddsd) 86 | 'Craete a clipper 87 | Set clipper = DDraw.CreateClipper(0) 88 | 'assoiciate the window handle with the clipper 89 | clipper.SetHWnd dHandle 90 | 'clip blitting routines to the window 91 | primary.SetClipper clipper 92 | 'create a normal surface 93 | ddsd.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT 94 | ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN 95 | 'set surface resolution 96 | ddsd.lWidth = 160 97 | ddsd.lHeight = 144 98 | Set backbuffer = DDraw.CreateSurface(ddsd) 99 | 'surface rectangle 100 | surfaceRect.Bottom = ddsd.lHeight 101 | surfaceRect.Right = ddsd.lWidth 102 | Exit Sub 103 | create_error: 104 | MsgBox "Direct Draw Error : " & err.Description & " " 105 | mode1 = 0 106 | End Sub 107 | -------------------------------------------------------------------------------- /BasicBoy/modRLECompression.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modRLECompression" 2 | '***Added by Xeon (www.xeons.net)*** 3 | 'Just has compression code for the saved states, and a simple routine to count the length of a file in lines. 4 | 5 | 'mostly contains simple rle compression routines, but they work great on the save states 6 | 7 | 'Buffered IO. faster. 8 | Private readBuffer(4095) As Byte 9 | Private writebuffer(4095) As Byte 10 | Private readptr As Long 11 | Private writeptr As Long 12 | Private readsize As Long 13 | 14 | Private runlength As Byte 15 | Private runchar As Byte 16 | Private nextchar As Byte 17 | Private temp As Byte 18 | Public gif As IPictureDisp 19 | Private ind As Long 20 | 21 | Public palName As String 22 | Private Function readchar() As Byte 23 | If readptr = 0 Then 24 | If readsize >= 4096 Then 25 | Get #1, , readBuffer 26 | Else 27 | Dim b() As Byte, i As Long 28 | ReDim b(readsize - 1) 29 | Get #1, , b 30 | For i = 0 To readsize - 1 31 | readBuffer(i) = b(i) 32 | Next i 33 | End If 34 | End If 35 | readchar = readBuffer(readptr) 36 | readptr = (readptr + 1) And 4095 37 | readsize = readsize - 1 38 | End Function 39 | 40 | Private Sub writechar(c As Byte) 41 | writebuffer(writeptr) = c 42 | writeptr = (writeptr + 1) And 4095 43 | If writeptr = 0 Then Put #2, , writebuffer 44 | End Sub 45 | 46 | Private Sub preclose() 47 | If writeptr > 0 Then 48 | Dim b() As Byte, i As Long 49 | ReDim b(writeptr - 1) 50 | For i = 0 To writeptr - 1: b(i) = writebuffer(i): Next i 51 | Put #2, , b 52 | End If 53 | End Sub 54 | 55 | Public Sub delete(f As String) 56 | On Error Resume Next 57 | Kill f 58 | End Sub 59 | 60 | Private Sub scanrun() 61 | runchar = nextchar 62 | runlength = 0 63 | Do 64 | runlength = runlength + 1 65 | nextchar = readchar 66 | Loop Until nextchar <> runchar Or runlength = 255 Or readsize = 0 67 | End Sub 68 | 69 | Private Sub writerun() 70 | Dim i As Long 71 | For i = 1 To runlength 72 | writechar runchar 73 | Next i 74 | End Sub 75 | 76 | Private Sub encoderun() 77 | Dim i As Long 78 | If runlength > 3 Then 79 | temp = 207 80 | writechar temp 81 | writechar runlength 82 | writechar runchar 83 | Else 84 | For i = 1 To runlength 85 | writechar runchar 86 | If runchar = 207 Then 87 | temp = 0 88 | writechar temp 89 | End If 90 | Next i 91 | End If 92 | End Sub 93 | 94 | Private Sub decoderun() 95 | runchar = readchar 96 | If runchar = 207 Then 97 | runlength = readchar 98 | If runlength > 0 Then 99 | runchar = readchar 100 | Else 101 | runlength = 1 102 | End If 103 | Else 104 | runlength = 1 105 | End If 106 | End Sub 107 | 108 | 'very simple RLE file compression 109 | Public Sub RLECompress(infile As String, outfile As String) 110 | delete outfile 111 | Open infile For Binary As #1 112 | Open outfile For Binary As #2 113 | readsize = LOF(1) 114 | readptr = 0 115 | writeptr = 0 116 | 117 | Get #1, , nextchar 118 | While readsize > 0 119 | scanrun 120 | If readsize = 0 Then 121 | If nextchar = runchar And runlength < 255 Then 122 | runlength = runlength + 1 123 | encoderun 124 | Else 125 | encoderun 126 | runlength = 1 127 | runchar = nextchar 128 | encoderun 129 | End If 130 | Else 131 | encoderun 132 | End If 133 | Wend 134 | preclose 135 | Close 136 | End Sub 137 | 138 | Public Sub RLEDecompress(infile As String, outfile As String) 139 | delete outfile 140 | Open infile For Binary As #1 141 | Open outfile For Binary As #2 142 | readsize = LOF(1) 143 | readptr = 0 144 | writeptr = 0 145 | 146 | While readsize > 0 147 | decoderun 148 | writerun 149 | Wend 150 | preclose 151 | Close 152 | End Sub 153 | 154 | 155 | -------------------------------------------------------------------------------- /BasicBoy/modVars.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modVars" 2 | 'This is a part of the BasicBoy emulator 3 | 'You are not allowed to release modified(or unmodified) versions 4 | 'without asking me (Raziel). 5 | 'For Suggestions ect please e-mail at :stef_mp@yahoo.gr 6 | 'To download the latest version/source goto basicboy.emuhost.com 7 | '(I know the emulator is NOT OPTIMIZED AT ALL) 8 | 9 | 'v1.1.0 10 | 'All global / public vars moved here 11 | 'Comments Added 12 | 'minor timing fixes 13 | 14 | 'Sory for my bad english ... 15 | Option Explicit 16 | Option Base 0 17 | '****Gui/General vars**** 18 | Global CD As New clsDialog 'Common dialog class 19 | Global Const pschome As String = "Explorer " & """" & "http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=54373&lngWId=1" & """" 20 | Global gtc As Long 'use gettickcount instead of queryperformancecounter 21 | '****Cpu vars**** 22 | Global Wait_Data As Long 23 | Global zf As Byte, nf As Byte, hf As Byte, cf As Byte 'bits 7-4 24 | Global f_lowbits As Byte 'bits 3-0 25 | Global A As Long, f As Long 'Registers 26 | Global b As Long, c As Long 'Registers 27 | Global D As Long, E As Long 'Registers 28 | Global H As Long, L As Long 'Registers 29 | Global PC As Long 'PC Register 30 | Global SP As Long 'SP Register 31 | Global IME As Boolean 'Interupt Master Enable Register 32 | Global timerC As Long 'Timer interupt Cycle counter 33 | 'Global brkAddr As Long'CPU break Address (not used anymore) 34 | Global Clcount As Long 'CPU sync cycle counter 35 | Global ime_stat As Long 'IME delay state 36 | Global SETT(0 To 56) As Byte, BITT(0 To 56) As Byte 'Precalculated for speed 37 | Global bCpuRun As Boolean 'Cpu run :P 38 | 'Global tval As Long 39 | Global tvm As Long 'Timer Iterupt Speed 40 | Global cpc(&HFF) As Long 'Intruction Cylces table 41 | 'Global lw As Long 42 | Global mm As Long, zm As Long, cm As Long 'GRFX mode,GRFX Size,CPU mode(not used currently) 43 | Global GBM As Long '0 = gb, 1 = gbc 44 | Global message As msg 'replacent for the doevents 45 | Global TGBC As Boolean 'Try to emulate GBC(if rom is color) 46 | Global smp As Long 'Prepare Speed Change reg 47 | Global Clm0 As Long, clm3 As Long, cllc As Long, cldr As Long 'CPU Cycle Sync 48 | Global CpuS As Long 'Cpu speed(1,0) 49 | Global lfp As Byte 'Limit FPS 50 | Global hline As Long, Mhz As Long 'Cur Hblank line,Cpu speed 51 | Global Mips As Long 'Cpu mips 52 | Global Cpu_Speed As Single 'cpu over/under-clock 53 | 54 | '****Memory Vars**** 55 | Global rominfo As CartIinfo 'Cart info All together :) 56 | Global Ct(255) As String 'cart type name 57 | Global Ros(255) As String 'Rom size name 58 | Global Ras(255) As String 'Ram size name 59 | Global Rosn(255) As Long 'Rom size number 60 | Global Rasn(255) As Long 'Ram size Number 61 | Global ROM(16383, 128) As Long 'Memory to hold the rom/Ram:Staticaly dimed to max to 62 | Global RAM(32768 To 65535, 7) As Long 'Max and as long in order to increase speed( 63 | Global bRam(8191, 15) As Byte '8megs wow gb has max 2...) 64 | Global CurROMBank As Long, CurRAMBank As Long ' No comment :P 65 | Global mbcrtc As Long 'Cart has RTC?? 66 | Global mbcrtcE As Long 'Is it Emulated?? 67 | Global mbc1mode As Long '16/8 or 4/32 mode for mbc1 68 | Global mbc3rtc As New rtc 'Real Time Clock class 69 | Global wRamB As Long, vRamB As Long 'work ram and video ram banks (GBC) 70 | Global objpi As Long, bgpi As Long 'Color Paletes indexes 71 | Global bgai As Boolean, objai As Boolean 'Color Paletes indexes 72 | Global hdmaS As Long, hdmaD As Long 'hDMA source / Dest 73 | Global Hdma As Byte, Hdmal As Long, tHdmal As Long 'hDMA len/Eneble disable 74 | Global joyval1 As Long, joyval2 As Long 'Joystick Values 75 | Global ro As String 'Rom FileName 76 | 77 | '****Sound vars**** 78 | Global snd As Long 'Sound enabled (1,0) 79 | Global sqrW(7, 3) As Integer 'Square Wave Waveform 80 | Global noise7(127) As Long, noise15(32767) As Long, npointer As Long 'Noise tables/pointer 81 | Global ssnd As Long, gb_snd As Long 82 | Global wave1p As Long 83 | Global wave2p As Long 84 | Global wave3p As Long 85 | Global wave4p As Long 86 | 87 | '****Joystic Vars**** 88 | Global Up As Long 'Button keycodes 89 | Global Dn As Long 'Button keycodes 90 | Global Lf As Long 'Button keycodes 91 | Global Rg As Long 'Button keycodes 92 | Global ABut As Long 'Button keycodes 93 | Global BBut As Long 'Button keycodes 94 | Global St1 As Long, St2 As Long, St3 As Long 'Button keycodes 95 | Global Sl1 As Long, Sl2 As Long 'Button keycodes 96 | Global SpeedKeyD As Long, SpeedKeyU As Long 'Button keycodes 97 | Global sTes As Long, ofmode As Long, ofskip As Long 'Button keycodes 98 | Global stpsnd As Boolean, stpsk As Boolean, slfp As Boolean 'Button keycodes 99 | 100 | 101 | Function GetTickCount2() As Double 102 | If gtc = 1 Then 103 | GetTickCount2 = GetTickCount 104 | Exit Function 105 | End If 106 | Dim curC As Currency 107 | If curFreq = 0 Then 108 | QueryPerformanceFrequency curFreq 'Get the timer frequency 109 | curFreq = curFreq * 10 'in ms 110 | End If 111 | QueryPerformanceCounter curC 112 | GetTickCount2 = (curC * 10000) / curFreq 113 | End Function 114 | 115 | 116 | -------------------------------------------------------------------------------- /BasicBoy/clsDik2.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "clsDik2" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | Option Base 0 16 | 17 | 'local references 18 | Dim dinput As clsDirectInput8 19 | 20 | 'class variables 21 | Dim diDev_Keyboard As DirectInputDevice8 22 | Dim diState_Keyboard As DxVBLibA.DIKEYBOARDSTATE 23 | Dim diOState_Keyboard As DxVBLibA.DIKEYBOARDSTATE 24 | Dim sKeyNames(255) As String 25 | 26 | Public Sub Startup(ByRef di As clsDirectInput8, ByVal hWindowHandle As Long) 27 | 'create reference to DirectInput object 28 | Set dinput = di 29 | 30 | 'create an interface to the keyboard 31 | Set diDev_Keyboard = dinput.DIObj.CreateDevice("GUID_SysKeyboard") 32 | 33 | diDev_Keyboard.SetCommonDataFormat DIFORMAT_KEYBOARD 34 | diDev_Keyboard.SetCooperativeLevel hWindowHandle, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE 35 | diDev_Keyboard.Acquire 36 | 37 | 'initialize the key name array 38 | InitKeyNames 39 | End Sub 40 | 41 | Public Sub Check_Keyboard() 42 | Dim n As Long 43 | If GetActiveWindow = frmJoy.hWnd Then 44 | 'make sure the keyboard handler is running 45 | If diDev_Keyboard Is Nothing Then Exit Sub 46 | 47 | 'get the list of pressed keys 48 | diDev_Keyboard.GetDeviceStateKeyboard diState_Keyboard 49 | 50 | 'scan the entire list for pressed keys 51 | For n = 0 To 255 52 | If diState_Keyboard.key(n) <> diOState_Keyboard.key(n) Then 53 | If diState_Keyboard.key(n) <> 0 Then 54 | If diOState_Keyboard.key(n) = 0 Then 55 | frmJoy.ckeydown n 56 | End If 57 | End If 58 | End If 59 | Next 60 | End If 61 | diOState_Keyboard = diState_Keyboard 62 | End Sub 63 | 64 | Public Sub Shutdown() 65 | On Local Error Resume Next 66 | 67 | 'release the keyboard 68 | If Not (diDev_Keyboard Is Nothing) Then 69 | diDev_Keyboard.Unacquire 70 | Set diDev_Keyboard = Nothing 71 | End If 72 | End Sub 73 | 74 | Public Property Get KeyName(ByVal lKey As Long) As String 75 | KeyName = sKeyNames(lKey) 76 | End Property 77 | 78 | Private Sub InitKeyNames() 79 | sKeyNames(1) = "ESC" 80 | sKeyNames(2) = "1" 81 | sKeyNames(3) = "2" 82 | sKeyNames(4) = "3" 83 | sKeyNames(5) = "4" 84 | sKeyNames(6) = "5" 85 | sKeyNames(7) = "6" 86 | sKeyNames(8) = "7" 87 | sKeyNames(9) = "8" 88 | sKeyNames(10) = "9" 89 | sKeyNames(11) = "0" 90 | sKeyNames(12) = "-" 91 | sKeyNames(13) = "=" 92 | sKeyNames(14) = "BACKSPACE" 93 | sKeyNames(15) = "TAB" 94 | sKeyNames(16) = "Q" 95 | sKeyNames(17) = "W" 96 | sKeyNames(18) = "E" 97 | sKeyNames(19) = "R" 98 | sKeyNames(20) = "T" 99 | sKeyNames(21) = "Y" 100 | sKeyNames(22) = "U" 101 | sKeyNames(23) = "I" 102 | sKeyNames(24) = "O" 103 | sKeyNames(25) = "P" 104 | sKeyNames(26) = "[" 105 | sKeyNames(27) = " ]" 106 | sKeyNames(28) = "ENTER" 107 | sKeyNames(29) = "LCTRL" 108 | sKeyNames(30) = "A" 109 | sKeyNames(31) = "S" 110 | sKeyNames(32) = "D" 111 | sKeyNames(33) = "F" 112 | sKeyNames(34) = "G" 113 | sKeyNames(35) = "H" 114 | sKeyNames(36) = "J" 115 | sKeyNames(37) = "K" 116 | sKeyNames(38) = "L" 117 | sKeyNames(39) = ";" 118 | sKeyNames(40) = "'" 119 | sKeyNames(41) = "`" 120 | sKeyNames(42) = "LSHIFT" 121 | sKeyNames(43) = "\" 122 | sKeyNames(44) = "Z" 123 | sKeyNames(45) = "X" 124 | sKeyNames(46) = "C" 125 | sKeyNames(47) = "V" 126 | sKeyNames(48) = "B" 127 | sKeyNames(49) = "N" 128 | sKeyNames(50) = "M" 129 | sKeyNames(51) = "," 130 | sKeyNames(52) = "." 131 | sKeyNames(53) = "/" 132 | sKeyNames(54) = "RSHIFT" 133 | sKeyNames(55) = "NUMPAD*" 134 | sKeyNames(56) = "LALT" 135 | sKeyNames(57) = "SPACE" 136 | sKeyNames(58) = "CAPSLOCK" 137 | sKeyNames(59) = "F1" 138 | sKeyNames(60) = "F2" 139 | sKeyNames(61) = "F3" 140 | sKeyNames(62) = "F4" 141 | sKeyNames(63) = "F5" 142 | sKeyNames(64) = "F6" 143 | sKeyNames(65) = "F7" 144 | sKeyNames(66) = "F8" 145 | sKeyNames(67) = "F9" 146 | sKeyNames(68) = "F10" 147 | sKeyNames(69) = "NUMLOCK" 148 | sKeyNames(70) = "SCRLLOCK" 149 | sKeyNames(71) = "NUMPAD7" 150 | sKeyNames(72) = "NUMPAD8" 151 | sKeyNames(73) = "NUMPAD9" 152 | sKeyNames(74) = "NUMPAD-" 153 | sKeyNames(75) = "NUMPAD4" 154 | sKeyNames(76) = "NUMPAD5" 155 | sKeyNames(77) = "NUMPAD6" 156 | sKeyNames(78) = "NUMPAD+" 157 | sKeyNames(79) = "NUMPAD1" 158 | sKeyNames(80) = "NUMPAD2" 159 | sKeyNames(81) = "NUMPAD3" 160 | sKeyNames(82) = "NUMPAD0" 161 | sKeyNames(83) = "NUMPAD." 162 | sKeyNames(87) = "F11" 163 | sKeyNames(88) = "F12" 164 | sKeyNames(86) = "F13" 165 | sKeyNames(84) = "F14" 166 | sKeyNames(85) = "F15" 167 | sKeyNames(156) = "NUMPADENTER" 168 | sKeyNames(157) = "RCONTROL" 169 | sKeyNames(91) = "NUMPAD," 170 | sKeyNames(181) = "NUMPAD/" 171 | sKeyNames(183) = "SYSRQ" 172 | sKeyNames(184) = "RALT" 173 | sKeyNames(199) = "HOME" 174 | sKeyNames(200) = "UP" 175 | sKeyNames(201) = "PGUP" 176 | sKeyNames(203) = "LEFT" 177 | sKeyNames(205) = "RIGHT" 178 | sKeyNames(207) = "END" 179 | sKeyNames(208) = "DOWN" 180 | sKeyNames(209) = "PGDN" 181 | sKeyNames(210) = "INSERT" 182 | sKeyNames(211) = "DELETE" 183 | sKeyNames(219) = "LWIN" 184 | sKeyNames(220) = "RWIN" 185 | sKeyNames(221) = "APPS" 186 | sKeyNames(116) = "PAUSE" 187 | End Sub 188 | 189 | 190 | 191 | 192 | -------------------------------------------------------------------------------- /BasicBoy/CLS/clsDik2.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "clsDik2" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | Option Base 0 16 | 17 | 'local references 18 | Dim dinput As clsDirectInput8 19 | 20 | 'class variables 21 | Dim diDev_Keyboard As DirectInputDevice8 22 | Dim diState_Keyboard As DxVBLibA.DIKEYBOARDSTATE 23 | Dim diOState_Keyboard As DxVBLibA.DIKEYBOARDSTATE 24 | Dim sKeyNames(255) As String 25 | 26 | Public Sub Startup(ByRef di As clsDirectInput8, ByVal hWindowHandle As Long) 27 | 'create reference to DirectInput object 28 | Set dinput = di 29 | 30 | 'create an interface to the keyboard 31 | Set diDev_Keyboard = dinput.DIObj.CreateDevice("GUID_SysKeyboard") 32 | 33 | diDev_Keyboard.SetCommonDataFormat DIFORMAT_KEYBOARD 34 | diDev_Keyboard.SetCooperativeLevel hWindowHandle, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE 35 | diDev_Keyboard.Acquire 36 | 37 | 'initialize the key name array 38 | InitKeyNames 39 | End Sub 40 | 41 | Public Sub Check_Keyboard() 42 | Dim n As Long 43 | If GetActiveWindow = frmJoy.hWnd Then 44 | 'make sure the keyboard handler is running 45 | If diDev_Keyboard Is Nothing Then Exit Sub 46 | 47 | 'get the list of pressed keys 48 | diDev_Keyboard.GetDeviceStateKeyboard diState_Keyboard 49 | 50 | 'scan the entire list for pressed keys 51 | For n = 0 To 255 52 | If diState_Keyboard.key(n) <> diOState_Keyboard.key(n) Then 53 | If diState_Keyboard.key(n) <> 0 Then 54 | If diOState_Keyboard.key(n) = 0 Then 55 | frmJoy.ckeydown n 56 | End If 57 | End If 58 | End If 59 | Next 60 | End If 61 | diOState_Keyboard = diState_Keyboard 62 | End Sub 63 | 64 | Public Sub Shutdown() 65 | On Local Error Resume Next 66 | 67 | 'release the keyboard 68 | If Not (diDev_Keyboard Is Nothing) Then 69 | diDev_Keyboard.Unacquire 70 | Set diDev_Keyboard = Nothing 71 | End If 72 | End Sub 73 | 74 | Public Property Get KeyName(ByVal lKey As Long) As String 75 | KeyName = sKeyNames(lKey) 76 | End Property 77 | 78 | Private Sub InitKeyNames() 79 | sKeyNames(1) = "ESC" 80 | sKeyNames(2) = "1" 81 | sKeyNames(3) = "2" 82 | sKeyNames(4) = "3" 83 | sKeyNames(5) = "4" 84 | sKeyNames(6) = "5" 85 | sKeyNames(7) = "6" 86 | sKeyNames(8) = "7" 87 | sKeyNames(9) = "8" 88 | sKeyNames(10) = "9" 89 | sKeyNames(11) = "0" 90 | sKeyNames(12) = "-" 91 | sKeyNames(13) = "=" 92 | sKeyNames(14) = "BACKSPACE" 93 | sKeyNames(15) = "TAB" 94 | sKeyNames(16) = "Q" 95 | sKeyNames(17) = "W" 96 | sKeyNames(18) = "E" 97 | sKeyNames(19) = "R" 98 | sKeyNames(20) = "T" 99 | sKeyNames(21) = "Y" 100 | sKeyNames(22) = "U" 101 | sKeyNames(23) = "I" 102 | sKeyNames(24) = "O" 103 | sKeyNames(25) = "P" 104 | sKeyNames(26) = "[" 105 | sKeyNames(27) = " ]" 106 | sKeyNames(28) = "ENTER" 107 | sKeyNames(29) = "LCTRL" 108 | sKeyNames(30) = "A" 109 | sKeyNames(31) = "S" 110 | sKeyNames(32) = "D" 111 | sKeyNames(33) = "F" 112 | sKeyNames(34) = "G" 113 | sKeyNames(35) = "H" 114 | sKeyNames(36) = "J" 115 | sKeyNames(37) = "K" 116 | sKeyNames(38) = "L" 117 | sKeyNames(39) = ";" 118 | sKeyNames(40) = "'" 119 | sKeyNames(41) = "`" 120 | sKeyNames(42) = "LSHIFT" 121 | sKeyNames(43) = "\" 122 | sKeyNames(44) = "Z" 123 | sKeyNames(45) = "X" 124 | sKeyNames(46) = "C" 125 | sKeyNames(47) = "V" 126 | sKeyNames(48) = "B" 127 | sKeyNames(49) = "N" 128 | sKeyNames(50) = "M" 129 | sKeyNames(51) = "," 130 | sKeyNames(52) = "." 131 | sKeyNames(53) = "/" 132 | sKeyNames(54) = "RSHIFT" 133 | sKeyNames(55) = "NUMPAD*" 134 | sKeyNames(56) = "LALT" 135 | sKeyNames(57) = "SPACE" 136 | sKeyNames(58) = "CAPSLOCK" 137 | sKeyNames(59) = "F1" 138 | sKeyNames(60) = "F2" 139 | sKeyNames(61) = "F3" 140 | sKeyNames(62) = "F4" 141 | sKeyNames(63) = "F5" 142 | sKeyNames(64) = "F6" 143 | sKeyNames(65) = "F7" 144 | sKeyNames(66) = "F8" 145 | sKeyNames(67) = "F9" 146 | sKeyNames(68) = "F10" 147 | sKeyNames(69) = "NUMLOCK" 148 | sKeyNames(70) = "SCRLLOCK" 149 | sKeyNames(71) = "NUMPAD7" 150 | sKeyNames(72) = "NUMPAD8" 151 | sKeyNames(73) = "NUMPAD9" 152 | sKeyNames(74) = "NUMPAD-" 153 | sKeyNames(75) = "NUMPAD4" 154 | sKeyNames(76) = "NUMPAD5" 155 | sKeyNames(77) = "NUMPAD6" 156 | sKeyNames(78) = "NUMPAD+" 157 | sKeyNames(79) = "NUMPAD1" 158 | sKeyNames(80) = "NUMPAD2" 159 | sKeyNames(81) = "NUMPAD3" 160 | sKeyNames(82) = "NUMPAD0" 161 | sKeyNames(83) = "NUMPAD." 162 | sKeyNames(87) = "F11" 163 | sKeyNames(88) = "F12" 164 | sKeyNames(86) = "F13" 165 | sKeyNames(84) = "F14" 166 | sKeyNames(85) = "F15" 167 | sKeyNames(156) = "NUMPADENTER" 168 | sKeyNames(157) = "RCONTROL" 169 | sKeyNames(91) = "NUMPAD," 170 | sKeyNames(181) = "NUMPAD/" 171 | sKeyNames(183) = "SYSRQ" 172 | sKeyNames(184) = "RALT" 173 | sKeyNames(199) = "HOME" 174 | sKeyNames(200) = "UP" 175 | sKeyNames(201) = "PGUP" 176 | sKeyNames(203) = "LEFT" 177 | sKeyNames(205) = "RIGHT" 178 | sKeyNames(207) = "END" 179 | sKeyNames(208) = "DOWN" 180 | sKeyNames(209) = "PGDN" 181 | sKeyNames(210) = "INSERT" 182 | sKeyNames(211) = "DELETE" 183 | sKeyNames(219) = "LWIN" 184 | sKeyNames(220) = "RWIN" 185 | sKeyNames(221) = "APPS" 186 | sKeyNames(116) = "PAUSE" 187 | End Sub 188 | 189 | 190 | 191 | 192 | -------------------------------------------------------------------------------- /BasicBoy/CLS/DIKeyboard8.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "clsDIKeyboard8" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | Option Base 0 16 | 17 | 'local references 18 | Dim dinput As clsDirectInput8 19 | 20 | 'class variables 21 | Dim diDev_Keyboard As DirectInputDevice8 22 | Dim diState_Keyboard As DxVBLibA.DIKEYBOARDSTATE 23 | Dim diOState_Keyboard As DxVBLibA.DIKEYBOARDSTATE 24 | Dim sKeyNames(255) As String 25 | 26 | Public Sub Startup(ByRef di As clsDirectInput8, ByVal hWindowHandle As Long) 27 | 'create reference to DirectInput object 28 | Set dinput = di 29 | 30 | 'create an interface to the keyboard 31 | Set diDev_Keyboard = dinput.DIObj.CreateDevice("GUID_SysKeyboard") 32 | 33 | diDev_Keyboard.SetCommonDataFormat DIFORMAT_KEYBOARD 34 | diDev_Keyboard.SetCooperativeLevel hWindowHandle, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE 35 | diDev_Keyboard.Acquire 36 | 37 | 'initialize the key name array 38 | InitKeyNames 39 | End Sub 40 | 41 | Public Sub Check_Keyboard() 42 | Dim n As Long, aw As Long 43 | aw = GetActiveWindow 44 | If (aw = frmMain.hwnd) Or aw = frmRender.hwnd Then 45 | 'make sure the keyboard handler is running 46 | If diDev_Keyboard Is Nothing Then Exit Sub 47 | 48 | 'get the list of pressed keys 49 | diDev_Keyboard.GetDeviceStateKeyboard diState_Keyboard 50 | 51 | 'scan the entire list for pressed keys 52 | For n = 0 To 255 53 | If diState_Keyboard.key(n) <> diOState_Keyboard.key(n) Then 54 | If diState_Keyboard.key(n) = 0 Then 55 | KeyUp (n) 56 | Else 57 | If diOState_Keyboard.key(n) = 0 Then 58 | KeyDown (n) 59 | End If 60 | End If 61 | End If 62 | Next 63 | End If 64 | diOState_Keyboard = diState_Keyboard 65 | End Sub 66 | 67 | Public Sub Shutdown() 68 | On Local Error Resume Next 69 | 70 | 'release the keyboard 71 | If Not (diDev_Keyboard Is Nothing) Then 72 | diDev_Keyboard.Unacquire 73 | Set diDev_Keyboard = Nothing 74 | End If 75 | End Sub 76 | 77 | Public Property Get KeyName(ByVal lKey As Long) As String 78 | KeyName = sKeyNames(lKey) 79 | End Property 80 | 81 | Private Sub InitKeyNames() 82 | sKeyNames(1) = "ESC" 83 | sKeyNames(2) = "1" 84 | sKeyNames(3) = "2" 85 | sKeyNames(4) = "3" 86 | sKeyNames(5) = "4" 87 | sKeyNames(6) = "5" 88 | sKeyNames(7) = "6" 89 | sKeyNames(8) = "7" 90 | sKeyNames(9) = "8" 91 | sKeyNames(10) = "9" 92 | sKeyNames(11) = "0" 93 | sKeyNames(12) = "-" 94 | sKeyNames(13) = "=" 95 | sKeyNames(14) = "BACKSPACE" 96 | sKeyNames(15) = "TAB" 97 | sKeyNames(16) = "Q" 98 | sKeyNames(17) = "W" 99 | sKeyNames(18) = "E" 100 | sKeyNames(19) = "R" 101 | sKeyNames(20) = "T" 102 | sKeyNames(21) = "Y" 103 | sKeyNames(22) = "U" 104 | sKeyNames(23) = "I" 105 | sKeyNames(24) = "O" 106 | sKeyNames(25) = "P" 107 | sKeyNames(26) = "[" 108 | sKeyNames(27) = " ]" 109 | sKeyNames(28) = "ENTER" 110 | sKeyNames(29) = "LCTRL" 111 | sKeyNames(30) = "A" 112 | sKeyNames(31) = "S" 113 | sKeyNames(32) = "D" 114 | sKeyNames(33) = "F" 115 | sKeyNames(34) = "G" 116 | sKeyNames(35) = "H" 117 | sKeyNames(36) = "J" 118 | sKeyNames(37) = "K" 119 | sKeyNames(38) = "L" 120 | sKeyNames(39) = ";" 121 | sKeyNames(40) = "'" 122 | sKeyNames(41) = "`" 123 | sKeyNames(42) = "LSHIFT" 124 | sKeyNames(43) = "\" 125 | sKeyNames(44) = "Z" 126 | sKeyNames(45) = "X" 127 | sKeyNames(46) = "C" 128 | sKeyNames(47) = "V" 129 | sKeyNames(48) = "B" 130 | sKeyNames(49) = "N" 131 | sKeyNames(50) = "M" 132 | sKeyNames(51) = "," 133 | sKeyNames(52) = "." 134 | sKeyNames(53) = "/" 135 | sKeyNames(54) = "RSHIFT" 136 | sKeyNames(55) = "NUMPAD*" 137 | sKeyNames(56) = "LALT" 138 | sKeyNames(57) = "SPACE" 139 | sKeyNames(58) = "CAPSLOCK" 140 | sKeyNames(59) = "F1" 141 | sKeyNames(60) = "F2" 142 | sKeyNames(61) = "F3" 143 | sKeyNames(62) = "F4" 144 | sKeyNames(63) = "F5" 145 | sKeyNames(64) = "F6" 146 | sKeyNames(65) = "F7" 147 | sKeyNames(66) = "F8" 148 | sKeyNames(67) = "F9" 149 | sKeyNames(68) = "F10" 150 | sKeyNames(69) = "NUMLOCK" 151 | sKeyNames(70) = "SCRLLOCK" 152 | sKeyNames(71) = "NUMPAD7" 153 | sKeyNames(72) = "NUMPAD8" 154 | sKeyNames(73) = "NUMPAD9" 155 | sKeyNames(74) = "NUMPAD-" 156 | sKeyNames(75) = "NUMPAD4" 157 | sKeyNames(76) = "NUMPAD5" 158 | sKeyNames(77) = "NUMPAD6" 159 | sKeyNames(78) = "NUMPAD+" 160 | sKeyNames(79) = "NUMPAD1" 161 | sKeyNames(80) = "NUMPAD2" 162 | sKeyNames(81) = "NUMPAD3" 163 | sKeyNames(82) = "NUMPAD0" 164 | sKeyNames(83) = "NUMPAD." 165 | sKeyNames(87) = "F11" 166 | sKeyNames(88) = "F12" 167 | sKeyNames(86) = "F13" 168 | sKeyNames(84) = "F14" 169 | sKeyNames(85) = "F15" 170 | sKeyNames(156) = "NUMPADENTER" 171 | sKeyNames(157) = "RCONTROL" 172 | sKeyNames(91) = "NUMPAD," 173 | sKeyNames(181) = "NUMPAD/" 174 | sKeyNames(183) = "SYSRQ" 175 | sKeyNames(184) = "RALT" 176 | sKeyNames(199) = "HOME" 177 | sKeyNames(200) = "UP" 178 | sKeyNames(201) = "PGUP" 179 | sKeyNames(203) = "LEFT" 180 | sKeyNames(205) = "RIGHT" 181 | sKeyNames(207) = "END" 182 | sKeyNames(208) = "DOWN" 183 | sKeyNames(209) = "PGDN" 184 | sKeyNames(210) = "INSERT" 185 | sKeyNames(211) = "DELETE" 186 | sKeyNames(219) = "LWIN" 187 | sKeyNames(220) = "RWIN" 188 | sKeyNames(221) = "APPS" 189 | sKeyNames(116) = "PAUSE" 190 | End Sub 191 | 192 | 193 | 194 | -------------------------------------------------------------------------------- /BasicBoy/DIKeyboard8.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "clsDIKeyboard8" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | Option Base 0 16 | 17 | 'local references 18 | Dim dinput As clsDirectInput8 19 | 20 | 'class variables 21 | Dim diDev_Keyboard As DirectInputDevice8 22 | Dim diState_Keyboard As DxVBLibA.DIKEYBOARDSTATE 23 | Dim diOState_Keyboard As DxVBLibA.DIKEYBOARDSTATE 24 | Dim sKeyNames(255) As String 25 | 26 | Public Sub Startup(ByRef di As clsDirectInput8, ByVal hWindowHandle As Long) 27 | 'create reference to DirectInput object 28 | Set dinput = di 29 | 30 | 'create an interface to the keyboard 31 | Set diDev_Keyboard = dinput.DIObj.CreateDevice("GUID_SysKeyboard") 32 | 33 | diDev_Keyboard.SetCommonDataFormat DIFORMAT_KEYBOARD 34 | diDev_Keyboard.SetCooperativeLevel hWindowHandle, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE 35 | diDev_Keyboard.Acquire 36 | 37 | 'initialize the key name array 38 | InitKeyNames 39 | End Sub 40 | 41 | Public Sub Check_Keyboard() 42 | Dim n As Long, aw As Long 43 | aw = GetActiveWindow 44 | If (aw = frmMain.hwnd) Or aw = frmRender.hwnd Then 45 | 'make sure the keyboard handler is running 46 | If diDev_Keyboard Is Nothing Then Exit Sub 47 | 48 | 'get the list of pressed keys 49 | diDev_Keyboard.GetDeviceStateKeyboard diState_Keyboard 50 | 51 | 'scan the entire list for pressed keys 52 | For n = 0 To 255 53 | If diState_Keyboard.key(n) <> diOState_Keyboard.key(n) Then 54 | If diState_Keyboard.key(n) = 0 Then 55 | KeyUp (n) 56 | Else 57 | If diOState_Keyboard.key(n) = 0 Then 58 | KeyDown (n) 59 | End If 60 | End If 61 | End If 62 | Next 63 | End If 64 | diOState_Keyboard = diState_Keyboard 65 | End Sub 66 | 67 | Public Sub Shutdown() 68 | On Local Error Resume Next 69 | 70 | 'release the keyboard 71 | If Not (diDev_Keyboard Is Nothing) Then 72 | diDev_Keyboard.Unacquire 73 | Set diDev_Keyboard = Nothing 74 | End If 75 | End Sub 76 | 77 | Public Property Get KeyName(ByVal lKey As Long) As String 78 | KeyName = sKeyNames(lKey) 79 | End Property 80 | 81 | Private Sub InitKeyNames() 82 | sKeyNames(1) = "ESC" 83 | sKeyNames(2) = "1" 84 | sKeyNames(3) = "2" 85 | sKeyNames(4) = "3" 86 | sKeyNames(5) = "4" 87 | sKeyNames(6) = "5" 88 | sKeyNames(7) = "6" 89 | sKeyNames(8) = "7" 90 | sKeyNames(9) = "8" 91 | sKeyNames(10) = "9" 92 | sKeyNames(11) = "0" 93 | sKeyNames(12) = "-" 94 | sKeyNames(13) = "=" 95 | sKeyNames(14) = "BACKSPACE" 96 | sKeyNames(15) = "TAB" 97 | sKeyNames(16) = "Q" 98 | sKeyNames(17) = "W" 99 | sKeyNames(18) = "E" 100 | sKeyNames(19) = "R" 101 | sKeyNames(20) = "T" 102 | sKeyNames(21) = "Y" 103 | sKeyNames(22) = "U" 104 | sKeyNames(23) = "I" 105 | sKeyNames(24) = "O" 106 | sKeyNames(25) = "P" 107 | sKeyNames(26) = "[" 108 | sKeyNames(27) = " ]" 109 | sKeyNames(28) = "ENTER" 110 | sKeyNames(29) = "LCTRL" 111 | sKeyNames(30) = "A" 112 | sKeyNames(31) = "S" 113 | sKeyNames(32) = "D" 114 | sKeyNames(33) = "F" 115 | sKeyNames(34) = "G" 116 | sKeyNames(35) = "H" 117 | sKeyNames(36) = "J" 118 | sKeyNames(37) = "K" 119 | sKeyNames(38) = "L" 120 | sKeyNames(39) = ";" 121 | sKeyNames(40) = "'" 122 | sKeyNames(41) = "`" 123 | sKeyNames(42) = "LSHIFT" 124 | sKeyNames(43) = "\" 125 | sKeyNames(44) = "Z" 126 | sKeyNames(45) = "X" 127 | sKeyNames(46) = "C" 128 | sKeyNames(47) = "V" 129 | sKeyNames(48) = "B" 130 | sKeyNames(49) = "N" 131 | sKeyNames(50) = "M" 132 | sKeyNames(51) = "," 133 | sKeyNames(52) = "." 134 | sKeyNames(53) = "/" 135 | sKeyNames(54) = "RSHIFT" 136 | sKeyNames(55) = "NUMPAD*" 137 | sKeyNames(56) = "LALT" 138 | sKeyNames(57) = "SPACE" 139 | sKeyNames(58) = "CAPSLOCK" 140 | sKeyNames(59) = "F1" 141 | sKeyNames(60) = "F2" 142 | sKeyNames(61) = "F3" 143 | sKeyNames(62) = "F4" 144 | sKeyNames(63) = "F5" 145 | sKeyNames(64) = "F6" 146 | sKeyNames(65) = "F7" 147 | sKeyNames(66) = "F8" 148 | sKeyNames(67) = "F9" 149 | sKeyNames(68) = "F10" 150 | sKeyNames(69) = "NUMLOCK" 151 | sKeyNames(70) = "SCRLLOCK" 152 | sKeyNames(71) = "NUMPAD7" 153 | sKeyNames(72) = "NUMPAD8" 154 | sKeyNames(73) = "NUMPAD9" 155 | sKeyNames(74) = "NUMPAD-" 156 | sKeyNames(75) = "NUMPAD4" 157 | sKeyNames(76) = "NUMPAD5" 158 | sKeyNames(77) = "NUMPAD6" 159 | sKeyNames(78) = "NUMPAD+" 160 | sKeyNames(79) = "NUMPAD1" 161 | sKeyNames(80) = "NUMPAD2" 162 | sKeyNames(81) = "NUMPAD3" 163 | sKeyNames(82) = "NUMPAD0" 164 | sKeyNames(83) = "NUMPAD." 165 | sKeyNames(87) = "F11" 166 | sKeyNames(88) = "F12" 167 | sKeyNames(86) = "F13" 168 | sKeyNames(84) = "F14" 169 | sKeyNames(85) = "F15" 170 | sKeyNames(156) = "NUMPADENTER" 171 | sKeyNames(157) = "RCONTROL" 172 | sKeyNames(91) = "NUMPAD," 173 | sKeyNames(181) = "NUMPAD/" 174 | sKeyNames(183) = "SYSRQ" 175 | sKeyNames(184) = "RALT" 176 | sKeyNames(199) = "HOME" 177 | sKeyNames(200) = "UP" 178 | sKeyNames(201) = "PGUP" 179 | sKeyNames(203) = "LEFT" 180 | sKeyNames(205) = "RIGHT" 181 | sKeyNames(207) = "END" 182 | sKeyNames(208) = "DOWN" 183 | sKeyNames(209) = "PGDN" 184 | sKeyNames(210) = "INSERT" 185 | sKeyNames(211) = "DELETE" 186 | sKeyNames(219) = "LWIN" 187 | sKeyNames(220) = "RWIN" 188 | sKeyNames(221) = "APPS" 189 | sKeyNames(116) = "PAUSE" 190 | End Sub 191 | 192 | 193 | 194 | -------------------------------------------------------------------------------- /BasicBoy/help.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | BasicBoy Help 5 | 6 | 7 | 8 | 9 | BasicBoy Help Document 10 | 11 |

Basic Usage:

12 |

Loading a ROM
13 | To load a rom simply click the File menu, and navigate to “Open ROM”, 14 | after you have done that a dialog will appear asking you where the ROM is stored, 15 | once you have found the rom and opened it, BasicBoy will automatically start 16 | emulating it.

17 |

Resetting a ROM
18 | Sometimes a game can hang for one reason or another and you may need to reset 19 | the rom, to do this simply click the File menu, and select "Reset ROM", 20 | after you have done this the game will completely restart.

21 |

ROM Information
22 | You can access some of the hidden ROM information by clicking the File menu 23 | and selecting “ROM Information”.

24 |

Saving States
25 | You may save your progress anywhere in any game with this, to save a state simply 26 | click the File menu and navigate to “Save State”, after you have 27 | made it to “Save State” menu, you may select a slot to save. There 28 | are 8 separate slots for saving progress on each game, the save state files 29 | are stored locally inside the BasicBoy Directory in the following format “<lowercase 30 | ROM name>.st<slot number>”. So if you saved to Slot #1 on Mario 31 | the filename would be “Mario.st0”. Please note: If you save in a 32 | slot that has already been saved into, the previous save will be overwritten.

33 |

Loading States
34 | Loading your state is simple as well, simply load the ROM you where playing 35 | when you saved your state and click on the File menu, “Load State”, 36 | and select the exact slot you saved to and it will automatically load to the 37 | exact point at which you saved.

38 |

Options:

39 |

Emulated Hardware
40 | You can decide not to emulate certain aspects of gameboy's hardware such as 41 | Sound, Color, and Link. If you wanted to run Tetris-DX without color, you can 42 | simple disable Color and it will run as if it was on an old gameboy.

43 |

Frame Skip
44 | On slower machines especially, the computer may not have enough power to keep 45 | up with the frame rate, skip frames to increase speed and performance.

46 |

Render Method
47 | On some machines DirectDraw works better and on others WinApi, I only suggest 48 | you change this if you are getting slower speeds with one of them. I personally 49 | suggest DirectDraw if you have a video card made specifically for 3D.

50 |

Resolution
51 | You may have up to 4X the original GameBoy screen size and full screen if you 52 | so choose. Please note: If you have WinApi on and you go with a bigger screen 53 | you may see a performance drop.

54 |

Layers
55 | These are the different layers of the GameBoy color, If you disable one or all 56 | of them, you may find very strange effects on the ROM, such as sprites disappearing, 57 | stuff not getting drawn. I don’t see any reason why you would need to 58 | mess with this, but just incase it’s included.

59 |

Sound Buffer
60 | On some machines you need a smaller or bigger sound buffer, normally the smaller 61 | the sound buffer, the more crackling and popping you will hear. We recommend 62 | you leave it at 8 milliseconds.

63 |

Sound Render Method
64 | On some machines software sound works better than hardware and on others, hardware 65 | works better than software. Please note: Some machines lock up when on hardware 66 | sound mode, this has been linked to certain cards by Creative Sound. We recommend 67 | you leave it at software sound for best performance.

68 |

Cheat Codes
69 | Yes you can cheat, this is much like an old-style GameShark, you have to find 70 | the codes yourself by doing searches. Please note: This feature is currently 71 | very buggy and I would not recommend using it.

72 |

Configure Keys
73 | You may configure the keyboard to your liking so you may play GameBoy to the 74 | maximum extent possible.

75 |

Fast Sound Off
76 | When you are running the ROM high speed, this will make sure it does not play 77 | sound while you are running the ROM at 70 Mhz.

78 |

Fast Skip On
79 | When you are running the ROM high speed, this will make sure it skips frames 80 | while its running at the high speed, if its off then it will still do every 81 | frame but it will be at least 2X faster.

82 |

Limit FPS
83 | This limits the frames per second that the emulator displays. Please Note: Right 84 | now you cannot turn this feature off.

85 |

Shortcut Keys
86 | There are not many shortcut keys, but holding TAB speeds the ROM execution up 87 | to MAX SPEED, and F8 takes a screenshot and saves it in the BasicBoy Directory.
88 |
89 | Any questions or comments just goto http://basicboy.emuhost.com/
90 |
91 | Help Document written by Xeon.

92 |

 

93 | 94 | 95 | -------------------------------------------------------------------------------- /BasicBoy/frmSpeed.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmSpeed 3 | Caption = "Frame Delay Configuration" 4 | ClientHeight = 4635 5 | ClientLeft = 60 6 | ClientTop = 450 7 | ClientWidth = 4575 8 | LinkTopic = "Form1" 9 | ScaleHeight = 4635 10 | ScaleWidth = 4575 11 | StartUpPosition = 3 'Windows Default 12 | Begin VB.Frame frmCpu 13 | Caption = "Cpu Over/Under-clock" 14 | Height = 2175 15 | Left = 120 16 | TabIndex = 5 17 | Top = 1920 18 | Width = 4335 19 | Begin VB.HScrollBar sSpeed 20 | Height = 255 21 | Left = 120 22 | Max = 200 23 | Min = 1 24 | TabIndex = 10 25 | Top = 360 26 | Value = 100 27 | Width = 4095 28 | End 29 | Begin VB.Label Label7 30 | Caption = $"frmSpeed.frx":0000 31 | Height = 1095 32 | Left = 120 33 | TabIndex = 13 34 | Top = 960 35 | Width = 3975 36 | End 37 | Begin VB.Line Line1 38 | X1 = 2160 39 | X2 = 2160 40 | Y1 = 240 41 | Y2 = 600 42 | End 43 | Begin VB.Label Label6 44 | Caption = "100%" 45 | Height = 255 46 | Left = 840 47 | TabIndex = 12 48 | Top = 720 49 | Width = 495 50 | End 51 | Begin VB.Label Label5 52 | Caption = "Speed : " 53 | Height = 255 54 | Left = 120 55 | TabIndex = 11 56 | Top = 720 57 | Width = 615 58 | End 59 | End 60 | Begin VB.HScrollBar fde 61 | Height = 255 62 | LargeChange = 10 63 | Left = 240 64 | Max = 6400 65 | Min = 1 66 | TabIndex = 4 67 | Top = 600 68 | Value = 1600 69 | Width = 4095 70 | End 71 | Begin VB.CommandButton Command1 72 | Caption = "restore" 73 | Height = 255 74 | Left = 3240 75 | TabIndex = 3 76 | Top = 960 77 | Width = 735 78 | End 79 | Begin VB.CommandButton Command2 80 | Caption = "Close" 81 | Height = 375 82 | Left = 120 83 | TabIndex = 2 84 | Top = 4200 85 | Width = 4335 86 | End 87 | Begin VB.CheckBox chkTgt 88 | Caption = "Do not use QueryPerformaceCounter(if you have speed problems, try it)" 89 | Height = 375 90 | Left = 240 91 | TabIndex = 1 92 | ToolTipText = "Use GetTickCount Insted of QueryPerformaceCounter.Try it if you have speed problems." 93 | Top = 1320 94 | Width = 4095 95 | End 96 | Begin VB.Frame frmDG 97 | Caption = "Frame Delay" 98 | Height = 1815 99 | Left = 120 100 | TabIndex = 0 101 | Top = 0 102 | Width = 4335 103 | Begin VB.Label Label1 104 | Caption = "Normal value : 16.00,Current :" 105 | Height = 255 106 | Left = 120 107 | TabIndex = 6 108 | Top = 960 109 | Width = 2175 110 | End 111 | Begin VB.Label Label4 112 | Caption = "15.00 ->" 113 | Height = 255 114 | Left = 600 115 | TabIndex = 9 116 | Top = 360 117 | Width = 615 118 | End 119 | Begin VB.Label Label3 120 | Caption = " <- 16.00" 121 | Height = 255 122 | Left = 1440 123 | TabIndex = 8 124 | Top = 360 125 | Width = 735 126 | End 127 | Begin VB.Label Label2 128 | Caption = "16.00" 129 | Height = 255 130 | Left = 2280 131 | TabIndex = 7 132 | Top = 960 133 | Width = 855 134 | End 135 | Begin VB.Line Line4 136 | X1 = 1245 137 | X2 = 1245 138 | Y1 = 360 139 | Y2 = 840 140 | End 141 | Begin VB.Line Line3 142 | X1 = 1320 143 | X2 = 1320 144 | Y1 = 360 145 | Y2 = 840 146 | End 147 | End 148 | Begin VB.Line Line2 149 | X1 = 1480 150 | X2 = 1470 151 | Y1 = 240 152 | Y2 = 720 153 | End 154 | End 155 | Attribute VB_Name = "frmSpeed" 156 | Attribute VB_GlobalNameSpace = False 157 | Attribute VB_Creatable = False 158 | Attribute VB_PredeclaredId = True 159 | Attribute VB_Exposed = False 160 | 'To configure the frame limiting mode/delay 161 | 'Added on v2.0.1 162 | Option Explicit 163 | 164 | Private Sub chkTgt_Click() 165 | SaveSetting "BasicBoy", "misc", "timermode", Abs(chkTgt.value) 166 | gtc = Abs(chkTgt.value) 167 | If gtc Then 168 | Label1.Caption = "Normal value : 15.00,Current :" 169 | Else 170 | Label1.Caption = "Normal value : 16.00,Current :" 171 | End If 172 | End Sub 173 | 174 | Private Sub Command1_Click() 175 | 'since gettickcount has lower resolution(15 ms) 176 | 'will round 16 to 30 ...so use 15 177 | If gtc Then 178 | fde.value = 1500 179 | Else 180 | fde.value = 1600 181 | End If 182 | End Sub 183 | 184 | Private Sub Command2_Click() 185 | Me.Hide 186 | Unload Me 187 | End Sub 188 | 189 | Private Sub fde_Change() 190 | framedelay = fde.value / 100 191 | Label2.Caption = format$(framedelay, "00.00") 192 | End Sub 193 | 194 | Private Sub fde_Scroll() 195 | fde_Change 196 | End Sub 197 | 198 | Private Sub Form_Load() 199 | If gtc Then 200 | Label1.Caption = "Normal value : 15.00,Current :" 201 | Else 202 | Label1.Caption = "Normal value : 16.00,Current :" 203 | End If 204 | fde.value = framedelay * 100 205 | chkTgt.value = gtc 206 | sSpeed.value = (1 / Cpu_Speed) * 100 207 | End Sub 208 | 209 | Private Sub sSpeed_Change() 210 | Cpu_Speed = 1 / (sSpeed.value / 100) 211 | Label6.Caption = format$(1 / Cpu_Speed, "000%") 212 | InitCPU 213 | End Sub 214 | 215 | Private Sub sSpeed_Scroll() 216 | sSpeed_Change 217 | End Sub 218 | -------------------------------------------------------------------------------- /BasicBoy/modSaveState.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modSaveState" 2 | Option Explicit 3 | 4 | '## This is a part of the BasicBoy emulator 5 | '## You are not allowed to release modified(or unmodified) versions 6 | '## without asking me (Raziel). 7 | '## For Suggestions ect please e-mail at :stef_mp@yahoo.gr 8 | '## To download the latestt version/source goto basicboy.emuhost.com 9 | '## 10 | '## Save state module by Xeon. (http://www.xeons.net) 11 | '## Version 1.0 12 | 13 | Public Sub saveState(Index As Integer) 14 | On Error GoTo BadSave: 15 | If rominfo.Title = vbNullString Then 16 | MsgBox "No rom loaded!", vbCritical, "Invalid Slot" 17 | Exit Sub 18 | End If 19 | Dim iFreeFile As Integer 20 | iFreeFile = FreeFile 21 | Open App.Path & "\gbsavestate.dat" For Binary As #iFreeFile 22 | Put #iFreeFile, , hline 23 | Put #iFreeFile, , IME 24 | Put #iFreeFile, , GBM 25 | Put #iFreeFile, , f_lowbits 26 | Put #iFreeFile, , zf 27 | Put #iFreeFile, , nf 28 | Put #iFreeFile, , hf 29 | Put #iFreeFile, , cf 30 | Put #iFreeFile, , b 31 | Put #iFreeFile, , c 32 | Put #iFreeFile, , D 33 | Put #iFreeFile, , E 34 | Put #iFreeFile, , H 35 | Put #iFreeFile, , L 36 | Put #iFreeFile, , PC 37 | Put #iFreeFile, , SP 38 | Put #iFreeFile, , cldr 39 | Put #iFreeFile, , Clm0 40 | Put #iFreeFile, , clm3 41 | Put #iFreeFile, , cllc 42 | Put #iFreeFile, , CpuS 43 | Put #iFreeFile, , RAM 44 | Put #iFreeFile, , bRam 45 | Put #iFreeFile, , Vram 46 | Put #iFreeFile, , mir 47 | Put #iFreeFile, , mv1 48 | Put #iFreeFile, , mv2 49 | Put #iFreeFile, , vf 50 | Put #iFreeFile, , cid2 51 | Put #iFreeFile, , tiletmp 52 | Put #iFreeFile, , xs 53 | Put #iFreeFile, , ys 54 | Put #iFreeFile, , xt 55 | Put #iFreeFile, , tobj 56 | Put #iFreeFile, , thdc 57 | Put #iFreeFile, , DH 58 | Put #iFreeFile, , Dw 59 | Put #iFreeFile, , xr 60 | Put #iFreeFile, , yr 61 | Put #iFreeFile, , fskip 62 | Put #iFreeFile, , fmode 63 | Put #iFreeFile, , objp 64 | Put #iFreeFile, , bgp 65 | Put #iFreeFile, , vrm 66 | Put #iFreeFile, , ccp 67 | Put #iFreeFile, , ccid 68 | Put #iFreeFile, , tm2 69 | Put #iFreeFile, , tm1 70 | Put #iFreeFile, , bgat 71 | Put #iFreeFile, , wv 72 | Put #iFreeFile, , bgv 73 | Put #iFreeFile, , objv 74 | Put #iFreeFile, , xflip 75 | Put #iFreeFile, , yflip 76 | Put #iFreeFile, , lastline 77 | Put #iFreeFile, , curline 78 | Put #iFreeFile, , tcls 79 | Put #iFreeFile, , curFreq 80 | Put #iFreeFile, , curStart 81 | 'Put #iFreeFile, , CurEnd 82 | Put #iFreeFile, , dblResult 83 | Put #iFreeFile, , Skipf 84 | Put #iFreeFile, , bgpCC 85 | Put #iFreeFile, , objpCC 86 | Put #iFreeFile, , CurRAMBank 87 | Put #iFreeFile, , CurROMBank 88 | Close #iFreeFile 89 | 'Excellent Fast Compression System from BasicNES ;-) 90 | RLECompress App.Path & "\gbsavestate.dat", App.Path & "\" & LCase(rominfo.Title) & ".st" & CStr(Index) 91 | 'Delete temp 92 | Kill App.Path & "\gbsavestate.dat" 93 | Exit Sub 94 | BadSave: 95 | MsgBox "Save State Error" & vbCrLf & _ 96 | "--------------------------------------------" & vbCrLf & _ 97 | err.Description & vbCrLf & _ 98 | "--------------------------------------------", vbCritical, "Save State Error" 99 | End Sub 100 | 101 | Public Sub loadState(Index As Integer) 102 | On Error GoTo BadLoad: 103 | If rominfo.Title = vbNullString Then 104 | MsgBox "No rom loaded!", vbCritical, "Invalid Slot" 105 | Exit Sub 106 | End If 107 | If FileExist(App.Path & "\" & LCase(rominfo.Title) & ".st" & CStr(Index)) = False Then 108 | MsgBox "Invalid Load Slot", vbCritical, "Invalid Slot" 109 | Exit Sub 110 | End If 111 | Dim iFreeFile As Integer 112 | iFreeFile = FreeFile 113 | RLEDecompress App.Path & "\" & LCase(rominfo.Title) & ".st" & CStr(Index), App.Path & "\gbsavestate.dat" 114 | Open App.Path & "\gbsavestate.dat" For Binary As #iFreeFile 115 | Get #iFreeFile, , hline 116 | Get #iFreeFile, , IME 117 | Get #iFreeFile, , GBM 118 | Get #iFreeFile, , f_lowbits 119 | Get #iFreeFile, , zf 120 | Get #iFreeFile, , nf 121 | Get #iFreeFile, , hf 122 | Get #iFreeFile, , cf 123 | Get #iFreeFile, , b 124 | Get #iFreeFile, , c 125 | Get #iFreeFile, , D 126 | Get #iFreeFile, , E 127 | Get #iFreeFile, , H 128 | Get #iFreeFile, , L 129 | Get #iFreeFile, , PC 130 | Get #iFreeFile, , SP 131 | Get #iFreeFile, , cldr 132 | Get #iFreeFile, , Clm0 133 | Get #iFreeFile, , clm3 134 | Get #iFreeFile, , cllc 135 | Get #iFreeFile, , CpuS 136 | Get #iFreeFile, , RAM 137 | Get #iFreeFile, , bRam 138 | Get #iFreeFile, , Vram '?? 139 | Get #iFreeFile, , mir 140 | Get #iFreeFile, , mv1 141 | Get #iFreeFile, , mv2 142 | Get #iFreeFile, , vf 143 | Get #iFreeFile, , cid2 144 | Get #iFreeFile, , tiletmp 145 | Get #iFreeFile, , xs 146 | Get #iFreeFile, , ys 147 | Get #iFreeFile, , xt 148 | Get #iFreeFile, , tobj 149 | Get #iFreeFile, , thdc 150 | Get #iFreeFile, , DH 151 | Get #iFreeFile, , Dw 152 | Get #iFreeFile, , xr 153 | Get #iFreeFile, , yr 154 | Get #iFreeFile, , fskip 155 | Get #iFreeFile, , fmode 156 | Get #iFreeFile, , objp 157 | Get #iFreeFile, , bgp 158 | Get #iFreeFile, , vrm 159 | Get #iFreeFile, , ccp 160 | Get #iFreeFile, , ccid 161 | Get #iFreeFile, , tm2 162 | Get #iFreeFile, , tm1 163 | Get #iFreeFile, , bgat 164 | Get #iFreeFile, , wv 165 | Get #iFreeFile, , bgv 166 | Get #iFreeFile, , objv 167 | Get #iFreeFile, , xflip 168 | Get #iFreeFile, , yflip 169 | Get #iFreeFile, , lastline 170 | Get #iFreeFile, , curline 171 | Get #iFreeFile, , tcls 172 | Get #iFreeFile, , curFreq 173 | Get #iFreeFile, , curStart 174 | 'Get #iFreeFile, , CurEnd 175 | Get #iFreeFile, , dblResult 176 | Get #iFreeFile, , Skipf 177 | Get #iFreeFile, , bgpCC 178 | Get #iFreeFile, , objpCC 179 | Get #iFreeFile, , CurRAMBank 180 | Get #iFreeFile, , CurROMBank 181 | Close #iFreeFile 182 | Kill App.Path & "\gbsavestate.dat" 183 | Exit Sub 184 | BadLoad: 185 | MsgBox "Load State Error" & vbCrLf & _ 186 | "--------------------------------------------" & vbCrLf & _ 187 | err.Description & vbCrLf & _ 188 | "--------------------------------------------", vbCritical, "Load State Error" 189 | End Sub 190 | 191 | Public Function FileExist(strFileName As String) As Boolean 192 | On Error Resume Next 193 | If strFileName = "" Then 194 | FileExist = False 195 | Exit Function 196 | End If 197 | FileExist = (Dir(strFileName) <> "") 198 | End Function 199 | -------------------------------------------------------------------------------- /BasicBoy/frmCheat.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmCheat 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "Ram Cheats" 5 | ClientHeight = 4215 6 | ClientLeft = 45 7 | ClientTop = 435 8 | ClientWidth = 9735 9 | Icon = "frmCheat.frx":0000 10 | LinkTopic = "Form2" 11 | MaxButton = 0 'False 12 | ScaleHeight = 4215 13 | ScaleWidth = 9735 14 | StartUpPosition = 3 'Windows Default 15 | Begin VB.CommandButton Rescmd 16 | Caption = "Resume" 17 | Height = 345 18 | Left = 7560 19 | TabIndex = 11 20 | Top = 3720 21 | Width = 2055 22 | End 23 | Begin VB.CommandButton cmdCopy 24 | Caption = "Copy" 25 | Height = 345 26 | Left = 9000 27 | TabIndex = 10 28 | Top = 2280 29 | Width = 615 30 | End 31 | Begin VB.CommandButton cmdCo 32 | Caption = "Change offset" 33 | Height = 345 34 | Left = 7560 35 | TabIndex = 9 36 | Top = 2280 37 | Width = 1335 38 | End 39 | Begin VB.CheckBox chkck 40 | Caption = "Use cheats" 41 | Height = 255 42 | Left = 7680 43 | TabIndex = 8 44 | Top = 1920 45 | Width = 1935 46 | End 47 | Begin VB.ListBox lsttm 48 | Height = 2010 49 | Left = 120 50 | TabIndex = 7 51 | Top = 120 52 | Width = 7215 53 | End 54 | Begin VB.ListBox lstAdr 55 | Height = 1815 56 | Left = 120 57 | TabIndex = 6 58 | Top = 2280 59 | Width = 7215 60 | End 61 | Begin VB.CommandButton cmdLod 62 | Caption = "Load List" 63 | Height = 345 64 | Left = 7560 65 | TabIndex = 5 66 | Top = 3240 67 | Width = 2055 68 | End 69 | Begin VB.CommandButton cmdSav 70 | Caption = "Save List" 71 | Height = 345 72 | Left = 7560 73 | TabIndex = 4 74 | Top = 2760 75 | Width = 2055 76 | End 77 | Begin VB.CommandButton cmdNew 78 | Caption = "Restart" 79 | Height = 345 80 | Left = 7680 81 | TabIndex = 3 82 | Top = 1440 83 | Width = 1935 84 | End 85 | Begin VB.CommandButton cmdFind 86 | Caption = "Find the value" 87 | Height = 345 88 | Left = 7680 89 | TabIndex = 2 90 | Top = 960 91 | Width = 1935 92 | End 93 | Begin VB.TextBox txtVal 94 | Height = 285 95 | Left = 7680 96 | TabIndex = 1 97 | Top = 600 98 | Width = 1935 99 | End 100 | Begin VB.ComboBox cmbsiz 101 | Height = 315 102 | ItemData = "frmCheat.frx":058A 103 | Left = 7680 104 | List = "frmCheat.frx":0597 105 | TabIndex = 0 106 | Text = "Combo1" 107 | Top = 240 108 | Width = 1935 109 | End 110 | End 111 | Attribute VB_Name = "frmCheat" 112 | Attribute VB_GlobalNameSpace = False 113 | Attribute VB_Creatable = False 114 | Attribute VB_PredeclaredId = True 115 | Attribute VB_Exposed = False 116 | Option Explicit 117 | Private Type cheat 118 | Adr As Long 119 | Siz As Byte 120 | val(3) As Byte 121 | Frz As Boolean 122 | rb As Long 123 | End Type 124 | Dim fs As Boolean 125 | Dim cheats() As cheat 126 | Dim tcheats() As cheat 127 | Dim uch As Boolean 128 | 129 | Private Sub chkck_Click() 130 | uch = chkck.value 131 | End Sub 132 | 133 | Private Sub cmdCo_Click() 134 | On Error GoTo to1 135 | cheats(lstAdr.ListIndex).Adr = val(InputBox("Give a new address (old was " & cheats(lstAdr.ListIndex).Adr & " ) ", "Cheats")) 136 | UpdateList lstAdr, cheats 137 | Exit Sub 138 | to1: 139 | End Sub 140 | 141 | Private Sub cmdCopy_Click() 142 | On Error GoTo to1 143 | ReDim Preserve cheats(UBound(cheats) + 1) 144 | cheats(UBound(cheats)) = cheats(lstAdr.ListIndex) 145 | UpdateList lstAdr, cheats 146 | Exit Sub 147 | to1: 148 | End Sub 149 | 150 | Private Sub cmdFind_Click() 151 | Dim i As Long, csiz As Byte, wval(3) As Byte, ti As Long, rb As Long 152 | On Error Resume Next 153 | ReDim tcheats(99999) 154 | csiz = cmbsiz.ListIndex 155 | If csiz = 1 Then 156 | wval(1) = val(txtVal.Text) \ 256: wval(0) = val(txtVal.Text) And 255 157 | Else 158 | wval(0) = val(txtVal.Text) And 255 159 | End If 160 | If csiz = 0 Then 161 | For rb = 0 To 7 162 | For i = LBound(RAM) To UBound(RAM) 163 | If readHackM(i, rb) = wval(0) Then 164 | tcheats(ti).Adr = i 165 | tcheats(ti).rb = rb 166 | tcheats(ti).val(0) = readHackM(i, rb) 167 | tcheats(ti).Siz = csiz 168 | ti = ti + 1 169 | End If 170 | Next i 171 | Next rb 172 | ElseIf csiz = 1 Then 173 | For rb = 0 To 7 174 | For i = LBound(RAM) To UBound(RAM) Step 2 175 | If readHackM(i, rb) = wval(1) And readHackM(i + 1, rb) = wval(0) Then 176 | tcheats(ti).Adr = i 177 | tcheats(ti).val(0) = readHackM(i, rb): tcheats(ti).val(1) = readHackM(i + 1, rb) 178 | tcheats(ti).Siz = csiz 179 | tcheats(ti).rb = rb 180 | ti = ti + 1 181 | End If 182 | Next i 183 | Next rb 184 | End If 185 | If ti = 0 Then ti = 1 186 | ReDim Preserve tcheats(ti - 1) 187 | UpdateList lsttm, tcheats 188 | End Sub 189 | 190 | Private Sub cmdLod_Click() 191 | Dim tmp As Long, mt As String 192 | mt = CD.ShowOpen(Me.hwnd, "Select a Cheat List to load", CD.FileName, "Cheat Files (*.clf)|*.clf") 193 | If Len(mt) < 1 Then Exit Sub 194 | Open mt For Binary As #1 195 | Get #1, , tmp 196 | ReDim cheats(tmp) 197 | Get #1, , cheats 198 | Close #1 199 | UpdateList lstAdr, cheats 200 | End Sub 201 | 202 | Private Sub cmdNew_Click() 203 | fs = True 204 | lstAdr.Clear 205 | End Sub 206 | 207 | Private Sub cmdSav_Click() 208 | Dim tmp As Long, mt As String 209 | On Error Resume Next 210 | 211 | mt = CD.ShowSave(Me.hwnd, "Select a name to save the Cheat List", CD.FileName, "Cheat Files (*.clf)|*.clf", "") 212 | If Len(mt) < 1 Then Exit Sub 213 | Open mt$ For Binary As #1 214 | tmp = UBound(cheats) 215 | Put #1, , tmp 216 | Put #1, , cheats 217 | Close #1 218 | End Sub 219 | 220 | Private Sub Form_Initialize() 221 | Call InitCommonControls 222 | End Sub 223 | 224 | Private Sub Form_Load() 225 | Call InitCommonControls 226 | cmbsiz.ListIndex = 0 227 | End Sub 228 | 229 | Private Sub UpdateList(list As ListBox, cheats() As cheat) 230 | Dim i As Long 231 | list.Clear 232 | For i = 0 To UBound(cheats) 233 | If cheats(i).Siz = 0 Then list.AddItem cheats(i).Adr & "," & cheats(i).rb & " :" & cheats(i).val(0), i Else list.AddItem cheats(i).Adr & "," & cheats(i).rb & ":" & CLng(cheats(i).val(0)) * 256 + cheats(i).val(1), i 234 | list.Selected(i) = cheats(i).Frz 235 | Next i 236 | End Sub 237 | 238 | Private Sub lstAdr_DblClick() 239 | Dim tmp As Long 240 | tmp = InputBox("Give a value") 241 | If cheats(lstAdr.ListIndex).Siz = 2 Then 242 | cheats(lstAdr.ListIndex).val(0) = tmp \ 256: cheats(lstAdr.ListIndex).val(1) = tmp And 255 243 | Else 244 | cheats(lstAdr.ListIndex).val(0) = tmp And 255 245 | End If 246 | UpdateList lstAdr, cheats 247 | End Sub 248 | 249 | Private Sub lsttm_DblClick() 250 | On Error GoTo to1 251 | ReDim Preserve cheats(UBound(cheats) + 1) 252 | res1: 253 | cheats(UBound(cheats)) = tcheats(lsttm.ListIndex) 254 | UpdateList lstAdr, cheats 255 | Exit Sub 256 | to1: 257 | ReDim Preserve cheats(0) 258 | GoTo res1 259 | End Sub 260 | Public Sub ChkCheats() 261 | Dim i As Long 262 | On Error GoTo st0 263 | If uch Then 264 | For i = 0 To UBound(cheats) 265 | If cheats(i).Siz = 1 Then 266 | wHackM cheats(i).Adr, cheats(i).rb, cheats(i).val(0) 267 | wHackM cheats(i).Adr + 1, cheats(i).rb, cheats(i).val(1) 268 | Else 269 | wHackM cheats(i).Adr, cheats(i).rb, cheats(i).val(0) 270 | End If 271 | Next i 272 | End If 273 | st0: 274 | End Sub 275 | 276 | Private Sub Rescmd_Click() 277 | Dim tch() As cheat, tch2() As cheat, i As Long, i2 As Long, i3 As Long 278 | tch = tcheats 279 | tch2 = tcheats 280 | cmdFind_Click 281 | For i = 0 To UBound(tch) 282 | For i2 = 0 To UBound(tcheats) 283 | If tch(i).Adr = tcheats(i2).Adr Then 284 | ReDim Preserve tch2(i3) 285 | tch2(i3) = tch(i) 286 | i3 = i3 + 1 287 | End If 288 | Next 289 | Next 290 | tcheats = tch2 291 | UpdateList lsttm, tcheats 292 | End Sub 293 | -------------------------------------------------------------------------------- /bnet/bnet.server/frmMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" 3 | Begin VB.Form frmMain 4 | BorderStyle = 3 'Fixed Dialog 5 | Caption = "bnet.server" 6 | ClientHeight = 3450 7 | ClientLeft = 45 8 | ClientTop = 330 9 | ClientWidth = 4680 10 | BeginProperty Font 11 | Name = "Tahoma" 12 | Size = 8.25 13 | Charset = 0 14 | Weight = 400 15 | Underline = 0 'False 16 | Italic = 0 'False 17 | Strikethrough = 0 'False 18 | EndProperty 19 | LinkTopic = "Form1" 20 | MaxButton = 0 'False 21 | MinButton = 0 'False 22 | ScaleHeight = 3450 23 | ScaleWidth = 4680 24 | StartUpPosition = 3 'Windows Default 25 | Begin VB.CommandButton Command1 26 | Caption = "Reinit Link connection" 27 | Height = 255 28 | Left = 120 29 | TabIndex = 8 30 | Top = 3120 31 | Width = 4455 32 | End 33 | Begin VB.Timer Timer2 34 | Interval = 2 35 | Left = 3000 36 | Top = 2400 37 | End 38 | Begin VB.Timer Timer1 39 | Interval = 500 40 | Left = 2040 41 | Top = 2280 42 | End 43 | Begin VB.CommandButton cmdSend 44 | Caption = "send" 45 | Default = -1 'True 46 | Height = 285 47 | Left = 3960 48 | TabIndex = 1 49 | Top = 2760 50 | Width = 615 51 | End 52 | Begin VB.TextBox txtSend 53 | Appearance = 0 'Flat 54 | Height = 285 55 | Left = 240 56 | TabIndex = 0 57 | Top = 2760 58 | Width = 3615 59 | End 60 | Begin VB.TextBox txtData 61 | Appearance = 0 'Flat 62 | BeginProperty Font 63 | Name = "Courier" 64 | Size = 9.75 65 | Charset = 161 66 | Weight = 400 67 | Underline = 0 'False 68 | Italic = 0 'False 69 | Strikethrough = 0 'False 70 | EndProperty 71 | Height = 1575 72 | Left = 240 73 | Locked = -1 'True 74 | MultiLine = -1 'True 75 | ScrollBars = 2 'Vertical 76 | TabIndex = 2 77 | Top = 840 78 | Width = 4335 79 | End 80 | Begin MSWinsockLib.Winsock Winsock 81 | Left = 2640 82 | Tag = "CLOSED" 83 | Top = 2040 84 | _ExtentX = 741 85 | _ExtentY = 741 86 | _Version = 393216 87 | LocalPort = 8179 88 | End 89 | Begin VB.Label lblSend 90 | AutoSize = -1 'True 91 | BackStyle = 0 'Transparent 92 | Caption = "Send Data" 93 | Height = 195 94 | Left = 120 95 | TabIndex = 7 96 | Top = 2520 97 | Width = 750 98 | End 99 | Begin VB.Label lblData 100 | AutoSize = -1 'True 101 | BackStyle = 0 'Transparent 102 | Caption = "Incoming Data" 103 | Height = 195 104 | Left = 120 105 | TabIndex = 6 106 | Top = 600 107 | Width = 1035 108 | End 109 | Begin VB.Label lblStatus 110 | BackStyle = 0 'Transparent 111 | Caption = "Status: status here..." 112 | Height = 255 113 | Left = 15 114 | TabIndex = 5 115 | Top = 255 116 | Width = 4695 117 | End 118 | Begin VB.Line Line3 119 | X1 = 0 120 | X2 = 4680 121 | Y1 = 480 122 | Y2 = 480 123 | End 124 | Begin VB.Label lblIP 125 | Alignment = 1 'Right Justify 126 | AutoSize = -1 'True 127 | BackStyle = 0 'Transparent 128 | Height = 195 129 | Left = 4650 130 | TabIndex = 4 131 | Top = 0 132 | Width = 45 133 | End 134 | Begin VB.Label lblServer 135 | AutoSize = -1 'True 136 | BackStyle = 0 'Transparent 137 | Caption = "Server" 138 | BeginProperty Font 139 | Name = "Tahoma" 140 | Size = 8.25 141 | Charset = 0 142 | Weight = 700 143 | Underline = 0 'False 144 | Italic = 0 'False 145 | Strikethrough = 0 'False 146 | EndProperty 147 | Height = 195 148 | Left = 0 149 | TabIndex = 3 150 | Top = 0 151 | Width = 570 152 | End 153 | Begin VB.Line Line1 154 | X1 = 0 155 | X2 = 4680 156 | Y1 = 240 157 | Y2 = 240 158 | End 159 | End 160 | Attribute VB_Name = "frmMain" 161 | Attribute VB_GlobalNameSpace = False 162 | Attribute VB_Creatable = False 163 | Attribute VB_PredeclaredId = True 164 | Attribute VB_Exposed = False 165 | Option Explicit 166 | '********************************** 167 | '* CODE BY: PATRICK MOORE (ZELDA) * 168 | '* Feel free to re-distribute or * 169 | '* Use in your own projects. * 170 | '* Giving credit to me would be * 171 | '* nice :) -Patrick * 172 | '********************************** 173 | ' 174 | 'PS: Please look for more submissions to PSC by me 175 | ' shortly. I've recently been working on a lot 176 | ' :)) All my submissions are under author name 177 | ' "Patrick Moore" 178 | ' Vote for me..I'll be happy :DD 179 | ' 180 | 'Code edited by drk||Raziel 181 | 182 | Sub SendData(data As String) 183 | 'Check to see if we're connected to a client 184 | If Winsock.Tag = "CONNECTED" Then 185 | 'Send the data 186 | Winsock.SendData data & vbCrLf 187 | 188 | 'Send the outgoing data to the textbox as well 189 | txtData = txtData & "SERVER> " & data & vbCrLf 190 | End If 191 | End Sub 192 | Public Sub SendData2(data As String) 193 | 'Check to see if we're connected to the server 194 | If Winsock.Tag = "CONNECTED" Then 195 | 'Send the data 196 | Winsock.SendData data & vbCrLf 197 | End If 198 | End Sub 199 | 200 | Sub Status(data As String) 201 | 'Update the status label 202 | lblStatus.Caption = "Status: " & data 203 | End Sub 204 | 205 | Private Sub cmdSend_Click() 206 | 'Send the data to the client if it 207 | 'is not blank 208 | If txtSend.Text <> "" Then 209 | SendData txtSend.Text 210 | txtSend.Text = "" 211 | End If 212 | End Sub 213 | 214 | Private Sub Command1_Click() 215 | Me.Caption = "bnet.server" 216 | bbAC.link_kill 217 | bbAC.Con 218 | End Sub 219 | 220 | Private Sub Form_Load() 221 | bbAC.link_kill 222 | bbAC.Con 223 | 'Set the caption with your IP 224 | lblIP.Caption = "your ip: " & Winsock.LocalIP 225 | 226 | 'Listen for incoming connection requests 227 | Winsock.Listen 228 | Status "Awaiting connection.." 229 | End Sub 230 | 231 | Private Sub Timer1_Timer() 232 | bbAC.check_link_connection 233 | End Sub 234 | 235 | Private Sub Timer2_Timer() 236 | Check 237 | End Sub 238 | 239 | Private Sub txtData_Change() 240 | 'Set the cursor to the last character of the textbox 241 | txtData.SelStart = Len(txtData.Text) 242 | End Sub 243 | 244 | Private Sub Winsock_Close() 245 | 'Client closed connection, close the Winsock on this side 246 | Winsock.Close 247 | Winsock.Tag = "CLOSED" 248 | 249 | 'Update status 250 | Status "Connection closed, awaiting new connection.." 251 | 252 | 'Re-listen for incoming connection requests 253 | Winsock.Listen 254 | End Sub 255 | 256 | Private Sub Winsock_ConnectionRequest(ByVal requestID As Long) 257 | 'Update status 258 | Status "Accepting connection request" 259 | 260 | 'Close winsock 261 | Winsock.Close 262 | 263 | 'Accept the connection request 264 | Winsock.Accept requestID 265 | Winsock.Tag = "CONNECTED" 266 | 267 | 'Update status 268 | Status "Connected" 269 | End Sub 270 | 271 | Private Sub Winsock_DataArrival(ByVal bytesTotal As Long) 272 | Dim Buffer As String, bbb(1) As Byte 273 | 'Update status 274 | Status "Data has arrived" 275 | 276 | 277 | 'Get the data being sent by the client 278 | Winsock.GetData Buffer 279 | If Asc(Buffer) = 9 Then 280 | bbb(0) = 1 281 | bbb(1) = Asc(Mid$(Buffer, 2)) 282 | Send bbb 283 | Else 284 | 'Put incoming data into the Data textbox 285 | txtData = txtData & "CLIENT> " & Buffer 286 | End If 287 | 'Instead of using this as a chat program, you could use it 288 | 'as a remote network tool, etc. 289 | 290 | Buffer = UCase(Buffer) 291 | Buffer = Left(Buffer, Len(Buffer) - 2) 292 | 293 | 294 | 'Update the status back to "Connected" 295 | Status "Connected" 296 | End Sub 297 | -------------------------------------------------------------------------------- /BasicBoy/z80cmd.BAS: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modZ80cmd" 2 | 'This is a part of the BasicBoy emulator 3 | 'You are not allowed to release modified(or unmodified) versions 4 | 'without asking me (Raziel). 5 | 'For Suggestions ect please e-mail at :stef_mp@yahoo.gr 6 | 'To download the latest version/source goto basicboy.emuhost.com 7 | '(I know the emulator is NOT OPTIMIZED AT ALL) 8 | 9 | 10 | 'v1.2.0 11 | 'This module contains the emulation of some z80 instructions 12 | 'Comments added 13 | 'Fixed some bugs 14 | 'Optimized a bit (for v2.0.0) 15 | 'Fixed some bugs from the optimization (2.0.2) 16 | 17 | 'Sory for my bad english ... 18 | 19 | Option Explicit 20 | Dim temp_var As Long, temp_var2 As Long 'temporary vars 21 | Public Sub rl(ByRef reg8 As Long) 'Rotate left thru carry 22 | temp_var = reg8 \ 128 23 | reg8 = ((reg8 * 2) Or cf) And 255 24 | setZ reg8 = 0 25 | cf = temp_var 26 | hf = 0 27 | nf = 0 28 | End Sub 29 | Public Sub rla() 'Rotate left thru carry register a 30 | temp_var = A \ 128 31 | A = ((A * 2) Or cf) And 255 32 | setZ A = 0 33 | cf = temp_var 34 | hf = 0 35 | nf = 0 36 | End Sub 37 | 38 | Public Sub rlc(ByRef reg8 As Long) 'rotate left 39 | cf = reg8 \ 128 40 | reg8 = (reg8 * 2) And 255 Or cf 41 | setZ reg8 = 0 42 | hf = 0 43 | nf = 0 44 | End Sub 45 | 46 | Public Sub rlca() 'rotate left register A 47 | cf = A \ 128 48 | A = (A * 2) And 255 Or cf 49 | setZ A = 0 50 | hf = 0 51 | nf = 0 52 | End Sub 53 | 54 | Public Sub rr(ByRef reg8 As Long) 'Rotate right thru carry 55 | temp_var = reg8 And 1 56 | reg8 = (reg8 \ 2) Or (128 * cf) 57 | setZ reg8 = 0 58 | cf = temp_var 59 | hf = 0 60 | nf = 0 61 | End Sub 62 | 63 | Public Sub rra() 'Rotate right thru carry Register A 64 | temp_var = A And 1 65 | A = (A \ 2) Or (128 * cf) 66 | setZ A = 0 67 | cf = temp_var 68 | hf = 0 69 | nf = 0 70 | End Sub 71 | 72 | Public Sub rrc(ByRef reg8 As Long) 'Rotate right 73 | cf = reg8 And 1 74 | reg8 = (reg8 \ 2) Or (128 * cf) 75 | setZ reg8 = 0 76 | hf = 0 77 | nf = 0 78 | End Sub 79 | Public Sub rrca() 'Rotate right register A 80 | cf = A And 1 81 | A = (A \ 2) Or (128 * cf) 82 | setZ A = 0 83 | hf = 0 84 | nf = 0 85 | End Sub 86 | Public Sub sla(ByRef reg8 As Long) 'Shift Left 87 | cf = reg8 \ 128 88 | reg8 = (reg8 * 2) And 255 89 | setZ reg8 = 0 90 | hf = 0 91 | nf = 0 92 | End Sub 93 | Public Sub sra(ByRef reg8 As Long) 'Shift Right arithmetic 94 | cf = reg8 And 1 95 | reg8 = (reg8 \ 2) Or (reg8 And 128) 96 | setZ reg8 = 0 97 | hf = 0 98 | nf = 0 99 | End Sub 100 | Public Sub srl(ByRef reg8 As Long) 'Shift Right logical 101 | cf = reg8 And 1 102 | reg8 = reg8 \ 2 103 | setZ reg8 = 0 104 | hf = 0 105 | nf = 0 106 | End Sub 107 | Public Sub zsub(ByRef reg8 As Long) 'Substract from a 108 | temp_var = A - reg8 109 | temp_var2 = temp_var And 255 110 | setZ temp_var2 = 0 111 | setC A < temp_var2 112 | setH (A And 15) < (temp_var2 And 15) 113 | nf = 1 114 | A = temp_var2 115 | End Sub 116 | Public Sub sbc(ByRef reg8 As Long) 'Substract from a - carry 117 | temp_var = (A - reg8 - cf) And 255 118 | setZ temp_var = 0 119 | setC A < temp_var 120 | setH (A And &HF&) < (temp_var And 15) 121 | nf = 1 122 | A = temp_var 123 | End Sub 124 | Public Sub add(ByRef reg8 As Long) 'add to a 125 | temp_var = (A + reg8) And 255 126 | setZ temp_var = 0 127 | cf = (A + reg8) \ 256 128 | hf = ((A And 15) + (reg8 And 15)) \ 16 129 | nf = 0 130 | A = temp_var 131 | End Sub 132 | Public Sub adc(ByRef reg8 As Long) 'add to a + carry 133 | temp_var = (A + reg8 + cf) And 255 134 | setZ temp_var = 0 135 | cf = (A + reg8 + cf) \ 256 136 | hf = ((A And 15) + (reg8 And 15) + cf) \ 16 137 | nf = 0 138 | A = temp_var 139 | End Sub 140 | Sub push(ByRef reg8 As Long) 'Push to the stack 141 | SP = SP - 1 142 | WriteM SP, reg8 143 | End Sub 144 | 145 | Sub pop(ByRef reg8 As Long) 'pop from the stack 146 | reg8 = readM(SP) 147 | SP = SP + 1 148 | End Sub 149 | 150 | Sub zand(ByRef val As Long) 'Logocal and 151 | A = A And val 152 | setZ A = 0 153 | nf = 0 154 | cf = 0 155 | hf = 1 156 | End Sub 157 | Sub zor(ByRef val As Long) 'Logocal or 158 | A = A Or val 159 | setZ A = 0 160 | nf = 0 161 | hf = 0 162 | cf = 0 163 | End Sub 164 | Sub zxor(ByRef val As Long) 'Logocal xor 165 | A = A Xor val 166 | setZ A = 0 167 | nf = 0 168 | hf = 0 169 | cf = 0 170 | End Sub 171 | Sub cp(ByRef val As Long) 'Compare with A 172 | setC A < val 173 | setH (A And 15) < (val And 15) 174 | setZ A = val 175 | nf = 1 176 | End Sub 177 | Sub dec(ByRef reg8 As Long) 'decrease 178 | temp_var = reg8 179 | reg8 = reg8 - 1 180 | reg8 = reg8 And 255 181 | setH (reg8 And 15) < (temp_var And 15) 182 | setZ reg8 = 0 183 | nf = 1 184 | End Sub 185 | Sub dec16(ByRef reg81 As Long, ByRef reg82 As Long) 'same but for 16bit 186 | reg82 = reg82 - 1 187 | reg81 = reg81 + (reg82 < 0) 188 | reg81 = reg81 And 255 189 | reg82 = reg82 And 255 190 | End Sub 191 | Sub inc(ByRef reg8 As Long) 'increase 192 | reg8 = reg8 + 1 193 | reg8 = reg8 And 255 194 | setH ((reg8 And 15) = 0) 195 | setZ reg8 = 0 196 | nf = 0 197 | End Sub 198 | Sub inc16(ByRef reg81 As Long, ByRef reg82 As Long) 'same but for 16bit 199 | reg82 = reg82 + 1 200 | reg81 = reg81 + (reg82 \ 256) 201 | reg81 = reg81 And 255: reg82 = reg82 And 255 202 | End Sub 203 | Sub addHL(ByRef r1h As Long, ByRef r1l As Long) 'add to hl 204 | setC ((H * 256 Or L) + (r1h * 256 Or r1l)) > 65535 205 | setH (((H * 256 Or L) And 4095) + ((r1h * 256 Or r1l) And 4095)) > 4095 206 | L = L + r1l 207 | H = H + r1h 208 | If L > 255 Then H = H + 1 209 | L = L And 255: H = H And 255 210 | nf = 0 211 | End Sub 212 | Sub addSP(ByVal value As Long) 'add to sp(StackPointer) 213 | If value > 127 Then value = value - 256 214 | temp_var = SP + value 215 | temp_var = temp_var And 65535 216 | If value > 0 Then 217 | setC SP > temp_var 218 | setH ((SP Xor value Xor temp_var) And 4096) > 0 219 | SP = temp_var 220 | Else 221 | setC SP < temp_var 222 | setH ((SP Xor value Xor temp_var) And 4096) > 0 223 | SP = temp_var 224 | End If 225 | zf = 0 226 | nf = 0 227 | End Sub 228 | Sub swap(ByRef reg8 As Long) 'Swap nibles 229 | reg8 = (reg8 \ 16) Or ((reg8 And 15) * 16) 230 | setZ reg8 = 0 231 | nf = 0 232 | hf = 0 233 | cf = 0 234 | End Sub 235 | Sub daa() 'Demical adjust register A 236 | If hf Then 237 | If ((A And 15) >= 10 Or hf) Then A = A - 6 238 | If ((A And 240) >= 160 Or cf) Then A = A - 96: cf = 1 239 | Else 240 | If ((A And 15) >= 10 Or hf) Then A = A + 6 241 | If ((A And 240) >= 160 Or cf) Then A = A + 96: cf = 1 242 | End If 243 | A = A And 255 244 | setZ A = 0 245 | hf = 0 246 | End Sub 247 | Sub cpl() 'logical not 248 | A = 255 - A 249 | hf = 1 250 | nf = 1 251 | End Sub 252 | Sub halt() 'wait interupt 253 | If IME = False Then Exit Sub 254 | temp_var = RAM(65535, 0) And RAM(65295, 0) ' AND IE, IF 255 | If temp_var = 0 Then PC = PC - 1: Exit Sub 'If no Interrupt occured exit 256 | 'Process Interrput 257 | 'Push pc 258 | SP = SP - 1 259 | WriteM SP, PC \ 256 260 | SP = SP - 1 261 | WriteM SP, PC And 255 262 | IME = False 263 | If (temp_var And 1) = 1 Then 'V-Blank ? 264 | PC = 64 265 | RAM(65295, 0) = RAM(65295, 0) And 254 266 | ElseIf (temp_var And 2) = 2 Then 'LCDC ? 267 | PC = 72 268 | RAM(65295, 0) = RAM(65295, 0) And 253 269 | ElseIf (temp_var And 4) = 4 Then 'Timer ? 270 | PC = 80 271 | RAM(65295, 0) = RAM(65295, 0) And 251 272 | ElseIf (temp_var And 8) = 8 Then 'Serial ? 273 | PC = 88 274 | RAM(65295, 0) = RAM(65295, 0) And 247 275 | ElseIf (temp_var And 16) = 16 Then 'Joypad ? 276 | PC = 96 277 | RAM(65295, 0) = RAM(65295, 0) And 239 278 | End If 279 | End Sub 280 | Sub bit(ByRef reg8 As Long, b As Long) 'test bit 281 | setZ ((reg8 And b) = 0) 282 | nf = 0 283 | hf = 1 284 | End Sub 285 | Sub zset(ByRef reg8 As Long, b As Long) ' set bit 286 | reg8 = reg8 Or b 287 | End Sub 288 | Sub res(ByRef reg8 As Long, b As Long) 'reset bit 289 | reg8 = reg8 And b 290 | End Sub 291 | Sub jp(Adr As Long, Optional cc As Byte = 1) 'jump to 292 | If cc Then PC = Adr 293 | End Sub 294 | Sub jr(ByVal val As Long, Optional cc As Byte = 1) 'jump local to 295 | If val > 127 Then val = val - 256 296 | If cc Then PC = PC + val 297 | End Sub 298 | Sub zcall(Adr As Long, Optional cc As Byte = 1) 'call subroutine 299 | If cc Then 300 | SP = SP - 1 301 | WriteM SP, PC \ 256 302 | SP = SP - 1 303 | WriteM SP, PC And 255 304 | PC = Adr 305 | End If 306 | End Sub 307 | Sub rst(value As Long) 'restart at 308 | SP = SP - 1 309 | WriteM SP, PC \ 256 310 | SP = SP - 1 311 | WriteM SP, PC And 255 312 | PC = value 313 | End Sub 314 | Sub ret(Optional cc As Byte = 1) 'return from subroutine 315 | If cc Then PC = readM(SP) Or readM(SP + 1) * 256: SP = SP + 2 316 | End Sub 317 | Sub reti() 'return from subroutine ,enable interups 318 | PC = readM(SP) Or readM(SP + 1) * 256 319 | SP = SP + 2 320 | IME = True 321 | End Sub 322 | 323 | -------------------------------------------------------------------------------- /bnet/bnet.client/frmClient.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" 3 | Begin VB.Form frmMain 4 | BorderStyle = 3 'Fixed Dialog 5 | Caption = "bnet.client" 6 | ClientHeight = 3465 7 | ClientLeft = 45 8 | ClientTop = 330 9 | ClientWidth = 4680 10 | BeginProperty Font 11 | Name = "Tahoma" 12 | Size = 8.25 13 | Charset = 0 14 | Weight = 400 15 | Underline = 0 'False 16 | Italic = 0 'False 17 | Strikethrough = 0 'False 18 | EndProperty 19 | LinkTopic = "Form1" 20 | MaxButton = 0 'False 21 | MinButton = 0 'False 22 | ScaleHeight = 3465 23 | ScaleWidth = 4680 24 | StartUpPosition = 3 'Windows Default 25 | Begin VB.CommandButton Command1 26 | Caption = "Reinit Link connection" 27 | Height = 255 28 | Left = 120 29 | TabIndex = 8 30 | Top = 3120 31 | Width = 4455 32 | End 33 | Begin VB.Timer Timer2 34 | Interval = 2 35 | Left = 2640 36 | Top = 2400 37 | End 38 | Begin VB.Timer Timer1 39 | Interval = 500 40 | Left = 1680 41 | Top = 2400 42 | End 43 | Begin VB.CommandButton cmdConnect 44 | Caption = "Connect" 45 | Height = 255 46 | Left = 3585 47 | TabIndex = 7 48 | Top = 0 49 | Width = 1095 50 | End 51 | Begin VB.CommandButton cmdSend 52 | Caption = "send" 53 | Default = -1 'True 54 | Height = 285 55 | Left = 3960 56 | TabIndex = 1 57 | Top = 2760 58 | Width = 615 59 | End 60 | Begin VB.TextBox txtSend 61 | Appearance = 0 'Flat 62 | Height = 285 63 | Left = 240 64 | TabIndex = 0 65 | Top = 2760 66 | Width = 3615 67 | End 68 | Begin VB.TextBox txtData 69 | Appearance = 0 'Flat 70 | BeginProperty Font 71 | Name = "Courier" 72 | Size = 9.75 73 | Charset = 161 74 | Weight = 400 75 | Underline = 0 'False 76 | Italic = 0 'False 77 | Strikethrough = 0 'False 78 | EndProperty 79 | Height = 1575 80 | Left = 240 81 | Locked = -1 'True 82 | MultiLine = -1 'True 83 | ScrollBars = 2 'Vertical 84 | TabIndex = 2 85 | Top = 840 86 | Width = 4335 87 | End 88 | Begin MSWinsockLib.Winsock Winsock 89 | Left = 2040 90 | Tag = "CLOSED" 91 | Top = 1440 92 | _ExtentX = 741 93 | _ExtentY = 741 94 | _Version = 393216 95 | RemotePort = 8174 96 | End 97 | Begin VB.Label lblSend 98 | AutoSize = -1 'True 99 | BackStyle = 0 'Transparent 100 | Caption = "Send Data" 101 | Height = 195 102 | Left = 120 103 | TabIndex = 6 104 | Top = 2520 105 | Width = 750 106 | End 107 | Begin VB.Label lblData 108 | AutoSize = -1 'True 109 | BackStyle = 0 'Transparent 110 | Caption = "Incoming Data" 111 | Height = 195 112 | Left = 120 113 | TabIndex = 5 114 | Top = 600 115 | Width = 1035 116 | End 117 | Begin VB.Label lblStatus 118 | BackStyle = 0 'Transparent 119 | Caption = "Status: status here..." 120 | Height = 255 121 | Left = 15 122 | TabIndex = 4 123 | Top = 255 124 | Width = 4695 125 | End 126 | Begin VB.Line Line3 127 | X1 = 0 128 | X2 = 4680 129 | Y1 = 480 130 | Y2 = 480 131 | End 132 | Begin VB.Label lblClient 133 | AutoSize = -1 'True 134 | BackStyle = 0 'Transparent 135 | Caption = "Client" 136 | BeginProperty Font 137 | Name = "Tahoma" 138 | Size = 8.25 139 | Charset = 0 140 | Weight = 700 141 | Underline = 0 'False 142 | Italic = 0 'False 143 | Strikethrough = 0 'False 144 | EndProperty 145 | Height = 195 146 | Left = 0 147 | TabIndex = 3 148 | Top = 0 149 | Width = 480 150 | End 151 | Begin VB.Line Line1 152 | X1 = 0 153 | X2 = 4680 154 | Y1 = 240 155 | Y2 = 240 156 | End 157 | End 158 | Attribute VB_Name = "frmMain" 159 | Attribute VB_GlobalNameSpace = False 160 | Attribute VB_Creatable = False 161 | Attribute VB_PredeclaredId = True 162 | Attribute VB_Exposed = False 163 | Option Explicit 164 | '********************************** 165 | '* CODE BY: PATRICK MOORE (ZELDA) * 166 | '* Feel free to re-distribute or * 167 | '* Use in your own projects. * 168 | '* Giving credit to me would be * 169 | '* nice :) -Patrick * 170 | '********************************** 171 | ' 172 | 'PS: Please look for more submissions to PSC by me 173 | ' shortly. I've recently been working on a lot 174 | ' :)) All my submissions are under author name 175 | ' "Patrick Moore" 176 | ' 177 | 'Code edited by drk||Raziel 178 | 179 | 180 | Public Sub SendData(data As String) 181 | 'Check to see if we're connected to the server 182 | If Winsock.Tag = "CONNECTED" Then 183 | 'Send the data 184 | Winsock.SendData data & vbCrLf 185 | 186 | 'Send the data go the textbox as well 187 | txtData = txtData & "CLIENT> " & data & vbCrLf 188 | End If 189 | End Sub 190 | Public Sub SendData2(data As String) 191 | 'Check to see if we're connected to the server 192 | If Winsock.Tag = "CONNECTED" Then 193 | 'Send the data 194 | Winsock.SendData data & vbCrLf 195 | End If 196 | End Sub 197 | 198 | Sub Status(data As String) 199 | 'Update the status label 200 | lblStatus.Caption = "Status: " & data 201 | End Sub 202 | 203 | Private Sub cmdConnect_Click() 204 | Dim ip As String 205 | 206 | If cmdConnect.Caption = "Connect" Then 207 | 'If we want to connect, first ask the user for the 208 | 'server's IP 209 | ip = InputBox("Enter the server's IP:", "Enter IP") 210 | 'If they didn't cancel, connect to the server 211 | If ip <> "" Then 212 | 'Close winsock 213 | Winsock.Close 214 | 215 | 'Tell winsock what it's connecting to 216 | Winsock.RemoteHost = ip 217 | Winsock.RemotePort = 8179 'and what port to use 218 | 219 | 'Connect 220 | Winsock.Connect 221 | cmdConnect.Caption = "Disconnect" 222 | Exit Sub 223 | End If 224 | Else 225 | 'Close the winsock 226 | Winsock.Close 227 | 'Do the code that is in Winsock's Close sub 228 | Winsock_Close 229 | cmdConnect.Caption = "Connect" 230 | End If 231 | End Sub 232 | 233 | Private Sub cmdSend_Click() 234 | 'If text isn't blank, send data to the server 235 | If txtSend.Text <> "" Then 236 | SendData txtSend.Text 237 | txtSend.Text = "" 238 | End If 239 | End Sub 240 | 241 | Private Sub Command1_Click() 242 | Me.Caption = "bnet.client" 243 | bbAC.link_kill 244 | bbAC.Con 245 | End Sub 246 | 247 | Private Sub Form_Load() 248 | bbAC.link_kill 249 | bbAC.Con 250 | Status "Idle.." 251 | End Sub 252 | 253 | Private Sub Timer1_Timer() 254 | bbAC.check_link_connection 255 | End Sub 256 | 257 | Private Sub Timer2_Timer() 258 | Check 259 | End Sub 260 | 261 | Private Sub txtData_Change() 262 | 'Set the cursor to the last character of the textbox 263 | txtData.SelStart = Len(txtData.Text) 264 | End Sub 265 | 266 | Private Sub Winsock_Close() 267 | 'Server closed connection, close here as well 268 | Winsock.Close 269 | Winsock.Tag = "CLOSED" 270 | 271 | 'Update status 272 | Status "Disconnected, Idle.." 273 | End Sub 274 | 275 | Private Sub Winsock_Connect() 276 | 'We've connected to the server! 277 | Winsock.Tag = "CONNECTED" 278 | 279 | 'Update status 280 | Status "Connected" 281 | End Sub 282 | 283 | Private Sub Winsock_DataArrival(ByVal bytesTotal As Long) 284 | Dim Buffer As String, bbb(1) As Byte 285 | 'Update status 286 | Status "Data has arrived" 287 | 288 | 'Get the incoming data, which was 289 | 'sent from the server 290 | Winsock.GetData Buffer 291 | If Asc(Buffer) = 9 Then 292 | bbb(0) = 1 293 | bbb(1) = Asc(Mid$(Buffer, 2)) 294 | Send bbb 295 | Else 296 | 'Send it to the textbox 297 | txtData = txtData & "SERVER> " & Buffer 298 | End If 299 | 'Update status 300 | Status "Connected" 301 | End Sub 302 | -------------------------------------------------------------------------------- /BasicBoy/Sound.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modSoundInterface" 2 | 'This is a part of the BasicBoy emulator 3 | 'You are not allowed to release modified(or unmodified) versions 4 | 'without asking me (Raziel). 5 | 'For Suggestions ect please e-mail at :stef_mp@yahoo.gr 6 | 'To download the latest version/source goto basicboy.emuhost.com 7 | '(I know the emulator is NOT OPTIMIZED AT ALL) 8 | 9 | 'v3.0.1 10 | '(almost)Complete rewrite of the Sound interface/emulation 11 | 'Emulated Sound chanels:Ch1,Ch2,Ch3,Ch4 12 | 'Still missing stereo,flags and volume(nr5x) 13 | 'Coments will be added with the next releases 14 | 15 | 'Sory for my bad english ... 16 | Option Explicit 17 | Global swm(15) As Long 18 | Dim tmp_1 As Long, freq As Double 19 | 20 | 'Public Whan As Long 21 | Public cl1(3) As Long 22 | Public en1(3) As Byte 23 | Public cl2(3) As Long 24 | Public en2(3) As Byte 25 | Public cl3(3) As Long 26 | Public en3(3) As Byte 27 | Public cl4(3) As Long 28 | Public en4(3) As Byte 29 | Public ClCleft As Long 30 | Public buf1(31) As Byte 31 | Public buf2(31) As Byte 32 | Public buf3(31) As Byte 33 | Public buf4(31) As Byte 34 | Dim tones(4) As Double, valumes(4) As Long, VOLS(7) As Byte 35 | Dim tmp2(7) As Byte, tlol As Byte, Tsnd As Long, tmp3(31) As Byte, i As Long 36 | 'Gb=2048-(131072/Hz) 37 | 'Hz=131072/(2048-Gb) 38 | Sub update_sound(clc As Long) 'update sound 39 | If snd Then 'sound is enabled 40 | Sound_Sync_Pos = Sound_Sync_Pos + clc 41 | '****Chanel 1**** 42 | If en1(0) Then cl1(0) = cl1(0) - clc 'ok 43 | 44 | If cl1(0) < 1 And en1(0) Then 'stop 45 | send_command Chanel1, Sound_Stop, No_Par 46 | wave1p = 0 47 | en1(0) = 0 48 | End If 49 | 50 | 51 | If en1(1) Then cl1(1) = cl1(1) - clc 52 | 53 | If cl1(1) < 1 And en1(1) Then 'Volume envelop 54 | Tsnd = (RAM(65298, 0) And 240) \ 16 55 | If RAM(65298, 0) And 8 Then 56 | Tsnd = Tsnd + 1 57 | If Tsnd > 15 Then en1(1) = 0: Tsnd = 15 58 | Else 59 | Tsnd = Tsnd - 1 60 | If Tsnd < 0 Then en1(1) = 0: Tsnd = 0 61 | End If 62 | RAM(65298, 0) = (RAM(65298, 0) And 15) + Tsnd * 16 63 | send_command Chanel1, Wave_Volume_Set, (RAM(65298, 0) And 224) \ 16 64 | cl1(1) = (en1(1) / 64) * 4194304 65 | End If 66 | 67 | 68 | 69 | If en1(2) Then cl1(2) = cl1(2) - clc 70 | 71 | If cl1(2) < 1 And en1(2) Then 'Sweep envelop 72 | Tsnd = (RAM(65300, 0) And 7) * 256 + RAM(65299, 0) 73 | If RAM(65296, 0) And 8 Then 74 | Tsnd = Tsnd - Tsnd / 2 ^ (RAM(65296, 0) And 7) 75 | Else 76 | Tsnd = Tsnd + Tsnd / 2 ^ (RAM(65296, 0) And 7) 77 | End If 78 | RAM(65300, 0) = (RAM(65300, 0) And 248) Or (Tsnd \ 256) 79 | RAM(65299, 0) = Tsnd And 255 80 | send_command Chanel1, Wave_Frequency_Set, Tsnd 81 | cl1(2) = ((en1(2) \ 16) / 128) * 4194304 82 | End If 83 | 84 | 85 | 86 | '****Channel 2**** 87 | If en2(0) Then cl2(0) = cl2(0) - clc 88 | 89 | If cl2(0) < 1 And en2(0) Then 'stop 90 | send_command Chanel2, Sound_Stop, No_Par 91 | wave2p = 0 92 | en2(0) = 0 93 | End If 94 | 95 | 96 | If en2(1) Then cl2(1) = cl2(1) - clc 97 | 98 | If cl2(1) < 1 And en2(1) Then 'Volume envelop 99 | Tsnd = (RAM(65303, 0) And 240) \ 16 100 | If RAM(65303, 0) And 8 Then 101 | Tsnd = Tsnd + 1 102 | If Tsnd > 15 Then Tsnd = 15 103 | Else 104 | Tsnd = Tsnd - 1 105 | If Tsnd < 0 Then Tsnd = 0 106 | End If 107 | RAM(65303, 0) = (RAM(65303, 0) And 15) + Tsnd * 16 108 | send_command Chanel2, Wave_Volume_Set, (RAM(65303, 0) And 224) \ 16 109 | cl2(1) = (en2(1) / 64) * 4194304 110 | End If 111 | 112 | '****Channel 3**** 113 | If en3(0) Then cl3(0) = cl3(0) - clc 114 | 115 | If cl3(0) < 1 And en3(0) Then 'stop 116 | send_command Chanel3, Sound_Stop, No_Par 117 | wave3p = 0 118 | en3(0) = 0 119 | End If 120 | End If 121 | 122 | '****Chanel 4**** 123 | If en4(0) Then cl4(0) = cl4(0) - clc 124 | 125 | If cl4(0) < 1 And en4(0) Then 'stop 126 | send_command Chanel4, Sound_Stop, No_Par 127 | wave4p = 0 128 | en4(0) = 0 129 | End If 130 | 131 | 132 | If en4(1) Then cl4(1) = cl4(1) - clc 133 | 134 | If cl4(1) < 1 And en4(1) Then 'Volume envelop 135 | Tsnd = (RAM(65313, 0) And 240) \ 16 136 | If RAM(65313, 0) And 8 Then 137 | Tsnd = Tsnd + 1 138 | If Tsnd > 15 Then Tsnd = 15 139 | Else 140 | Tsnd = Tsnd - 1 141 | If Tsnd < 0 Then Tsnd = 0 142 | End If 143 | RAM(65313, 0) = (RAM(65313, 0) And 15) + Tsnd * 16 144 | send_command Chanel4, Wave_Volume_Set, (RAM(65313, 0) And 240) \ 16 145 | cl4(1) = (en4(1) / 64) * 4194304 146 | End If 147 | 148 | End Sub 149 | 'Register Writes 150 | Sub setNR10(val As Long) 'Frequency Sweep,time,mode,sweep shift 151 | en1(2) = val And 112 152 | If en1(2) Then 153 | cl1(2) = ((en1(2) \ 16) / 128) * 4194304 154 | End If 155 | End Sub 156 | Sub setNR11(val As Long) 'wpd,len 157 | send_command Chanel1, Wave_Pattern_Duty_Set, val \ 64 'bits 7-6 158 | cl1(0) = (64 - (val And 63)) / 256 159 | en1(0) = RAM(65300, 0) And 64 160 | End Sub 161 | Sub setNR12(val As Long) 'evelope reg 162 | en1(1) = val And 7 163 | cl1(1) = en1(1) * (1 / 64) * 4194304 164 | send_command Chanel1, Wave_Volume_Set, (RAM(65298, 0) And 224) \ 16 165 | End Sub 166 | Sub setNR13(val As Long) 'freq 8 low bits 167 | send_command Chanel1, Wave_Frequency_Set, (RAM(65300, 0) And 7) * 256 + RAM(65299, 0) 168 | End Sub 169 | Sub setNR14(val As Long) 'freq 3 hi bits, intial,counter 170 | 'if intial is set then play and set freq 171 | send_command Chanel1, Wave_Frequency_Set, (RAM(65300, 0) And 7) * 256 + RAM(65299, 0) 172 | If val And 128 Then send_command Chanel1, sound_play, No_Par: wave1p = 1 173 | 174 | en1(0) = val And 64 175 | cl1(0) = (64 - (RAM(65297, 0) And 63)) / 256 * 4194304 176 | End Sub 177 | 178 | Sub setNR21(val As Long) 179 | send_command Chanel2, Wave_Pattern_Duty_Set, val \ 64 'bits 7-6 180 | cl2(0) = (64 - (val And 63)) / 256 181 | en2(0) = RAM(65305, 0) And 64 182 | End Sub 183 | Sub setNR22(val As Long) 'evelope reg 184 | en2(1) = val And 7 185 | cl2(1) = en2(1) * (1 / 64) * 4194304 186 | send_command Chanel2, Wave_Volume_Set, (RAM(65303, 0) And 224) \ 16 187 | End Sub 188 | Sub setNR23(val As Long) 'freq 8 bit low 189 | send_command Chanel2, Wave_Frequency_Set, (RAM(65305, 0) And 7) * 256 + RAM(65304, 0) 190 | End Sub 191 | Sub setNR24(val As Long) 192 | send_command Chanel2, Wave_Frequency_Set, (RAM(65305, 0) And 7) * 256 + RAM(65304, 0) 193 | If val And 128 Then send_command Chanel2, sound_play, No_Par: wave2p = 1 194 | en2(0) = val And 64 195 | cl2(0) = (64 - (RAM(65302, 0) And 63)) / 256 * 4194304 196 | End Sub 197 | 198 | Sub setNR30(val As Long) 199 | If val And 128 Then 200 | send_command Chanel3, sound_play, No_Par 201 | wave3p = 1 202 | Else 203 | send_command Chanel3, Sound_Stop, No_Par 204 | wave3p = 0 205 | End If 206 | End Sub 207 | Sub setNR31(val As Long) 'len 0 - 255 208 | 209 | End Sub 210 | Sub setNR32(ByVal val As Long) 211 | val = (val And 96) \ 32 212 | If val = 1 Then val = 256 '1 213 | If val = 2 Then val = 128 '1/2 214 | If val = 3 Then val = 64 '1/4 215 | send_command Chanel3, Wave_Pattern_Volume_Set, val 216 | End Sub 217 | Sub setNR33(val As Long) 218 | send_command Chanel3, Wave_Frequency_Set, (RAM(65310, 0) And 7) * 256 + RAM(65309, 0) 219 | End Sub 220 | Sub setNR34(val As Long) 221 | send_command Chanel3, Wave_Frequency_Set, (RAM(65310, 0) And 7) * 256 + RAM(65309, 0) 222 | If val And 128 Then 223 | send_command Chanel3, sound_play, No_Par 224 | wave3p = 1 225 | End If 226 | en3(0) = val And 64 227 | cl3(0) = (256 - (RAM(65307, 0))) / 256 * 4194304 228 | End Sub 229 | Sub setNR41(val As Long) 'sound len : 5-0 230 | cl4(0) = (64 - (val And 63)) / 256 * 4194304 231 | End Sub 232 | Sub setNR42(val As Long) 'Evelope : 7-4 = envelope,3= envelope up/dn,2-0 = env. sweep 233 | en4(1) = -((val And 7) > 0) 234 | cl4(1) = (1 / 64) * 4194304 * (val And 7) 235 | send_command Chanel4, Wave_Volume_Set, (val And 240) \ 16 236 | End Sub 237 | Sub setNR43(val As Long) 'freq 238 | 'Bit 7-4(m) - Selection of the shift clock 239 | 'Bit 3 - Selection of the polynomial bits 240 | 'Bit 2-0(n) - Selection of the dividing ratio 241 | 'if n=0 then n=0.5 242 | freq = val '4194304 * 1 / 2 ^ 3 * 1 / (val And 7) * 1 / (2 ^ ((val \ 16) + 1)) 243 | send_command Chanel4, Wave_Frequency_Set, CLng(freq) 244 | send_command Chanel4, 2, (val \ 8) And 1 245 | End Sub 246 | Sub setNR44(val As Long) 'intial/counter : 7 = intial , 6 = counter 247 | 'if intial is set then play and set freq 248 | If val And 128 Then send_command Chanel4, sound_play, No_Par: _ 249 | send_command Chanel4, Wave_Frequency_Set, CLng(freq): wave4p = 1 250 | en4(0) = (val And 64) \ 64 251 | cl4(0) = (64 - (RAM(65312, 0) And 63)) / 256 * 4194304 252 | en4(1) = -((RAM(65313, 0) And 7) > 0) 253 | cl4(1) = (1 / 64) * 4194304 * (RAM(65313, 0) And 7) 254 | send_command Chanel4, Wave_Volume_Set, (RAM(65313, 0) And 240) \ 16 255 | End Sub 256 | 257 | 258 | Sub setNR50(val As Long) 259 | 260 | End Sub 261 | Sub setNR51(val As Long) 262 | 263 | End Sub 264 | Sub setNR52(val As Long) 265 | gb_snd = val \ 128 266 | RAM(65318, 0) = gb_snd * 128 + _ 267 | wave4p * 8 + _ 268 | wave3p * 4 + _ 269 | wave2p * 2 + _ 270 | wave1p * 1 271 | End Sub 272 | 273 | Sub initWave() 'init square and noise waves patterns 274 | Dim i As Long 275 | 276 | 'noise 7 bits 277 | Randomize 10 278 | For i = 0 To 127 279 | noise7(i) = ((255 * Rnd) - 127) 280 | Next i 281 | 282 | 'noise 15 bits 283 | Randomize 11 284 | For i = 0 To 32767 285 | noise15(i) = ((255 * Rnd) - 127) 286 | Next i 287 | 288 | 'I have some new info on this.. now waveforms are correct 289 | '8*0.125%=1 : 00 : 12.5% ____=___ 290 | sqrW(0, 0) = -127: sqrW(1, 0) = -127: sqrW(2, 0) = -127: sqrW(3, 0) = -127: sqrW(4, 0) = 128: sqrW(5, 0) = -127: sqrW(6, 0) = -127: sqrW(7, 0) = -127 291 | '8*0.25=2 : 01 : 25% ____==__ 292 | sqrW(0, 1) = -127: sqrW(1, 1) = -127: sqrW(2, 1) = -127: sqrW(3, 1) = -127: sqrW(4, 1) = 128: sqrW(5, 1) = 128: sqrW(6, 1) = -127: sqrW(7, 1) = -127 293 | '8*0.50=4 : 10 : 50% __====__ 294 | sqrW(0, 2) = -127: sqrW(1, 2) = -127: sqrW(2, 2) = 128: sqrW(3, 2) = 128: sqrW(4, 2) = 128: sqrW(5, 2) = 128: sqrW(6, 2) = -127: sqrW(7, 2) = -127 295 | '8*0.75=6 : 11 : 75% ====__== 296 | sqrW(0, 3) = 128: sqrW(1, 3) = 128: sqrW(2, 3) = 128: sqrW(3, 3) = 128: sqrW(4, 3) = -127: sqrW(5, 3) = -127: sqrW(6, 3) = 128: sqrW(7, 3) = 128 297 | 'chanel 3 wave values 298 | For i = 0 To 15 299 | swm(i) = (i * 16) - 127 300 | Next i 301 | End Sub 302 | -------------------------------------------------------------------------------- /BasicBoy/frmDebugger.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmDebugger 3 | Caption = "Form1" 4 | ClientHeight = 6855 5 | ClientLeft = 60 6 | ClientTop = 450 7 | ClientWidth = 11040 8 | LinkTopic = "Form1" 9 | ScaleHeight = 6855 10 | ScaleWidth = 11040 11 | StartUpPosition = 3 'Windows Default 12 | Begin VB.ListBox lstCh 13 | Height = 1035 14 | Left = 120 15 | TabIndex = 33 16 | Top = 5040 17 | Width = 2415 18 | End 19 | Begin VB.ListBox lstEh 20 | Height = 2205 21 | Left = 120 22 | TabIndex = 30 23 | Top = 2400 24 | Width = 2415 25 | End 26 | Begin VB.Frame fraMisk 27 | Caption = "Misk Variables" 28 | Height = 6135 29 | Left = 8640 30 | TabIndex = 28 31 | Top = 120 32 | Width = 2175 33 | End 34 | Begin VB.Frame fraInf 35 | Caption = "GameBoy/Cart Info" 36 | Height = 4695 37 | Left = 2640 38 | TabIndex = 23 39 | Top = 1560 40 | Width = 1815 41 | Begin VB.Label lblZ80S 42 | Caption = "8 MHz" 43 | Height = 255 44 | Left = 1080 45 | TabIndex = 27 46 | Top = 480 47 | Width = 495 48 | End 49 | Begin VB.Label lblcpus 50 | Caption = "CPU speed :" 51 | Height = 255 52 | Left = 120 53 | TabIndex = 26 54 | Top = 480 55 | Width = 975 56 | End 57 | Begin VB.Label lblGBS 58 | Caption = "GBC" 59 | Height = 255 60 | Left = 840 61 | TabIndex = 25 62 | Top = 240 63 | Width = 375 64 | End 65 | Begin VB.Label lblsys 66 | Caption = "System :" 67 | Height = 255 68 | Left = 120 69 | TabIndex = 24 70 | Top = 240 71 | Width = 615 72 | End 73 | End 74 | Begin VB.Frame fraMMR 75 | Caption = "Memory Mapped Registers" 76 | Height = 6135 77 | Left = 4560 78 | TabIndex = 22 79 | Top = 120 80 | Width = 3975 81 | End 82 | Begin VB.Frame fraRegs 83 | Caption = "CPU Registers" 84 | Height = 1335 85 | Left = 2640 86 | TabIndex = 4 87 | Top = 120 88 | Width = 1815 89 | Begin VB.Label lblCarry 90 | Caption = "C" 91 | Height = 255 92 | Left = 960 93 | TabIndex = 21 94 | Top = 960 95 | Width = 135 96 | End 97 | Begin VB.Label lblHalfCarry 98 | Caption = "H" 99 | Height = 255 100 | Left = 840 101 | TabIndex = 20 102 | Top = 960 103 | Width = 135 104 | End 105 | Begin VB.Label lblPrevOp 106 | Caption = "N" 107 | Height = 255 108 | Left = 720 109 | TabIndex = 19 110 | Top = 960 111 | Width = 135 112 | End 113 | Begin VB.Label lblZero 114 | Caption = "Z" 115 | Height = 255 116 | Left = 600 117 | TabIndex = 18 118 | Top = 960 119 | Width = 135 120 | End 121 | Begin VB.Label lblFlags 122 | Caption = "Flags:" 123 | Height = 255 124 | Left = 120 125 | TabIndex = 17 126 | Top = 960 127 | Width = 495 128 | End 129 | Begin VB.Label lblde 130 | Caption = "FFFF" 131 | Height = 255 132 | Left = 480 133 | TabIndex = 16 134 | Top = 480 135 | Width = 495 136 | End 137 | Begin VB.Label lblpc 138 | Caption = "FFFF" 139 | Height = 255 140 | Left = 480 141 | TabIndex = 15 142 | Top = 720 143 | Width = 495 144 | End 145 | Begin VB.Label lblhl 146 | BackStyle = 0 'Transparent 147 | Caption = "FFFF" 148 | Height = 255 149 | Left = 1320 150 | TabIndex = 13 151 | Top = 480 152 | Width = 495 153 | End 154 | Begin VB.Label lblsp 155 | BackStyle = 0 'Transparent 156 | Caption = "FFFF" 157 | Height = 255 158 | Left = 1320 159 | TabIndex = 12 160 | Top = 720 161 | Width = 495 162 | End 163 | Begin VB.Label lblaf 164 | Caption = "FFFF" 165 | Height = 255 166 | Left = 480 167 | TabIndex = 11 168 | Top = 240 169 | Width = 495 170 | End 171 | Begin VB.Label SP 172 | Caption = "SP :" 173 | Height = 255 174 | Left = 960 175 | TabIndex = 10 176 | Top = 720 177 | Width = 375 178 | End 179 | Begin VB.Label PC 180 | Caption = "PC :" 181 | Height = 255 182 | Left = 120 183 | TabIndex = 9 184 | Top = 720 185 | Width = 375 186 | End 187 | Begin VB.Label BC 188 | Caption = "BC :" 189 | Height = 255 190 | Left = 960 191 | TabIndex = 8 192 | Top = 240 193 | Width = 375 194 | End 195 | Begin VB.Label DE 196 | Caption = "DE :" 197 | Height = 255 198 | Left = 120 199 | TabIndex = 7 200 | Top = 480 201 | Width = 375 202 | End 203 | Begin VB.Label HL 204 | Caption = "HL :" 205 | Height = 255 206 | Left = 960 207 | TabIndex = 6 208 | Top = 480 209 | Width = 375 210 | End 211 | Begin VB.Label af 212 | Caption = "AF :" 213 | Height = 255 214 | Left = 120 215 | TabIndex = 5 216 | Top = 240 217 | Width = 375 218 | End 219 | Begin VB.Label lblbc 220 | BackStyle = 0 'Transparent 221 | Caption = "FFFF" 222 | Height = 255 223 | Left = 1320 224 | TabIndex = 14 225 | Top = 240 226 | Width = 495 227 | End 228 | End 229 | Begin VB.CommandButton cmdExit 230 | Caption = "Exit" 231 | Height = 375 232 | Left = 9840 233 | TabIndex = 3 234 | Top = 6360 235 | Width = 975 236 | End 237 | Begin VB.CommandButton cmdRun 238 | Caption = "Run/Stop" 239 | Height = 375 240 | Left = 1440 241 | TabIndex = 2 242 | Top = 6360 243 | Width = 975 244 | End 245 | Begin VB.CommandButton cmdStep 246 | Caption = "Step" 247 | Height = 375 248 | Left = 360 249 | TabIndex = 1 250 | Top = 6360 251 | Width = 975 252 | End 253 | Begin VB.ListBox lstDiss 254 | Height = 1620 255 | Left = 120 256 | Sorted = -1 'True 257 | TabIndex = 0 258 | Top = 480 259 | Width = 2415 260 | End 261 | Begin VB.Label Label1 262 | Caption = "Call History" 263 | Height = 255 264 | Left = 120 265 | TabIndex = 32 266 | Top = 4680 267 | Width = 2415 268 | End 269 | Begin VB.Label lstst3 270 | Caption = "Execute History" 271 | Height = 255 272 | Left = 120 273 | TabIndex = 31 274 | Top = 2160 275 | Width = 2415 276 | End 277 | Begin VB.Label lblst2 278 | Caption = "Disassembly :" 279 | Height = 255 280 | Left = 120 281 | TabIndex = 29 282 | Top = 240 283 | Width = 2415 284 | End 285 | End 286 | Attribute VB_Name = "frmDebugger" 287 | Attribute VB_GlobalNameSpace = False 288 | Attribute VB_Creatable = False 289 | Attribute VB_PredeclaredId = True 290 | Attribute VB_Exposed = False 291 | Public w As Long, den As Long 292 | Sub execcommand() 293 | If den = 0 Then 294 | Me.lblaf = hex2(A * 256 + F) 295 | Me.lblbc = hex2(b * 256 + C) 296 | Me.lblde = hex2(D * 256 + E) 297 | Me.lblhl = hex2(H * 256 + L) 298 | Me.lblpc = hex2(z80.PC) 299 | Me.lblsp = hex2(z80.SP) 300 | Me.lblZero = IIf(getZ, "Z", "-") 301 | Me.lblPrevOp = IIf(GetN, "N", "-") 302 | Me.lblHalfCarry = IIf(getH, "H", "-") 303 | Me.lblCarry = IIf(getC, "C", "-") 304 | Do 305 | DoEvents 306 | Loop While w = 1 307 | If w = 2 Then w = 1 308 | End If 309 | End Sub 310 | 311 | Function hex2(ByVal val As Long) As String 312 | hex2 = String(4 - Len(Hex(val)), "0") & Hex(val) 313 | End Function 314 | 315 | Private Sub cmdExit_Click() 316 | den = 12 317 | Unload Me 318 | End Sub 319 | 320 | Private Sub cmdRun_Click() 321 | If w = 0 Then: w = 2: Else w = 0 322 | End Sub 323 | 324 | Private Sub cmdStep_Click() 325 | If w Then w = 2 326 | End Sub 327 | 328 | Private Sub Form_Load() 329 | den = 0 330 | End Sub 331 | 332 | Private Sub Form_Unload(Cancel As Integer) 333 | den = 12 334 | Unload Me 335 | End Sub 336 | -------------------------------------------------------------------------------- /BasicBoy/db.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmRomInfo 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "ROM Information" 5 | ClientHeight = 2160 6 | ClientLeft = 45 7 | ClientTop = 330 8 | ClientWidth = 5655 9 | BeginProperty Font 10 | Name = "Tahoma" 11 | Size = 8.25 12 | Charset = 0 13 | Weight = 400 14 | Underline = 0 'False 15 | Italic = 0 'False 16 | Strikethrough = 0 'False 17 | EndProperty 18 | Icon = "db.frx":0000 19 | LinkTopic = "Form2" 20 | MaxButton = 0 'False 21 | MinButton = 0 'False 22 | ScaleHeight = 2160 23 | ScaleWidth = 5655 24 | StartUpPosition = 3 'Windows Default 25 | Begin VB.CommandButton Command1 26 | Caption = "OK" 27 | Height = 345 28 | Left = 2280 29 | TabIndex = 22 30 | Top = 1680 31 | Width = 1095 32 | End 33 | Begin VB.Label GbColor 34 | Height = 195 35 | Left = 1680 36 | TabIndex = 21 37 | Top = 1290 38 | Width = 3855 39 | End 40 | Begin VB.Label Label5 41 | Alignment = 1 'Right Justify 42 | Caption = "ROM Size:" 43 | Height = 195 44 | Left = 120 45 | TabIndex = 10 46 | Top = 120 47 | Width = 1455 48 | End 49 | Begin VB.Label lRas 50 | Height = 390 51 | Left = 1680 52 | TabIndex = 20 53 | Top = 510 54 | Width = 3855 55 | End 56 | Begin VB.Label lRos 57 | Height = 390 58 | Left = 1680 59 | TabIndex = 19 60 | Top = 120 61 | Width = 3855 62 | End 63 | Begin VB.Label iName 64 | Height = 195 65 | Left = 1680 66 | TabIndex = 18 67 | Top = 1095 68 | Width = 3855 69 | End 70 | Begin VB.Label Cart 71 | Height = 195 72 | Left = 1680 73 | TabIndex = 17 74 | Top = 900 75 | Width = 3855 76 | End 77 | Begin VB.Label Label11 78 | Alignment = 1 'Right Justify 79 | Caption = "GameBoy Color:" 80 | Height = 195 81 | Left = 60 82 | TabIndex = 16 83 | Top = 1290 84 | Width = 1515 85 | End 86 | Begin VB.Label Label10 87 | Alignment = 1 'Right Justify 88 | Caption = "Internal Name:" 89 | Height = 195 90 | Left = 15 91 | TabIndex = 15 92 | Top = 1095 93 | Width = 1560 94 | End 95 | Begin VB.Label Label9 96 | Alignment = 1 'Right Justify 97 | Caption = "Cart Type:" 98 | Height = 195 99 | Left = 75 100 | TabIndex = 14 101 | Top = 900 102 | Width = 1500 103 | End 104 | Begin VB.Label Label8 105 | Alignment = 1 'Right Justify 106 | Caption = "RAM Banks:" 107 | Height = 195 108 | Left = 120 109 | TabIndex = 13 110 | Top = 705 111 | Width = 1455 112 | End 113 | Begin VB.Label Label7 114 | Alignment = 1 'Right Justify 115 | Caption = "ROM Banks:" 116 | Height = 195 117 | Left = 105 118 | TabIndex = 12 119 | Top = 315 120 | Width = 1470 121 | End 122 | Begin VB.Label Label6 123 | Alignment = 1 'Right Justify 124 | Caption = "RAM Size:" 125 | Height = 195 126 | Left = 15 127 | TabIndex = 11 128 | Top = 510 129 | Width = 1560 130 | End 131 | Begin VB.Label Label1 132 | Caption = "E :" 133 | BeginProperty Font 134 | Name = "MS Sans Serif" 135 | Size = 8.25 136 | Charset = 0 137 | Weight = 400 138 | Underline = 0 'False 139 | Italic = 0 'False 140 | Strikethrough = 0 'False 141 | EndProperty 142 | Height = 255 143 | Index = 7 144 | Left = 4680 145 | TabIndex = 9 146 | Top = 6840 147 | Visible = 0 'False 148 | Width = 255 149 | End 150 | Begin VB.Label Label1 151 | Caption = "F :" 152 | BeginProperty Font 153 | Name = "MS Sans Serif" 154 | Size = 8.25 155 | Charset = 0 156 | Weight = 400 157 | Underline = 0 'False 158 | Italic = 0 'False 159 | Strikethrough = 0 'False 160 | EndProperty 161 | Height = 255 162 | Index = 6 163 | Left = 4680 164 | TabIndex = 8 165 | Top = 7080 166 | Visible = 0 'False 167 | Width = 255 168 | End 169 | Begin VB.Label Label1 170 | Caption = "H :" 171 | BeginProperty Font 172 | Name = "MS Sans Serif" 173 | Size = 8.25 174 | Charset = 0 175 | Weight = 400 176 | Underline = 0 'False 177 | Italic = 0 'False 178 | Strikethrough = 0 'False 179 | EndProperty 180 | Height = 255 181 | Index = 5 182 | Left = 4680 183 | TabIndex = 7 184 | Top = 7320 185 | Visible = 0 'False 186 | Width = 255 187 | End 188 | Begin VB.Label Label1 189 | Caption = "L :" 190 | BeginProperty Font 191 | Name = "MS Sans Serif" 192 | Size = 8.25 193 | Charset = 0 194 | Weight = 400 195 | Underline = 0 'False 196 | Italic = 0 'False 197 | Strikethrough = 0 'False 198 | EndProperty 199 | Height = 255 200 | Index = 4 201 | Left = 4680 202 | TabIndex = 6 203 | Top = 7560 204 | Visible = 0 'False 205 | Width = 255 206 | End 207 | Begin VB.Label Label1 208 | Caption = "SP :" 209 | BeginProperty Font 210 | Name = "MS Sans Serif" 211 | Size = 8.25 212 | Charset = 0 213 | Weight = 400 214 | Underline = 0 'False 215 | Italic = 0 'False 216 | Strikethrough = 0 'False 217 | EndProperty 218 | Height = 255 219 | Index = 3 220 | Left = 4680 221 | TabIndex = 5 222 | Top = 7800 223 | Visible = 0 'False 224 | Width = 375 225 | End 226 | Begin VB.Label Label1 227 | Caption = "PC :" 228 | BeginProperty Font 229 | Name = "MS Sans Serif" 230 | Size = 8.25 231 | Charset = 0 232 | Weight = 400 233 | Underline = 0 'False 234 | Italic = 0 'False 235 | Strikethrough = 0 'False 236 | EndProperty 237 | Height = 255 238 | Index = 2 239 | Left = 4680 240 | TabIndex = 4 241 | Top = 8040 242 | Visible = 0 'False 243 | Width = 375 244 | End 245 | Begin VB.Label Label1 246 | Caption = "D :" 247 | BeginProperty Font 248 | Name = "MS Sans Serif" 249 | Size = 8.25 250 | Charset = 0 251 | Weight = 400 252 | Underline = 0 'False 253 | Italic = 0 'False 254 | Strikethrough = 0 'False 255 | EndProperty 256 | Height = 255 257 | Index = 1 258 | Left = 4680 259 | TabIndex = 3 260 | Top = 6600 261 | Visible = 0 'False 262 | Width = 255 263 | End 264 | Begin VB.Label Label3 265 | Caption = "B :" 266 | BeginProperty Font 267 | Name = "MS Sans Serif" 268 | Size = 8.25 269 | Charset = 0 270 | Weight = 400 271 | Underline = 0 'False 272 | Italic = 0 'False 273 | Strikethrough = 0 'False 274 | EndProperty 275 | Height = 255 276 | Left = 4680 277 | TabIndex = 2 278 | Top = 6120 279 | Visible = 0 'False 280 | Width = 255 281 | End 282 | Begin VB.Label Label2 283 | Caption = "C :" 284 | BeginProperty Font 285 | Name = "MS Sans Serif" 286 | Size = 8.25 287 | Charset = 0 288 | Weight = 400 289 | Underline = 0 'False 290 | Italic = 0 'False 291 | Strikethrough = 0 'False 292 | EndProperty 293 | Height = 255 294 | Left = 4680 295 | TabIndex = 1 296 | Top = 6360 297 | Visible = 0 'False 298 | Width = 255 299 | End 300 | Begin VB.Label Label1 301 | Caption = "A :" 302 | BeginProperty Font 303 | Name = "MS Sans Serif" 304 | Size = 8.25 305 | Charset = 0 306 | Weight = 400 307 | Underline = 0 'False 308 | Italic = 0 'False 309 | Strikethrough = 0 'False 310 | EndProperty 311 | Height = 255 312 | Index = 0 313 | Left = 4680 314 | TabIndex = 0 315 | Top = 5880 316 | Visible = 0 'False 317 | Width = 255 318 | End 319 | End 320 | Attribute VB_Name = "frmRomInfo" 321 | Attribute VB_GlobalNameSpace = False 322 | Attribute VB_Creatable = False 323 | Attribute VB_PredeclaredId = True 324 | Attribute VB_Exposed = False 325 | Option Explicit 326 | 327 | Private Sub Command1_Click() 328 | Me.Hide 329 | End Sub 330 | 331 | Private Sub Form_Initialize() 332 | Call InitCommonControls 333 | End Sub 334 | 335 | Private Sub Form_Load() 336 | Call InitCommonControls 337 | Cart.Caption = Ct(rominfo.Ctype) 338 | iName.Caption = rominfo.Title 339 | lRos.Caption = Ros(rominfo.romsize) & vbNewLine & Rosn(rominfo.romsize) 340 | lRas.Caption = Ras(rominfo.ramsize) & vbNewLine & Rasn(rominfo.ramsize) 341 | GbColor.Caption = GBM 342 | End Sub 343 | 344 | -------------------------------------------------------------------------------- /BasicBoy/debugger.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "debugger" 2 | Option Explicit 3 | Dim lasdr As Long 4 | Public Function ToAsm1(ByVal val As Long, ByRef adr As Long) As String 5 | Dim tmp As Long 6 | Dim pre As String 7 | pre = String(4 - Len(Hex(adr)), "0") & Hex(adr) & ": " 8 | adr = adr + 1 9 | Select Case val 10 | Case &H0: ToAsm1 = "NOP" 11 | Case &H1: ToAsm1 = "LD BC," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 12 | Case &H2: ToAsm1 = "LD (BC),A" 13 | Case &H3: ToAsm1 = "INC BC" 14 | Case &H4: ToAsm1 = "INC B" 15 | Case &H5: ToAsm1 = "DEC B" 16 | Case &H6: ToAsm1 = "LD B," & Hex(readM(adr)) & "H": adr = adr + 1 17 | Case &H7: ToAsm1 = "RLC A" 18 | Case &H8: ToAsm1 = "LD (" & Hex(readM(adr) + readM(adr + 1) * 256) & "H), SP": adr = adr + 1: adr = adr + 1 19 | Case &H9: ToAsm1 = "ADD HL,BC" 20 | Case &HA: ToAsm1 = "LD A,(BC)" 21 | Case &HB: ToAsm1 = "DEC BC" 22 | Case &HC: ToAsm1 = "INC C" 23 | Case &HD: ToAsm1 = "DEC C" 24 | Case &HE: ToAsm1 = "LD C," & Hex(readM(adr)) & "H": adr = adr + 1 25 | Case &HF: ToAsm1 = "RRC A" 26 | Case &H10: ToAsm1 = "STOP": adr = adr + 1 27 | Case &H11: ToAsm1 = "LD DE," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 28 | Case &H12: ToAsm1 = "LD (DE),A" 29 | Case &H13: ToAsm1 = "INC DE" 30 | Case &H14: ToAsm1 = "INC D" 31 | Case &H15: ToAsm1 = "DEC D" 32 | Case &H16: ToAsm1 = "LD D," & Hex(readM(adr)) & "H": adr = adr + 1 33 | Case &H17: ToAsm1 = "RLA" 34 | Case &H18: 35 | tmp = readM(adr) 36 | If tmp And 128 Then 37 | tmp = 256 - tmp 38 | ToAsm1 = "JR -" & Hex(tmp) & "H" 39 | Else 40 | ToAsm1 = "JR " & Hex(tmp) & "H" 41 | End If 42 | Case &H19: ToAsm1 = "ADD HL,DE" 43 | Case &H1A: ToAsm1 = "LD A,(DE)" 44 | Case &H1B: ToAsm1 = "DEC DE" 45 | Case &H1C: ToAsm1 = "INC E" 46 | Case &H1D: ToAsm1 = "DEC E" 47 | Case &H1E: ToAsm1 = "LD E," & Hex(readM(adr)) & "H": adr = adr + 1 48 | Case &H1F: ToAsm1 = "RRA" 49 | Case &H20: 50 | tmp = readM(adr) 51 | If tmp And 128 Then 52 | tmp = 256 - tmp 53 | ToAsm1 = "JR NZ,-" & Hex(tmp) & "H" 54 | Else 55 | ToAsm1 = "JR NZ," & Hex(tmp) & "H" 56 | End If 57 | Case &H21: ToAsm1 = "LD HL," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 58 | Case &H22: ToAsm1 = "LDI (HL), A" 59 | Case &H23: ToAsm1 = "INC HL" 60 | Case &H24: ToAsm1 = "INC H" 61 | Case &H25: ToAsm1 = "DEC H" 62 | Case &H26: ToAsm1 = "LD H," & Hex(readM(adr)) & "H": adr = adr + 1 63 | Case &H27: ToAsm1 = "DAA" 64 | Case &H28: 65 | tmp = readM(adr) 66 | If tmp And 128 Then 67 | tmp = 256 - tmp 68 | ToAsm1 = "JR Z,-" & Hex(tmp) & "H" 69 | Else 70 | ToAsm1 = "JR Z," & Hex(tmp) & "H" 71 | End If 72 | Case &H29: ToAsm1 = "ADD HL,HL" 73 | Case &H2A: ToAsm1 = "LDI A,(HL)" 74 | Case &H2B: ToAsm1 = "DEC HL" 75 | Case &H2C: ToAsm1 = "INC L" 76 | Case &H2D: ToAsm1 = "DEC L" 77 | Case &H2E: ToAsm1 = "LD L," & Hex(readM(adr)) & "H": adr = adr + 1: adr = adr + 1 78 | Case &H2F: ToAsm1 = "CPL" 79 | Case &H30: 80 | tmp = readM(adr) 81 | If tmp And 128 Then 82 | tmp = 256 - tmp 83 | ToAsm1 = "JR NC,-" & Hex(tmp) & "H" 84 | Else 85 | ToAsm1 = "JR NC," & Hex(tmp) & "H" 86 | End If 87 | Case &H31: ToAsm1 = "LD SP," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 88 | Case &H32: ToAsm1 = "LDD (HL),A" 89 | Case &H33: ToAsm1 = "INC SP" 90 | Case &H34: ToAsm1 = "INC (HL)" 91 | Case &H35: ToAsm1 = "DEC (HL)" 92 | Case &H36: ToAsm1 = "LD (HL)," & Hex(readM(adr)) & "H": adr = adr + 1 93 | Case &H37: ToAsm1 = "SCF" 94 | Case &H38: 95 | tmp = readM(adr) 96 | If tmp And 128 Then 97 | tmp = 256 - tmp 98 | ToAsm1 = "JR C,-" & Hex(tmp) & "H" 99 | Else 100 | ToAsm1 = "JR C," & Hex(tmp) & "H" 101 | End If 102 | Case &H39: ToAsm1 = "ADD HL,SP" 103 | Case &H3A: ToAsm1 = "LDD A,(HL)" 104 | Case &H3B: ToAsm1 = "DEC SP" 105 | Case &H3C: ToAsm1 = "INC A" 106 | Case &H3D: ToAsm1 = "DEC A" 107 | Case &H3E: ToAsm1 = "LD A," & Hex(readM(adr)) & "H": adr = adr + 1 108 | Case &H3F: ToAsm1 = "CCF" 109 | Case &H40: ToAsm1 = "LD B,B" 110 | Case &H41: ToAsm1 = "LD B,C" 111 | Case &H42: ToAsm1 = "LD B,D" 112 | Case &H43: ToAsm1 = "LD B,E" 113 | Case &H44: ToAsm1 = "LD B,H" 114 | Case &H45: ToAsm1 = "LD B,L" 115 | Case &H46: ToAsm1 = "LD B,(HL)" 116 | Case &H47: ToAsm1 = "LD B,A" 117 | Case &H48: ToAsm1 = "LD C,B" 118 | Case &H49: ToAsm1 = "LD C,C" 119 | Case &H4A: ToAsm1 = "LD C,D" 120 | Case &H4B: ToAsm1 = "LD C,E" 121 | Case &H4C: ToAsm1 = "LD C,H" 122 | Case &H4D: ToAsm1 = "LD C,L" 123 | Case &H4E: ToAsm1 = "LD C,(HL)" 124 | Case &H4F: ToAsm1 = "LD C,A" 125 | Case &H50: ToAsm1 = "LD D,B" 126 | Case &H51: ToAsm1 = "LD D,C" 127 | Case &H52: ToAsm1 = "LD D,D" 128 | Case &H53: ToAsm1 = "LD D,E" 129 | Case &H54: ToAsm1 = "LD D,H" 130 | Case &H55: ToAsm1 = "LD D,L" 131 | Case &H56: ToAsm1 = "LD D,(HL)" 132 | Case &H57: ToAsm1 = "LD D,A" 133 | Case &H58: ToAsm1 = "LD E,B" 134 | Case &H59: ToAsm1 = "LD E,C" 135 | Case &H5A: ToAsm1 = "LD E,D" 136 | Case &H5B: ToAsm1 = "LD E,E" 137 | Case &H5C: ToAsm1 = "LD E,H" 138 | Case &H5D: ToAsm1 = "LD E,L" 139 | Case &H5E: ToAsm1 = "LD E,(HL)" 140 | Case &H5F: ToAsm1 = "LD E,A" 141 | Case &H60: ToAsm1 = "LD H,B" 142 | Case &H61: ToAsm1 = "LD H,C" 143 | Case &H62: ToAsm1 = "LD H,D" 144 | Case &H63: ToAsm1 = "LD H,E" 145 | Case &H64: ToAsm1 = "LD H,H" 146 | Case &H65: ToAsm1 = "LD H,L" 147 | Case &H66: ToAsm1 = "LD H,(HL)" 148 | Case &H67: ToAsm1 = "LD H,A" 149 | Case &H68: ToAsm1 = "LD L,B" 150 | Case &H69: ToAsm1 = "LD L,C" 151 | Case &H6A: ToAsm1 = "LD L,D" 152 | Case &H6B: ToAsm1 = "LD L,E" 153 | Case &H6C: ToAsm1 = "LD L,H" 154 | Case &H6D: ToAsm1 = "LD L,L" 155 | Case &H6E: ToAsm1 = "LD L,(HL)" 156 | Case &H6F: ToAsm1 = "LD L,A" 157 | Case &H70: ToAsm1 = "LD (HL),B" 158 | Case &H71: ToAsm1 = "LD (HL),C" 159 | Case &H72: ToAsm1 = "LD (HL),D" 160 | Case &H73: ToAsm1 = "LD (HL),E" 161 | Case &H74: ToAsm1 = "LD (HL),H" 162 | Case &H75: ToAsm1 = "LD (HL),L" 163 | Case &H76: ToAsm1 = "HALT" 164 | Case &H77: ToAsm1 = "LD (HL),A" 165 | Case &H78: ToAsm1 = "LD A,B" 166 | Case &H79: ToAsm1 = "LD A,C" 167 | Case &H7A: ToAsm1 = "LD A,D" 168 | Case &H7B: ToAsm1 = "LD A,E" 169 | Case &H7C: ToAsm1 = "LD A,H" 170 | Case &H7D: ToAsm1 = "LD A,L" 171 | Case &H7E: ToAsm1 = "LD A,(HL)" 172 | Case &H7F: ToAsm1 = "LD A,A" 173 | Case &H80: ToAsm1 = "ADD A,B" 174 | Case &H81: ToAsm1 = "ADD A,C" 175 | Case &H82: ToAsm1 = "ADD A,D" 176 | Case &H83: ToAsm1 = "ADD A,E" 177 | Case &H84: ToAsm1 = "ADD A,H" 178 | Case &H85: ToAsm1 = "ADD A,L" 179 | Case &H86: ToAsm1 = "ADD A,(HL)" 180 | Case &H87: ToAsm1 = "ADD A,A" 181 | Case &H88: ToAsm1 = "ADC A,B" 182 | Case &H89: ToAsm1 = "ADC A,C" 183 | Case &H8A: ToAsm1 = "ADC A,D" 184 | Case &H8B: ToAsm1 = "ADC A,E" 185 | Case &H8C: ToAsm1 = "ADC A,H" 186 | Case &H8D: ToAsm1 = "ADC A,L" 187 | Case &H8E: ToAsm1 = "ADC A,(HL)" 188 | Case &H8F: ToAsm1 = "ADC A,A" 189 | Case &H90: ToAsm1 = "SUB A,B" 190 | Case &H91: ToAsm1 = "SUB A,C" 191 | Case &H92: ToAsm1 = "SUB A,D" 192 | Case &H93: ToAsm1 = "SUB A,E" 193 | Case &H94: ToAsm1 = "SUB A,H" 194 | Case &H95: ToAsm1 = "SUB A,L" 195 | Case &H96: ToAsm1 = "SUB A,(HL)" 196 | Case &H97: ToAsm1 = "SUB A,A" 197 | Case &H98: ToAsm1 = "SBC A,B" 198 | Case &H99: ToAsm1 = "SBC A,C" 199 | Case &H9A: ToAsm1 = "SBC A,D" 200 | Case &H9B: ToAsm1 = "SBC A,E" 201 | Case &H9C: ToAsm1 = "SBC A,H" 202 | Case &H9D: ToAsm1 = "SBC A,L" 203 | Case &H9E: ToAsm1 = "SBC A,(HL)" 204 | Case &H9F: ToAsm1 = "SBC A,A" 205 | Case &HA0: ToAsm1 = "AND B" 206 | Case &HA1: ToAsm1 = "AND C" 207 | Case &HA2: ToAsm1 = "AND D" 208 | Case &HA3: ToAsm1 = "AND E" 209 | Case &HA4: ToAsm1 = "AND H" 210 | Case &HA5: ToAsm1 = "AND L" 211 | Case &HA6: ToAsm1 = "AND (HL)" 212 | Case &HA7: ToAsm1 = "AND A" 213 | Case &HA8: ToAsm1 = "XOR B" 214 | Case &HA9: ToAsm1 = "XOR C" 215 | Case &HAA: ToAsm1 = "XOR D" 216 | Case &HAB: ToAsm1 = "XOR E" 217 | Case &HAC: ToAsm1 = "XOR H" 218 | Case &HAD: ToAsm1 = "XOR L" 219 | Case &HAE: ToAsm1 = "XOR (HL)" 220 | Case &HAF: ToAsm1 = "XOR A" 221 | Case &HB0: ToAsm1 = "OR B" 222 | Case &HB1: ToAsm1 = "OR C" 223 | Case &HB2: ToAsm1 = "OR D" 224 | Case &HB3: ToAsm1 = "OR E" 225 | Case &HB4: ToAsm1 = "OR H" 226 | Case &HB5: ToAsm1 = "OR L" 227 | Case &HB6: ToAsm1 = "OR (HL)" 228 | Case &HB7: ToAsm1 = "OR A" 229 | Case &HB8: ToAsm1 = "CP B" 230 | Case &HB9: ToAsm1 = "CP C" 231 | Case &HBA: ToAsm1 = "CP D" 232 | Case &HBB: ToAsm1 = "CP E" 233 | Case &HBC: ToAsm1 = "CP H" 234 | Case &HBD: ToAsm1 = "CP L" 235 | Case &HBE: ToAsm1 = "CP (HL)" 236 | Case &HBF: ToAsm1 = "CP A" 237 | Case &HC0: ToAsm1 = "RET NZ" 238 | Case &HC1: ToAsm1 = "POP BC" 239 | Case &HC2: ToAsm1 = "JP NZ," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 240 | Case &HC3: ToAsm1 = "JP " & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 241 | Case &HC4: ToAsm1 = "CALL NZ," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 242 | Case &HC5: ToAsm1 = "PUSH BC" 243 | Case &HC6: ToAsm1 = "ADD A," & Hex(readM(adr)) & "H": adr = adr + 1 244 | Case &HC7: ToAsm1 = "RST 00H" 245 | Case &HC8: ToAsm1 = "RET Z" 246 | Case &HC9: ToAsm1 = "RET" 247 | Case &HCA: ToAsm1 = "JP Z," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 248 | Case &HCB: ToAsm1 = "CB " 249 | Case &HCC: ToAsm1 = "CALL Z," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 250 | Case &HCD: ToAsm1 = "CALL " & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 251 | Case &HCE: ToAsm1 = "ADC A," & Hex(readM(adr)) & "H": adr = adr + 1 252 | Case &HCF: ToAsm1 = "RST 08H" 253 | Case &HD0: ToAsm1 = "RET NC" 254 | Case &HD1: ToAsm1 = "POP DE" 255 | Case &HD2: ToAsm1 = "JP NC," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 256 | Case &HD3: ToAsm1 = "Invalid Opcode" 257 | Case &HD4: ToAsm1 = "CALL NC," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 258 | Case &HD5: ToAsm1 = "PUSH DE" 259 | Case &HD6: ToAsm1 = "SUB " & Hex(readM(adr)) & "H": adr = adr + 1 260 | Case &HD7: ToAsm1 = "RST 10H" 261 | Case &HD8: ToAsm1 = "RET C" 262 | Case &HD9: ToAsm1 = "RETI" 263 | Case &HDA: ToAsm1 = "JP C," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 264 | Case &HDB: ToAsm1 = "Invalid Opcode" 265 | Case &HDC: ToAsm1 = "CALL C," & Hex(readM(adr) + readM(adr + 1) * 256) & "H": adr = adr + 1: adr = adr + 1 266 | Case &HDD: ToAsm1 = "Invalid Opcode" 267 | Case &HDE: ToAsm1 = "SBC A," & Hex(readM(adr)) & "H": adr = adr + 1 268 | Case &HDF: ToAsm1 = "RST 18H" 269 | Case &HE0: ToAsm1 = "LDH (" & Hex(readM(adr)) & "H), A": adr = adr + 1 270 | Case &HE1: ToAsm1 = "POP HL" 271 | Case &HE2: ToAsm1 = "LDH (C), A" 272 | Case &HE3: ToAsm1 = "Invalid Opcode" 273 | Case &HE4: ToAsm1 = "Invalid Opcode" 274 | Case &HE5: ToAsm1 = "PUSH HL" 275 | Case &HE6: ToAsm1 = "AND " & Hex(readM(adr)) & "H": adr = adr + 1 276 | Case &HE7: ToAsm1 = "RST 20H" 277 | Case &HE8: ToAsm1 = "ADD SP," & Hex(readM(adr)) & "H": adr = adr + 1 278 | Case &HE9: ToAsm1 = "JP HL" 279 | Case &HEA: ToAsm1 = "LD (" & Hex(readM(adr) + readM(adr + 1) * 256) & "H), A": adr = adr + 1: adr = adr + 1 280 | Case &HEB: ToAsm1 = "Invalid Opcode" 281 | Case &HEC: ToAsm1 = "Invalid Opcode" 282 | Case &HED: ToAsm1 = "Invalid Opcode" 283 | Case &HEE: ToAsm1 = "XOR " & Hex(readM(adr)) & "H": adr = adr + 1 284 | Case &HEF: ToAsm1 = "RST 28H" 285 | Case &HF0: ToAsm1 = "LDH A,(" & Hex(readM(adr)) & "H)": adr = adr + 1 286 | Case &HF1: ToAsm1 = "POP AF" 287 | Case &HF2: ToAsm1 = "Invalid Opcode" 288 | Case &HF3: ToAsm1 = "DI" 289 | Case &HF4: ToAsm1 = "Invalid Opcode" 290 | Case &HF5: ToAsm1 = "PUSH AF" 291 | Case &HF6: ToAsm1 = "OR " & Hex(readM(adr)) & "H": adr = adr + 1 292 | Case &HF7: ToAsm1 = "RST 30H" 293 | Case &HF8: ToAsm1 = "LDHL SP," & Hex(readM(adr)) & "H": adr = adr + 1 294 | Case &HF9: ToAsm1 = "LD SP,HL" 295 | Case &HFA: ToAsm1 = "LD A,(" & Hex(readM(adr) + readM(adr + 1) * 256) & "H)": adr = adr + 1: adr = adr + 1 296 | Case &HFB: ToAsm1 = "EI" 297 | Case &HFC: ToAsm1 = "Invalid Opcode" 298 | Case &HFD: ToAsm1 = "Invalid Opcode" 299 | Case &HFE: ToAsm1 = "CP " & Hex(readM(adr)) & "H": adr = adr + 1 300 | Case &HFF: ToAsm1 = "RST 38H" 301 | End Select 302 | ToAsm1 = pre & ToAsm1 303 | End Function 304 | Sub dbinf(ByVal lon As Byte) 305 | 'If lon = &HCB Then 306 | 'lon = readM(PC) 307 | 'ic(lon + 256) = ic(lon + 256) + 1 308 | 'Else 309 | Debug.Print ToAsm1(lon, 0 + PC) 310 | 'End If 311 | End Sub 312 | Sub DebuggerDiss(ByVal adr As Long) 313 | If frmDebugger.w Then 314 | Dim sa As Long 315 | If adr <> lasdr Then 316 | Dim i As Long, li As Long 317 | frmDebugger.lstDiss.Clear 318 | #If 0 Then 319 | sa = adr ' save adr 320 | ToAsm2 readM(adr), adr 'get one inst 321 | adr = adr - 1 'dec one 322 | For i = 0 To 5 ' get prev six 323 | If adr < 65535 And adr > 0 Then frmDebugger.lstDiss.AddItem ToAsm2(readM(adr), adr) 324 | adr = adr - 1 325 | Next i 326 | adr = sa 327 | li = frmDebugger.lstDiss.ListCount - 1 328 | #End If 329 | If adr < 65535 And adr > 0 Then frmDebugger.lstDiss.AddItem ToAsm1(readM(adr), adr) 330 | For i = 0 To 5 331 | If adr < 65535 And adr > 0 Then frmDebugger.lstDiss.AddItem ToAsm1(readM(adr), adr) 332 | Next i 333 | frmDebugger.lstDiss.ListIndex = li 334 | lasdr = adr 335 | End If 336 | End If 337 | End Sub 338 | -------------------------------------------------------------------------------- /BasicBoy/modSoundEngine.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modSoundChip" 2 | 'This is a part of the BasicBoy emulator 3 | 'You are not allowed to release modified(or unmodified) versions 4 | 'without asking me (Raziel). 5 | 'For Suggestions ect please e-mail at :stef_mp@yahoo.gr 6 | 'To download the latest version/source goto basicboy.emuhost.com 7 | '(I know the emulator is NOT OPTIMIZED AT ALL) 8 | 9 | 'Sound Chip:Sound generator and mixer 10 | 'The interface with the emulator is in the modeSoundInterface.bas file 11 | 'I'm sure that waveform generation is not optimal and that there are 12 | 'many bugs..But it works :) 13 | 14 | 'v1.3.1 15 | 'Fisrt Implementation of the idea 16 | 'Sound Generation,Command procesing 17 | 18 | 19 | Option Explicit 20 | Option Base 0 21 | Global ssound As Long 22 | Dim inited As Byte 23 | Dim SoundS As clsSStream 24 | Dim i As Long, i_max As Long, t_chan As Long, i2 As Long 25 | Dim low_i2 As Long 26 | Public Sound_Sync_Pos As Long 27 | Dim buf() As Long, buf_() As Byte, buflenhalf As Long 28 | Dim com() As SoundCommand, cmd_index As Long, cmd_index_max As Long, cmd_index_t As Long 29 | Dim cmd_lo_idx As Long 30 | Public Const Sound_Sync As Double = 95.1089342403628 '4mega/44100 31 | Dim tmp_1 As Long 32 | '***Generation Variables*** 33 | Public wave1 As SoundCD12 34 | Public wave2 As SoundCD12 35 | Public wave3 As SoundCD3 36 | Public wave4 As SoundCD4 37 | 38 | Dim tmp_vard As Long 39 | 40 | 'Init everything 41 | Sub Init_Sound(ByVal buflen As Long) 42 | If inited Then 43 | inited = 0 44 | SoundS.ch.Stop 45 | Set SoundS = Nothing 46 | Init_Sound buflen 47 | Else 48 | inited = 1 49 | If buflen = 0 Then buflen = 8 50 | buflen = buflen * 441 '* 2 51 | ReDim buf(buflen) 52 | ReDim buf_(buflen) 53 | ReDim com(0 To buflen * 10) 54 | cmd_index_max = UBound(com) 55 | buflenhalf = buflen / 2 56 | Set SoundS = New clsSStream 57 | SoundS.init buflen 58 | generate 0 59 | generate 1 60 | SoundS.ch.Play DSBPLAY_LOOPING 61 | End If 62 | End Sub 63 | '**Send a command to the sound chip** 64 | Sub send_command(chan As Sound_Chans, cmd As Sound_CMD, param As Sound_Pars) 65 | If snd Then 66 | If cmd_index > UBound(com) Then ReDim Preserve com(cmd_index + 1000): cmd_index_max = cmd_index + 1000 67 | com(cmd_index).chan = chan 68 | com(cmd_index).cmd = cmd 69 | com(cmd_index).param = param 70 | com(cmd_index).en = 1 71 | com(cmd_index).pos = Sound_Sync_Pos / Sound_Sync 72 | cmd_index = cmd_index + 1 73 | End If 74 | End Sub 75 | '***Generate some samples*** 76 | Sub generate(half As Long) 77 | If (snd And gb_snd) = 1 Then 78 | cmd_lo_idx = 0 79 | chan1play buflenhalf - 1, buf: cmd_lo_idx = 0 80 | chan2play buflenhalf - 1, buf: cmd_lo_idx = 0 81 | chan3play buflenhalf - 1, buf: cmd_lo_idx = 0 82 | chan4play buflenhalf - 1, buf 83 | Sound_Sync_Pos = 0 84 | cmd_index = 0 85 | Else 86 | For cmd_index_t = 0 To cmd_index - 1 87 | If com(cmd_index_t).en = 1 Then 'command exec 88 | com(cmd_index_t).en = 0 'command was executed 89 | If com(cmd_index_t).chan = 1 Then proc_cmd1 com(cmd_index_t) 90 | If com(cmd_index_t).chan = 2 Then proc_cmd2 com(cmd_index_t) 91 | If com(cmd_index_t).chan = 3 Then proc_cmd3 com(cmd_index_t) 92 | If com(cmd_index_t).chan = 4 Then proc_cmd4 com(cmd_index_t) 93 | End If 94 | Next cmd_index_t 95 | cmd_index = 0 96 | End If 97 | mix32d buf, 4, buf_, buflenhalf - 1 98 | 99 | If half = 0 Then '0-half 100 | SoundS.ch.writebuffer 0, buflenhalf, buf_(0), DSBLOCK_DEFAULT 101 | Else 'half-end 102 | SoundS.ch.writebuffer buflenhalf, buflenhalf, buf_(0), DSBLOCK_DEFAULT 103 | End If 104 | End Sub 105 | Sub chan1play(Siz As Long, buf() As Long) 106 | For i = 0 To Siz 107 | 'generate sound chanel 1 108 | With wave1 109 | If .Play Then 110 | buf(i) = buf(i) + .Current * .Volume 111 | .Count = .Count + 1 112 | If .Count > CLng(.MCount) Then 113 | .Count = .Count - .MCount 114 | .Index = (.Index + 1) Mod 8 115 | .Current = sqrW(.Index, .Duty) 116 | End If 117 | End If 118 | End With 119 | 120 | 'Execute any command for this pos 121 | For cmd_index_t = cmd_lo_idx To cmd_index - 1 122 | If com(cmd_index_t).pos = i Then 123 | If com(cmd_index_t).en = 1 And com(cmd_index_t).chan = 1 Then 'command exec 124 | com(cmd_index_t).en = 0 'command was executed 125 | proc_cmd1 com(cmd_index_t) 126 | End If 127 | ElseIf com(cmd_index_t).pos > i Then 128 | GoTo ext: 129 | End If 130 | Next cmd_index_t 131 | ext: 132 | cmd_lo_idx = cmd_index_t 133 | Next i 134 | For cmd_index_t = cmd_lo_idx To cmd_index - 1 135 | If com(cmd_index_t).en = 1 And com(cmd_index_t).chan = 1 Then 'command exec 136 | com(cmd_index_t).en = 0 'command was executed 137 | proc_cmd1 com(cmd_index_t) 138 | End If 139 | Next cmd_index_t 140 | 141 | End Sub 142 | Sub chan2play(Siz As Long, buf() As Long) 143 | For i = 0 To Siz 144 | 'generate sound chanel 2 145 | With wave2 146 | If .Play Then 147 | buf(i) = buf(i) + .Current * .Volume 148 | .Count = .Count + 1 149 | If .Count > CLng(.MCount) Then 150 | .Count = .Count - .MCount 151 | .Index = (.Index + 1) Mod 8 152 | .Current = sqrW(.Index, .Duty) 153 | End If 154 | End If 155 | End With 156 | 157 | 'Exec any command for this sound pos 158 | For cmd_index_t = cmd_lo_idx To cmd_index - 1 159 | If com(cmd_index_t).pos = i Then 160 | If com(cmd_index_t).en = 1 And com(cmd_index_t).chan = 2 Then 'command exec 161 | com(cmd_index_t).en = 0 'command was executed 162 | proc_cmd2 com(cmd_index_t) 163 | End If 164 | ElseIf com(cmd_index_t).pos > i Then 165 | GoTo ext: 166 | End If 167 | Next cmd_index_t 168 | ext: 169 | cmd_lo_idx = cmd_index_t 170 | Next i 171 | For cmd_index_t = cmd_lo_idx To cmd_index - 1 172 | If com(cmd_index_t).en = 1 And com(cmd_index_t).chan = 2 Then 'command exec 173 | com(cmd_index_t).en = 0 'command was executed 174 | proc_cmd2 com(cmd_index_t) 175 | End If 176 | Next cmd_index_t 177 | 178 | 179 | End Sub 180 | Sub chan3play(Siz As Long, buf() As Long) 181 | 182 | For i = 0 To Siz 183 | 'generate sound chanel 3 184 | With wave3 185 | If .Play Then 186 | buf(i) = buf(i) + .Current * .Volume 187 | .Count = .Count + 1 188 | If .Count > CLng(wave3.MCount) Then 189 | .Count = .Count - .MCount 190 | .Index = (.Index + 1) Mod 32 191 | .Current = swm(.Waveform(wave3.Index)) 192 | End If 193 | End If 194 | End With 195 | 'Exec any command for this sound pos 196 | For cmd_index_t = cmd_lo_idx To cmd_index - 1 197 | If com(cmd_index_t).pos = i Then 198 | If com(cmd_index_t).en = 1 And com(cmd_index_t).chan = 3 Then 'command exec 199 | com(cmd_index_t).en = 0 'command was executed 200 | proc_cmd3 com(cmd_index_t) 201 | End If 202 | ElseIf com(cmd_index_t).pos > i Then 203 | GoTo ext: 204 | End If 205 | Next cmd_index_t 206 | ext: 207 | cmd_lo_idx = cmd_index_t 208 | Next i 209 | 'exec any odly positioned commands 210 | For cmd_index_t = cmd_lo_idx To cmd_index - 1 211 | If com(cmd_index_t).en = 1 And com(cmd_index_t).chan = 3 Then 'command exec 212 | com(cmd_index_t).en = 0 'command was executed 213 | proc_cmd3 com(cmd_index_t) 214 | End If 215 | Next cmd_index_t 216 | 217 | 218 | End Sub 219 | Sub chan4play(Siz As Long, buf() As Long) 220 | For i = 0 To Siz 221 | 'generate sound chanel 4 222 | If wave4.Play Then 223 | buf(i) = buf(i) + wave4.Current * wave4.Volume 224 | wave4.Count = wave4.Count + 1 225 | If wave4.Count > CLng(wave4.MCount) Then 226 | wave4.Count = wave4.Count - wave4.MCount 227 | If wave4.bits = 1 Then 228 | wave4.Index = (wave4.Index + 1) Mod 128 229 | wave4.Current = noise7(wave4.Index) 230 | Else 231 | wave4.Index = (wave4.Index + 1) Mod 32768 232 | wave4.Current = noise15(wave4.Index) 233 | End If 234 | End If 235 | End If 236 | 237 | 'Execute any command for this pos 238 | For cmd_index_t = cmd_lo_idx To cmd_index - 1 239 | If com(cmd_index_t).pos = i Then 240 | If com(cmd_index_t).en = 1 And com(cmd_index_t).chan = 4 Then 'command exec 241 | com(cmd_index_t).en = 0 'command was executed 242 | proc_cmd4 com(cmd_index_t) 243 | End If 244 | ElseIf com(cmd_index_t).pos > i Then 245 | GoTo ext: 246 | End If 247 | Next cmd_index_t 248 | ext: 249 | cmd_lo_idx = cmd_index_t 250 | Next i 251 | For cmd_index_t = cmd_lo_idx To cmd_index - 1 252 | If com(cmd_index_t).en = 1 And com(cmd_index_t).chan = 4 Then 'command exec 253 | com(cmd_index_t).en = 0 'command was executed 254 | proc_cmd4 com(cmd_index_t) 255 | End If 256 | Next cmd_index_t 257 | 258 | End Sub 259 | 260 | 261 | Sub proc_cmd1(ByRef command As SoundCommand) 'cmd proc for chanel1 262 | Select Case command.cmd 263 | Case 1 ' freq set 264 | command.param = 2048 - command.param 265 | wave1.MCount = command.param * 4.20570373535156E-02 '(0.042057037353515625) '8 wave phases 266 | Case 2 ' Pattern wave duty set 267 | wave1.Duty = command.param 268 | Case 3 ' volume set 269 | wave1.Volume = command.param / 15 270 | Case 13 ' play 271 | wave1.Play = 1 272 | 'updateNR52 273 | RAM(65318, 0) = gb_snd * 128 + _ 274 | wave4p * 8 + _ 275 | wave3p * 4 + _ 276 | wave2p * 2 + _ 277 | wave1p * 1 278 | Case 14 ' stop 279 | wave1.Play = 0 280 | 'updateNR52 281 | RAM(65318, 0) = gb_snd * 128 + _ 282 | wave4p * 8 + _ 283 | wave3p * 4 + _ 284 | wave2p * 2 + _ 285 | wave1p * 1 286 | End Select 287 | End Sub 288 | 289 | Sub proc_cmd2(ByRef command As SoundCommand) 290 | Select Case command.cmd 291 | Case 1 ' freq set 292 | command.param = 2048 - command.param 293 | wave2.MCount = command.param * 4.20570373535156E-02 '(0.042057037353515625) '8 wave phases 294 | Case 2 ' Pattern wave duty set 295 | wave2.Duty = command.param 296 | Case 3 ' volume set 297 | wave2.Volume = command.param / 15 298 | Case 13 ' play 299 | wave2.Play = 1 300 | 'updateNR52 301 | RAM(65318, 0) = gb_snd * 128 + _ 302 | wave4p * 8 + _ 303 | wave3p * 4 + _ 304 | wave2p * 2 + _ 305 | wave1p * 1 306 | Case 14 ' stop 307 | wave2.Play = 0 308 | 'updateNR52 309 | RAM(65318, 0) = gb_snd * 128 + _ 310 | wave4p * 8 + _ 311 | wave3p * 4 + _ 312 | wave2p * 2 + _ 313 | wave1p * 1 314 | End Select 315 | End Sub 316 | 317 | Sub proc_cmd3(ByRef command As SoundCommand) 318 | Select Case command.cmd 319 | Case 1 ' freq set 320 | command.param = 2048 - command.param 321 | wave3.MCount = ((1 / (65536 / command.param)) * 44100) / 32 '32 wave phases 322 | Case 5 ' volume set 323 | wave3.Volume = command.param / 256 324 | Case 13 ' play 325 | wave3.Play = 1 326 | 'updateNR52 327 | RAM(65318, 0) = gb_snd * 128 + _ 328 | wave4p * 8 + _ 329 | wave3p * 4 + _ 330 | wave2p * 2 + _ 331 | wave1p * 1 332 | Case 14 ' stop 333 | wave3.Play = 0 334 | 'updateNR52 335 | RAM(65318, 0) = gb_snd * 128 + _ 336 | wave4p * 8 + _ 337 | wave3p * 4 + _ 338 | wave2p * 2 + _ 339 | wave1p * 1 340 | Case 15 'write wave 341 | tmp_vard = (command.param \ 512) 342 | wave3.Waveform((command.param And 31) * 2) = tmp_vard 343 | tmp_vard = (command.param \ 32) And 15 344 | wave3.Waveform((command.param And 31) * 2 + 1) = tmp_vard 345 | End Select 346 | End Sub 347 | 348 | Sub proc_cmd4(ByRef command As SoundCommand) 349 | Select Case command.cmd 350 | Case 1 ' freq set 351 | If (command.param And 7) = 0 Then 352 | wave4.MCount = 1 / (4194304 * 1 / 2 ^ 3 * 2 * 1 / (2 ^ ((command.param \ 16) + 1))) * 44100 353 | Else 354 | wave4.MCount = 1 / (4194304 * 1 / 2 ^ 3 * 1 / (command.param And 7) * 1 / (2 ^ ((command.param \ 16) + 1))) * 44100 355 | End If 356 | Case 2 ' bits selection 357 | wave4.bits = command.param 358 | Case 3 ' volume set 359 | wave4.Volume = command.param / 15 360 | Case 13 ' play 361 | wave4.Play = 1 362 | 'updateNR52 363 | RAM(65318, 0) = gb_snd * 128 + _ 364 | wave4p * 8 + _ 365 | wave3p * 4 + _ 366 | wave2p * 2 + _ 367 | wave1p * 1 368 | Case 14 ' stop 369 | wave4.Play = 0 370 | 'updateNR52 371 | RAM(65318, 0) = gb_snd * 128 + _ 372 | wave4p * 8 + _ 373 | wave3p * 4 + _ 374 | wave2p * 2 + _ 375 | wave1p * 1 376 | End Select 377 | End Sub 378 | 379 | 'Helper functions for the software mixer 380 | Sub mix32d(data() As Long, chans As Long, tar() As Byte, upto As Long) '32 bits 381 | Dim temp As Long 382 | For i = 0 To upto 383 | temp = (data(i) \ chans) 384 | If temp > 126 Then 385 | temp = 126 386 | ElseIf temp < -126 Then 387 | temp = -126 388 | End If 389 | tar(i) = temp + 127 390 | data(i) = 0 391 | Next i 392 | End Sub 393 | 394 | -------------------------------------------------------------------------------- /BasicBoy/frmJoy.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmJoy 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "Configure keys" 5 | ClientHeight = 2295 6 | ClientLeft = 45 7 | ClientTop = 435 8 | ClientWidth = 4095 9 | Icon = "frmJoy.frx":0000 10 | LinkTopic = "Form2" 11 | MaxButton = 0 'False 12 | MinButton = 0 'False 13 | ScaleHeight = 2295 14 | ScaleWidth = 4095 15 | StartUpPosition = 3 'Windows Default 16 | Begin VB.CommandButton cmdj 17 | BeginProperty Font 18 | Name = "Tahoma" 19 | Size = 8.25 20 | Charset = 0 21 | Weight = 400 22 | Underline = 0 'False 23 | Italic = 0 'False 24 | Strikethrough = 0 'False 25 | EndProperty 26 | Height = 255 27 | Index = 9 28 | Left = 3120 29 | TabIndex = 18 30 | Top = 1200 31 | Width = 855 32 | End 33 | Begin VB.CommandButton cmdj 34 | BeginProperty Font 35 | Name = "Tahoma" 36 | Size = 8.25 37 | Charset = 0 38 | Weight = 400 39 | Underline = 0 'False 40 | Italic = 0 'False 41 | Strikethrough = 0 'False 42 | EndProperty 43 | Height = 255 44 | Index = 8 45 | Left = 3120 46 | TabIndex = 17 47 | Top = 840 48 | Width = 855 49 | End 50 | Begin VB.CommandButton Command1 51 | Caption = "Save" 52 | BeginProperty Font 53 | Name = "Tahoma" 54 | Size = 8.25 55 | Charset = 0 56 | Weight = 400 57 | Underline = 0 'False 58 | Italic = 0 'False 59 | Strikethrough = 0 'False 60 | EndProperty 61 | Height = 345 62 | Left = 2880 63 | TabIndex = 16 64 | Top = 1800 65 | Width = 1095 66 | End 67 | Begin VB.CommandButton cmdj 68 | BeginProperty Font 69 | Name = "Tahoma" 70 | Size = 8.25 71 | Charset = 0 72 | Weight = 400 73 | Underline = 0 'False 74 | Italic = 0 'False 75 | Strikethrough = 0 'False 76 | EndProperty 77 | Height = 255 78 | Index = 7 79 | Left = 3120 80 | TabIndex = 15 81 | Top = 480 82 | Width = 855 83 | End 84 | Begin VB.CommandButton cmdj 85 | BeginProperty Font 86 | Name = "Tahoma" 87 | Size = 8.25 88 | Charset = 0 89 | Weight = 400 90 | Underline = 0 'False 91 | Italic = 0 'False 92 | Strikethrough = 0 'False 93 | EndProperty 94 | Height = 255 95 | Index = 6 96 | Left = 3120 97 | TabIndex = 13 98 | Top = 120 99 | Width = 855 100 | End 101 | Begin VB.CommandButton cmdj 102 | BeginProperty Font 103 | Name = "Tahoma" 104 | Size = 8.25 105 | Charset = 0 106 | Weight = 400 107 | Underline = 0 'False 108 | Italic = 0 'False 109 | Strikethrough = 0 'False 110 | EndProperty 111 | Height = 255 112 | Index = 5 113 | Left = 1080 114 | TabIndex = 11 115 | Top = 1920 116 | Width = 855 117 | End 118 | Begin VB.CommandButton cmdj 119 | BeginProperty Font 120 | Name = "Tahoma" 121 | Size = 8.25 122 | Charset = 0 123 | Weight = 400 124 | Underline = 0 'False 125 | Italic = 0 'False 126 | Strikethrough = 0 'False 127 | EndProperty 128 | Height = 255 129 | Index = 4 130 | Left = 1080 131 | TabIndex = 9 132 | Top = 1560 133 | Width = 855 134 | End 135 | Begin VB.CommandButton cmdj 136 | BeginProperty Font 137 | Name = "Tahoma" 138 | Size = 8.25 139 | Charset = 0 140 | Weight = 400 141 | Underline = 0 'False 142 | Italic = 0 'False 143 | Strikethrough = 0 'False 144 | EndProperty 145 | Height = 255 146 | Index = 3 147 | Left = 1080 148 | TabIndex = 7 149 | Top = 1200 150 | Width = 855 151 | End 152 | Begin VB.CommandButton cmdj 153 | BeginProperty Font 154 | Name = "Tahoma" 155 | Size = 8.25 156 | Charset = 0 157 | Weight = 400 158 | Underline = 0 'False 159 | Italic = 0 'False 160 | Strikethrough = 0 'False 161 | EndProperty 162 | Height = 255 163 | Index = 2 164 | Left = 1080 165 | TabIndex = 5 166 | Top = 840 167 | Width = 855 168 | End 169 | Begin VB.CommandButton cmdj 170 | BeginProperty Font 171 | Name = "Tahoma" 172 | Size = 8.25 173 | Charset = 0 174 | Weight = 400 175 | Underline = 0 'False 176 | Italic = 0 'False 177 | Strikethrough = 0 'False 178 | EndProperty 179 | Height = 255 180 | Index = 1 181 | Left = 1080 182 | TabIndex = 3 183 | Top = 480 184 | Width = 855 185 | End 186 | Begin VB.CommandButton cmdj 187 | BeginProperty Font 188 | Name = "Tahoma" 189 | Size = 8.25 190 | Charset = 0 191 | Weight = 400 192 | Underline = 0 'False 193 | Italic = 0 'False 194 | Strikethrough = 0 'False 195 | EndProperty 196 | Height = 255 197 | Index = 0 198 | Left = 1080 199 | TabIndex = 1 200 | Top = 120 201 | Width = 855 202 | End 203 | Begin VB.Label Label1 204 | Caption = "Fast Disable" 205 | BeginProperty Font 206 | Name = "Tahoma" 207 | Size = 8.25 208 | Charset = 0 209 | Weight = 400 210 | Underline = 0 'False 211 | Italic = 0 'False 212 | Strikethrough = 0 'False 213 | EndProperty 214 | Height = 255 215 | Index = 9 216 | Left = 2160 217 | TabIndex = 20 218 | Top = 1200 219 | Width = 975 220 | End 221 | Begin VB.Label Label1 222 | Caption = "Fast Enable" 223 | BeginProperty Font 224 | Name = "Tahoma" 225 | Size = 8.25 226 | Charset = 0 227 | Weight = 400 228 | Underline = 0 'False 229 | Italic = 0 'False 230 | Strikethrough = 0 'False 231 | EndProperty 232 | Height = 255 233 | Index = 8 234 | Left = 2160 235 | TabIndex = 19 236 | Top = 840 237 | Width = 855 238 | End 239 | Begin VB.Label Label1 240 | Caption = "Select" 241 | BeginProperty Font 242 | Name = "Tahoma" 243 | Size = 8.25 244 | Charset = 0 245 | Weight = 400 246 | Underline = 0 'False 247 | Italic = 0 'False 248 | Strikethrough = 0 'False 249 | EndProperty 250 | Height = 255 251 | Index = 7 252 | Left = 2160 253 | TabIndex = 14 254 | Top = 480 255 | Width = 495 256 | End 257 | Begin VB.Label Label1 258 | Caption = "Start" 259 | BeginProperty Font 260 | Name = "Tahoma" 261 | Size = 8.25 262 | Charset = 0 263 | Weight = 400 264 | Underline = 0 'False 265 | Italic = 0 'False 266 | Strikethrough = 0 'False 267 | EndProperty 268 | Height = 255 269 | Index = 6 270 | Left = 2160 271 | TabIndex = 12 272 | Top = 120 273 | Width = 495 274 | End 275 | Begin VB.Label Label1 276 | Caption = "B button" 277 | BeginProperty Font 278 | Name = "Tahoma" 279 | Size = 8.25 280 | Charset = 0 281 | Weight = 400 282 | Underline = 0 'False 283 | Italic = 0 'False 284 | Strikethrough = 0 'False 285 | EndProperty 286 | Height = 255 287 | Index = 5 288 | Left = 120 289 | TabIndex = 10 290 | Top = 1920 291 | Width = 735 292 | End 293 | Begin VB.Label Label1 294 | Caption = "A button" 295 | BeginProperty Font 296 | Name = "Tahoma" 297 | Size = 8.25 298 | Charset = 0 299 | Weight = 400 300 | Underline = 0 'False 301 | Italic = 0 'False 302 | Strikethrough = 0 'False 303 | EndProperty 304 | Height = 255 305 | Index = 4 306 | Left = 120 307 | TabIndex = 8 308 | Top = 1560 309 | Width = 735 310 | End 311 | Begin VB.Label Label1 312 | Caption = "Right" 313 | BeginProperty Font 314 | Name = "Tahoma" 315 | Size = 8.25 316 | Charset = 0 317 | Weight = 400 318 | Underline = 0 'False 319 | Italic = 0 'False 320 | Strikethrough = 0 'False 321 | EndProperty 322 | Height = 255 323 | Index = 3 324 | Left = 120 325 | TabIndex = 6 326 | Top = 1200 327 | Width = 495 328 | End 329 | Begin VB.Label Label1 330 | Caption = "Left" 331 | BeginProperty Font 332 | Name = "Tahoma" 333 | Size = 8.25 334 | Charset = 0 335 | Weight = 400 336 | Underline = 0 'False 337 | Italic = 0 'False 338 | Strikethrough = 0 'False 339 | EndProperty 340 | Height = 255 341 | Index = 2 342 | Left = 120 343 | TabIndex = 4 344 | Top = 840 345 | Width = 375 346 | End 347 | Begin VB.Label Label1 348 | Caption = "Down" 349 | BeginProperty Font 350 | Name = "Tahoma" 351 | Size = 8.25 352 | Charset = 0 353 | Weight = 400 354 | Underline = 0 'False 355 | Italic = 0 'False 356 | Strikethrough = 0 'False 357 | EndProperty 358 | Height = 255 359 | Index = 1 360 | Left = 120 361 | TabIndex = 2 362 | Top = 480 363 | Width = 495 364 | End 365 | Begin VB.Label Label1 366 | Caption = "Up:" 367 | BeginProperty Font 368 | Name = "Tahoma" 369 | Size = 8.25 370 | Charset = 0 371 | Weight = 400 372 | Underline = 0 'False 373 | Italic = 0 'False 374 | Strikethrough = 0 'False 375 | EndProperty 376 | Height = 255 377 | Index = 0 378 | Left = 120 379 | TabIndex = 0 380 | Top = 120 381 | Width = 375 382 | End 383 | End 384 | Attribute VB_Name = "frmJoy" 385 | Attribute VB_GlobalNameSpace = False 386 | Attribute VB_Creatable = False 387 | Attribute VB_PredeclaredId = True 388 | Attribute VB_Exposed = False 389 | 390 | Dim keys As clsDik2, done As Long, wk As Long 391 | Sub confkeys() 392 | Me.Show 393 | done = 0 394 | wk = -1 395 | Set keys = New clsDik2 396 | keys.Startup frmMain.dih, Me.hwnd 397 | cmdj(0).Caption = keys.KeyName(Up) 398 | cmdj(1).Caption = keys.KeyName(Dn) 399 | cmdj(2).Caption = keys.KeyName(Lf) 400 | cmdj(3).Caption = keys.KeyName(Rg) 401 | cmdj(4).Caption = keys.KeyName(ABut) 402 | cmdj(5).Caption = keys.KeyName(BBut) 403 | cmdj(6).Caption = keys.KeyName(St1) 404 | cmdj(7).Caption = keys.KeyName(Sl1) 405 | cmdj(8).Caption = keys.KeyName(SpeedKeyD) 406 | cmdj(9).Caption = keys.KeyName(SpeedKeyU) 407 | Do 408 | DoEvents 409 | keys.Check_Keyboard 410 | Loop While done = 0 411 | Me.Hide 412 | Set keys = Nothing 413 | End Sub 414 | Public Sub ckeydown(key As Long) 415 | If wk > -1 Then 416 | Select Case wk 417 | Case 0 'up 418 | Up = key 419 | Case 1 'dn 420 | Dn = key 421 | Case 2 'lf 422 | Lf = key 423 | Case 3 'rg 424 | Rg = key 425 | Case 4 'abut 426 | ABut = key 427 | Case 5 'bbut 428 | BBut = key 429 | Case 6 'st1 430 | St1 = key 431 | Case 7 'sl1 432 | Sl1 = key 433 | Case 8 'speedkeyd 434 | SpeedKeyD = key 435 | Case 9 'speedkeyu 436 | SpeedKeyU = key 437 | End Select 438 | SaveSetting "BasicBoy", "Joy", "up", Up 439 | SaveSetting "BasicBoy", "Joy", "dn", Dn 440 | SaveSetting "BasicBoy", "Joy", "lf", Lf 441 | SaveSetting "BasicBoy", "Joy", "rg", Rg 442 | SaveSetting "BasicBoy", "Joy", "ab", ABut 443 | SaveSetting "BasicBoy", "Joy", "bb", BBut 444 | SaveSetting "BasicBoy", "Joy", "st1", St1: SaveSetting "BasicBoy", "Joy", "st2", St1: SaveSetting "BasicBoy", "Joy", "st3", St1 445 | SaveSetting "BasicBoy", "Joy", "sl1", Sl1: SaveSetting "BasicBoy", "Joy", "sl2", Sl1 446 | SaveSetting "BasicBoy", "Joy", "spdd", SpeedKeyD: SaveSetting "BasicBoy", "Joy", "spdu", SpeedKeyU 447 | cmdj(0).Caption = keys.KeyName(Up) 448 | cmdj(1).Caption = keys.KeyName(Dn) 449 | cmdj(2).Caption = keys.KeyName(Lf) 450 | cmdj(3).Caption = keys.KeyName(Rg) 451 | cmdj(4).Caption = keys.KeyName(ABut) 452 | cmdj(5).Caption = keys.KeyName(BBut) 453 | cmdj(6).Caption = keys.KeyName(St1) 454 | cmdj(7).Caption = keys.KeyName(Sl1) 455 | cmdj(8).Caption = keys.KeyName(SpeedKeyD) 456 | cmdj(9).Caption = keys.KeyName(SpeedKeyU) 457 | wk = -1 458 | End If 459 | End Sub 460 | 461 | Private Sub cmdj_Click(Index As Integer) 462 | wk = Index 463 | cmdj(Index).Caption = "..." 464 | End Sub 465 | 466 | Private Sub Command1_Click() 467 | done = 1 468 | End Sub 469 | 470 | Private Sub Form_Initialize() 471 | Call InitCommonControls 472 | End Sub 473 | 474 | Private Sub Form_Load() 475 | Call InitCommonControls 476 | End Sub 477 | 478 | Private Sub Form_Unload(Cancel As Integer) 479 | done = 1 480 | End Sub 481 | --------------------------------------------------------------------------------