commit a8856756f6be5b134770dbab1b69474dfd6bcd27 Author: xeons Date: Thu Jul 10 23:56:29 2014 -0500 Initial commit diff --git a/OverworldEditor.vbp b/OverworldEditor.vbp new file mode 100644 index 0000000..4bea224 --- /dev/null +++ b/OverworldEditor.vbp @@ -0,0 +1,39 @@ +Type=Exe +Form=frmOverworldEditor.frm +Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation +Module=modGraphicEditing; modGraphicEditing.bas +Form=frmAbout.frm +Class=clsCommonDialog; clsCommonDialog.cls +IconForm="frmOverworldEditor" +Startup="frmOverworldEditor" +HelpFile="" +Title="OverworldEditor" +ExeName32="OverworldEditor.exe" +Command32="" +Name="OverworldEditor" +HelpContextID="0" +CompatibleMode="0" +MajorVer=1 +MinorVer=0 +RevisionVer=13 +AutoIncrementVer=1 +ServerSupportFiles=0 +VersionCompanyName="Xeon Productions" +CompilationType=0 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 + +[MS Transaction Server] +AutoRefresh=1 diff --git a/OverworldEditor.vbw b/OverworldEditor.vbw new file mode 100644 index 0000000..d190c27 --- /dev/null +++ b/OverworldEditor.vbw @@ -0,0 +1,4 @@ +frmOverworldEditor = 99, 12, 892, 426, , 135, -15, 928, 481, C +modGraphicEditing = 110, 29, 925, 419, +frmAbout = 44, 58, 862, 423, , 22, 29, 840, 394, C +clsCommonDialog = 0, 0, 861, 286, Z diff --git a/README.md b/README.md new file mode 100644 index 0000000..82af6a6 --- /dev/null +++ b/README.md @@ -0,0 +1,51 @@ +Pokémon Overworld Sprite Editor +=============================== + +Sprite Navigation +----------------- +This is where you can pick the index of the sprite +to edit, there are over 200 sprites on all the games. + +Right now there is no way of determining how many +frames each sprite has, so if you go over how many +frames are actually in a sprite, it will start reading +from the sprite # after it. + +Sprite Header #1 Info +--------------------- +Sprite #: Current sprite you are on. +Starter Bytes: First two bytes in the header, always FFFF. +Pallete #: This is just the numerical index of the Pallete. There are around 20+ sprite palletes in the game. +Unknown Data: Self-Explanitory, its in the header, and I have no idea what it does? +Sprite Data Size: The number of bytes a the sprite takes +Width and Height: Self-explanitory. +Unknown Data 2: More data I have no clue what it does. +Unknown Pointer 1, 2, 3, and 4 I have no idea what kind of data these pointers point to. I believe 2 has to do with tile arrangment. +Sprite Pointer: Points to Sprite Header #2 + +Sprite Header #2 Info +--------------------- +Sprite Pointer: Actual pointer to the sprite image data. +Data Size: another specifier of datasize +Unknown 1: As the name says! + + +Drawing Canvas Features +----------------------- +- You can drag the current color, its like paintbrush. +- Right click on a pixel and it will make that the selected + color. +- Displays the color your mouse is over, and the currently + selected color. + +Games Supported +=============== +- Pokemon Ruby/Sapphire/Emerald (English Versions) +- Pokemon FireRed/LeafGreen (English and Japanese Versions) + +Features Coming Soon +==================== +- Import/Export Bitmaps +- Undo/Redo +- German and More japanese ROM support. +- Repointing and Pallete Editing \ No newline at end of file diff --git a/Sprites.ini b/Sprites.ini new file mode 100644 index 0000000..c376126 --- /dev/null +++ b/Sprites.ini @@ -0,0 +1,41 @@ +[AXVE] +Name = Pokémon Ruby (English) +SpritePalleteHeaders = &H37377C +SpriteBank = &H3718D4 +SpriteCount = 217 + +[AXPE] +Name = Pokémon Sapphire (English) +SpritePalleteHeaders = &H37370C +SpriteBank = &H371864 +SpriteCount = 217 + +[BPEE] +Name = Pokémon Emerald (English) +SpritePalleteHeaders = &H50BBC8 +SpriteBank = &H509954 +SpriteCount = 244 + +[BPRE] +Name = Pokémon Fire Red (English) +SpritePalleteHeaders = &H3A5158 +SpriteBank = &H3A3BB0 +SpriteCount = 153 + +[BPRJ] +Name = Pokémon Fire Red (Japanese) +SpritePalleteHeaders = &H3691E0 +SpriteBank = &H367C38 +SpriteCount = 153 + +[BPGE] +Name = Pokémon Leaf Green (English) +SpritePalleteHeaders = &H3A5138 +SpriteBank = &H3A3B90 +SpriteCount = 153 + +[BPGJ] +Name = Pokémon Leaf Green (Japanese) +SpritePalleteHeaders = &H3691C0 +SpriteBank = &H367C18 +SpriteCount = 153 \ No newline at end of file diff --git a/clsCommonDialog.cls b/clsCommonDialog.cls new file mode 100644 index 0000000..8bcf0e2 --- /dev/null +++ b/clsCommonDialog.cls @@ -0,0 +1,147 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "clsCommonDialog" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Private Declare Function GetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long +Private Declare Function GetSaveFileName Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long + +Private cdlg As OPENFILENAME +Private LastFileName As String +Private Type OPENFILENAME + lStructSize As Long + hwndOwner As Long + hInstance As Long + lpstrFilter As String + lpstrCustomFilter As String + nMaxCustFilter As Long + nFilterIndex As Long + lpstrFile As String + nMaxFile As Long + lpstrFileTitle As String + nMaxFileTitle As Long + lpstrInitialDir As String + lpstrTitle As String + Flags As Long + nFileOffset As Integer + nFileExtension As Integer + lpstrDefExt As String + lCustData As Long + lpfnHook As Long + lpTemplateName As String +End Type + +Private Const OFN_ALLOWMULTISELECT = &H200 +Private Const OFN_CREATEPROMPT = &H2000 +Private Const OFN_ENABLEHOOK = &H20 +Private Const OFN_ENABLETEMPLATE = &H40 +Private Const OFN_ENABLETEMPLATEHANDLE = &H80 +Private Const OFN_EXPLORER = &H80000 ' new look commdlg +Private Const OFN_EXTENSIONDIFFERENT = &H400 +Private Const OFN_FILEMUSTEXIST = &H1000 +Private Const OFN_HIDEREADONLY = &H4 +Private Const OFN_LONGNAMES = &H200000 ' force long names for 3.x modules +Private Const OFN_NOCHANGEDIR = &H8 +Private Const OFN_NODEREFERENCELINKS = &H100000 +Private Const OFN_NOLONGNAMES = &H40000 ' force no long names for 4.x modules +Private Const OFN_NONETWORKBUTTON = &H20000 +Private Const OFN_NOREADONLYRETURN = &H8000 +Private Const OFN_NOTESTFILECREATE = &H10000 +Private Const OFN_NOVALIDATE = &H100 +Private Const OFN_OVERWRITEPROMPT = &H2 +Private Const OFN_PATHMUSTEXIST = &H800 +Private Const OFN_READONLY = &H1 +Private Const OFN_SHAREAWARE = &H4000 +Private Const OFN_SHAREFALLTHROUGH = 2 +Private Const OFN_SHARENOWARN = 1 +Private Const OFN_SHAREWARN = 0 +Private Const OFN_SHOWHELP = &H10 + +Public Enum DialogFlags + ALLOWMULTISELECT = OFN_ALLOWMULTISELECT + CREATEPROMPT = OFN_CREATEPROMPT + ENABLEHOOK = OFN_ENABLEHOOK + ENABLETEMPLATE = OFN_ENABLETEMPLATE + ENABLETEMPLATEHANDLE = OFN_ENABLETEMPLATEHANDLE + EXPLORER = OFN_EXPLORER + EXTENSIONDIFFERENT = OFN_EXTENSIONDIFFERENT + FILEMUSTEXIST = OFN_FILEMUSTEXIST + HIDEREADONLY = OFN_HIDEREADONLY + LONGNAMES = OFN_LONGNAMES + NOCHANGEDIR = OFN_NOCHANGEDIR + NODEREFERENCELINKS = OFN_NODEREFERENCELINKS + NOLONGNAMES = OFN_NOLONGNAMES + NONETWORKBUTTON = OFN_NONETWORKBUTTON + NOREADONLYRETURN = OFN_NOREADONLYRETURN + NOTESTFILECREATE = OFN_NOTESTFILECREATE + NOVALIDATE = OFN_NOVALIDATE + OVERWRITEPROMPT = OFN_OVERWRITEPROMPT + PATHMUSTEXIST = OFN_PATHMUSTEXIST + ReadOnly = OFN_READONLY + SHAREAWARE = OFN_SHAREAWARE + SHAREFALLTHROUGH = OFN_SHAREFALLTHROUGH + SHARENOWARN = OFN_SHARENOWARN + SHAREWARN = OFN_SHAREWARN + SHOWHELP = OFN_SHOWHELP +End Enum + + +Public Function ShowOpen(ByVal Form_hWnd As Long, ByVal Title As String, Optional ByVal InitDir As String = "", Optional ByVal Filter As String = "All Files (*.*)|*.*|", Optional Flags As DialogFlags = FILEMUSTEXIST Or PATHMUSTEXIST) As String + Dim i As Integer + Filter = Replace(Filter, "|", Chr(0)) + If Right(Filter, 1) <> Chr(0) Then Filter = Filter & Chr(0) + If Len(InitDir) = 0 Then InitDir = LastFileName + cdlg.lStructSize = Len(cdlg) + cdlg.hwndOwner = Form_hWnd + cdlg.hInstance = App.hInstance + cdlg.lpstrFilter = Filter + cdlg.lpstrFile = Space(254) + cdlg.nMaxFile = 255 + cdlg.lpstrFileTitle = Space(254) + cdlg.nMaxFileTitle = 255 + cdlg.lpstrInitialDir = InitDir + cdlg.lpstrTitle = Title + cdlg.Flags = Flags + ShowOpen = IIf(GetOpenFileName(cdlg), Trim(cdlg.lpstrFile), "") + If Len(ShowOpen) > 0 Then LastFileName = ShowOpen +End Function + +Public Function ShowSave(ByVal Form_hWnd As Long, ByVal Title As String, Optional ByVal InitDir As String = "", Optional ByVal Filter As String = "All Files (*.*)|*.*|", Optional ByVal DefExt As String = "", Optional Flags As DialogFlags = OVERWRITEPROMPT) As String + Dim i As Integer + Filter = Replace(Filter, "|", Chr(0)) + If Right(Filter, 1) <> Chr(0) Then Filter = Filter & Chr(0) + If Len(InitDir) = 0 Then InitDir = LastFileName + cdlg.lStructSize = Len(cdlg) + cdlg.lpstrTitle = Title + cdlg.hwndOwner = Form_hWnd + cdlg.hInstance = App.hInstance + cdlg.lpstrFilter = Filter + cdlg.lpstrDefExt = DefExt + cdlg.lpstrFile = Space(255) + cdlg.nMaxFile = 255 + cdlg.lpstrFileTitle = Space(254) + cdlg.nMaxFileTitle = 255 + cdlg.lpstrInitialDir = InitDir + cdlg.Flags = Flags + ShowSave = IIf(GetSaveFileName(cdlg), Trim(cdlg.lpstrFile), "") + If Len(ShowSave) > 0 Then LastFileName = ShowSave +End Function + +Public Property Let FileName(szFileName) + LastFileName = szFileName +End Property + +Public Property Get FileName() + FileName = LastFileName +End Property + diff --git a/frmAbout.frm b/frmAbout.frm new file mode 100644 index 0000000..4e6093d --- /dev/null +++ b/frmAbout.frm @@ -0,0 +1,117 @@ +VERSION 5.00 +Begin VB.Form frmAbout + BorderStyle = 1 'Fixed Single + Caption = "About..." + ClientHeight = 2535 + ClientLeft = 45 + ClientTop = 435 + ClientWidth = 5175 + BeginProperty Font + Name = "Tahoma" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Icon = "frmAbout.frx":0000 + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 2535 + ScaleWidth = 5175 + StartUpPosition = 3 'Windows Default + Begin VB.CommandButton cmdOK + Caption = "OK" + Height = 345 + Left = 3960 + TabIndex = 4 + Top = 840 + Width = 1095 + End + Begin VB.Label lblAbout + Caption = $"frmAbout.frx":151A + Height = 1215 + Index = 1 + Left = 120 + TabIndex = 3 + Top = 1200 + Width = 3615 + End + Begin VB.Label lblAbout + Alignment = 2 'Center + Caption = "Coded by Xeon" + BeginProperty Font + Name = "Tahoma" + Size = 8.25 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Index = 0 + Left = 120 + TabIndex = 2 + Top = 840 + Width = 3615 + End + Begin VB.Label lblVersion + BackColor = &H00FFFFFF& + Caption = "Version 1.0" + Height = 255 + Left = 840 + TabIndex = 1 + Top = 360 + Width = 3255 + End + Begin VB.Label lblApplicationTitle + BackColor = &H00FFFFFF& + Caption = "Pokémon Overworld Sprite Editor" + BeginProperty Font + Name = "Tahoma" + Size = 8.25 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Left = 840 + TabIndex = 0 + Top = 120 + Width = 3735 + End + Begin VB.Image imgProgramIcon + Height = 480 + Left = 120 + Picture = "frmAbout.frx":162C + Top = 120 + Width = 480 + End + Begin VB.Shape shpHeaderBackground + BackStyle = 1 'Opaque + BorderStyle = 0 'Transparent + Height = 735 + Left = 0 + Top = 0 + Width = 6375 + End +End +Attribute VB_Name = "frmAbout" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Private Sub cmdOK_Click() + Unload Me +End Sub + +Private Sub Form_Load() + lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision & " by Xeon" +End Sub diff --git a/frmAbout.frx b/frmAbout.frx new file mode 100644 index 0000000..16468a6 Binary files /dev/null and b/frmAbout.frx differ diff --git a/frmOverworldEditor.frm b/frmOverworldEditor.frm new file mode 100644 index 0000000..7e49b7f --- /dev/null +++ b/frmOverworldEditor.frm @@ -0,0 +1,1113 @@ +VERSION 5.00 +Begin VB.Form frmOverworldEditor + BorderStyle = 1 'Fixed Single + Caption = "Pokémon Overworld Sprite Editor" + ClientHeight = 6735 + ClientLeft = 150 + ClientTop = 780 + ClientWidth = 8535 + BeginProperty Font + Name = "Tahoma" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Icon = "frmOverworldEditor.frx":0000 + LinkTopic = "Form1" + MaxButton = 0 'False + ScaleHeight = 449 + ScaleMode = 3 'Pixel + ScaleWidth = 569 + StartUpPosition = 3 'Windows Default + Begin VB.Frame grpSpriteHeaderTwo + Caption = "Sprite Header #2 Info" + Height = 1215 + Left = 3120 + TabIndex = 40 + Top = 2640 + Width = 2535 + Begin VB.Label lblUnknownHdr2 + Caption = "Unknown 1:" + Height = 255 + Left = 240 + TabIndex = 43 + Top = 840 + Width = 2055 + End + Begin VB.Label lblSpriteDataSizeHdr2 + Caption = "Data Size:" + Height = 255 + Left = 240 + TabIndex = 42 + Top = 600 + Width = 2055 + End + Begin VB.Label lblSpritePointerHdr2 + Caption = "Sprite Pointer:" + Height = 255 + Left = 240 + TabIndex = 41 + Top = 360 + Width = 2055 + End + End + Begin VB.Frame grpNavigation + Caption = "Sprite Navigation" + Height = 1215 + Left = 120 + TabIndex = 30 + Top = 2640 + Width = 2895 + Begin VB.TextBox txtSpriteFrame + Alignment = 2 'Center + Height = 285 + Left = 1200 + TabIndex = 37 + Text = "0" + Top = 720 + Width = 495 + End + Begin VB.CommandButton cmdSpriteFrameBackwards + Height = 255 + Left = 840 + Picture = "frmOverworldEditor.frx":151A + Style = 1 'Graphical + TabIndex = 36 + Top = 735 + Width = 255 + End + Begin VB.CommandButton cmdSpriteFrameForward + Height = 255 + Left = 1800 + Picture = "frmOverworldEditor.frx":1585 + Style = 1 'Graphical + TabIndex = 35 + Top = 735 + Width = 255 + End + Begin VB.CommandButton cmdIndexForward + Height = 255 + Left = 1800 + Picture = "frmOverworldEditor.frx":15F1 + Style = 1 'Graphical + TabIndex = 34 + Top = 375 + Width = 255 + End + Begin VB.CommandButton cmdIndexBack + Height = 255 + Left = 840 + Picture = "frmOverworldEditor.frx":165D + Style = 1 'Graphical + TabIndex = 33 + Top = 375 + Width = 255 + End + Begin VB.TextBox txtSpriteIndex + Alignment = 2 'Center + Height = 285 + Left = 1200 + TabIndex = 32 + Text = "0" + Top = 360 + Width = 495 + End + Begin VB.CommandButton cmdGo + Caption = "Go" + Height = 615 + Left = 2160 + TabIndex = 31 + Top = 360 + Width = 495 + End + Begin VB.Label lblFrame + Caption = "Frame " + Height = 255 + Left = 240 + TabIndex = 39 + Top = 735 + Width = 615 + End + Begin VB.Label lblSpriteIndex + Caption = "Index " + Height = 255 + Left = 240 + TabIndex = 38 + Top = 375 + Width = 615 + End + End + Begin VB.Frame grpSpriteHeader1 + Caption = "Sprite Header #1 Info" + Height = 2655 + Left = 120 + TabIndex = 16 + Top = 3960 + Width = 5535 + Begin VB.Label lblUnknownPointer4 + Caption = "Unknown Pointer 4:" + Height = 255 + Left = 2880 + TabIndex = 29 + Top = 1380 + Width = 2415 + End + Begin VB.Label lblSpritePointer + Caption = "Sprite Pointer:" + Height = 255 + Left = 2880 + TabIndex = 28 + Top = 1125 + Width = 2415 + End + Begin VB.Label lblUnknownPointer3 + Caption = "Unknown Pointer 3:" + Height = 255 + Left = 2880 + TabIndex = 27 + Top = 870 + Width = 2415 + End + Begin VB.Label lblUnknownPointer2 + Caption = "Unknown Pointer 2:" + Height = 255 + Left = 2880 + TabIndex = 26 + Top = 615 + Width = 2415 + End + Begin VB.Label lblUnknownPointer1 + Caption = "Unknown Pointer 1:" + Height = 255 + Left = 2880 + TabIndex = 25 + Top = 360 + Width = 2415 + End + Begin VB.Label lblPalleteNumber + Caption = "Pallete #:" + Height = 255 + Left = 240 + TabIndex = 24 + Top = 870 + Width = 2415 + End + Begin VB.Label lblStarterBytes + Caption = "Starter Bytes:" + Height = 255 + Left = 240 + TabIndex = 23 + Top = 615 + Width = 2415 + End + Begin VB.Label lblUnknownData2 + Caption = "Unknown Data 2:" + Height = 255 + Left = 240 + TabIndex = 22 + Top = 2145 + Width = 2415 + End + Begin VB.Label lblSpriteNumber + Caption = "Sprite #:" + Height = 255 + Left = 240 + TabIndex = 21 + Top = 360 + Width = 2415 + End + Begin VB.Label lblSpriteDataSize + Caption = "Sprite Data Size: " + Height = 255 + Left = 240 + TabIndex = 20 + Top = 1380 + Width = 2415 + End + Begin VB.Label lblUnknownData + Caption = "Unknown Data:" + Height = 255 + Left = 240 + TabIndex = 19 + Top = 1125 + Width = 2415 + End + Begin VB.Label lblSpriteWidth + Caption = "Width:" + Height = 255 + Left = 240 + TabIndex = 17 + Top = 1635 + Width = 2415 + End + Begin VB.Label lblSpriteHeight + Caption = "Height:" + Height = 255 + Left = 240 + TabIndex = 18 + Top = 1890 + Width = 2415 + End + End + Begin VB.PictureBox picMouseOverColor + Appearance = 0 'Flat + BackColor = &H80000005& + ForeColor = &H80000008& + Height = 495 + Left = 7200 + ScaleHeight = 465 + ScaleWidth = 1185 + TabIndex = 12 + Top = 5160 + Width = 1215 + End + Begin VB.CommandButton cmdFlipVertical + Enabled = 0 'False + Height = 375 + Left = 7080 + Picture = "frmOverworldEditor.frx":16C8 + Style = 1 'Graphical + TabIndex = 7 + Top = 6120 + Width = 495 + End + Begin VB.CommandButton cmdFlipHorizontal + Enabled = 0 'False + Height = 375 + Left = 7680 + Picture = "frmOverworldEditor.frx":1A6E + Style = 1 'Graphical + TabIndex = 6 + Top = 6120 + Width = 495 + End + Begin VB.CommandButton cmdRotateRight + Enabled = 0 'False + Height = 375 + Left = 6480 + Picture = "frmOverworldEditor.frx":1E0E + Style = 1 'Graphical + TabIndex = 5 + Top = 6120 + Width = 495 + End + Begin VB.CommandButton cmdRotateLeft + Enabled = 0 'False + Height = 375 + Left = 5880 + Picture = "frmOverworldEditor.frx":21C6 + Style = 1 'Graphical + TabIndex = 4 + Top = 6120 + Width = 495 + End + Begin VB.PictureBox picSelectPalette + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H80000005& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 1920 + Left = 7920 + MouseIcon = "frmOverworldEditor.frx":257F + MousePointer = 99 'Custom + ScaleHeight = 128 + ScaleMode = 3 'Pixel + ScaleWidth = 32 + TabIndex = 3 + Top = 2880 + Width = 480 + Begin VB.Line lnePalleteGrid + Index = 7 + X1 = 16 + X2 = 16 + Y1 = 0 + Y2 = 128 + End + Begin VB.Line lnePalleteGrid + Index = 6 + X1 = 0 + X2 = 32 + Y1 = 112 + Y2 = 112 + End + Begin VB.Line lnePalleteGrid + Index = 5 + X1 = 0 + X2 = 32 + Y1 = 96 + Y2 = 96 + End + Begin VB.Line lnePalleteGrid + Index = 4 + X1 = 0 + X2 = 32 + Y1 = 80 + Y2 = 80 + End + Begin VB.Line lnePalleteGrid + Index = 3 + X1 = 0 + X2 = 32 + Y1 = 64 + Y2 = 64 + End + Begin VB.Line lnePalleteGrid + Index = 2 + X1 = 0 + X2 = 32 + Y1 = 48 + Y2 = 48 + End + Begin VB.Line lnePalleteGrid + Index = 1 + X1 = 0 + X2 = 32 + Y1 = 32 + Y2 = 32 + End + Begin VB.Line lnePalleteGrid + Index = 0 + X1 = 0 + X2 = 32 + Y1 = 16 + Y2 = 16 + End + Begin VB.Shape shpPalleteBorder + Height = 1920 + Left = 0 + Top = 0 + Width = 480 + End + End + Begin VB.PictureBox picEditTile + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H80000005& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 1920 + Left = 5880 + MouseIcon = "frmOverworldEditor.frx":26D1 + MousePointer = 99 'Custom + ScaleHeight = 128 + ScaleMode = 3 'Pixel + ScaleWidth = 128 + TabIndex = 2 + Top = 2880 + Width = 1920 + Begin VB.Line lneTileEditGrid + Index = 13 + X1 = 128 + X2 = 0 + Y1 = 112 + Y2 = 112 + End + Begin VB.Line lneTileEditGrid + Index = 12 + X1 = 128 + X2 = 0 + Y1 = 96 + Y2 = 96 + End + Begin VB.Line lneTileEditGrid + Index = 11 + X1 = 128 + X2 = 0 + Y1 = 80 + Y2 = 80 + End + Begin VB.Line lneTileEditGrid + Index = 10 + X1 = 128 + X2 = 0 + Y1 = 64 + Y2 = 64 + End + Begin VB.Line lneTileEditGrid + Index = 9 + X1 = 128 + X2 = 0 + Y1 = 48 + Y2 = 48 + End + Begin VB.Line lneTileEditGrid + Index = 8 + X1 = 128 + X2 = 0 + Y1 = 32 + Y2 = 32 + End + Begin VB.Line lneTileEditGrid + Index = 7 + X1 = 128 + X2 = 0 + Y1 = 16 + Y2 = 16 + End + Begin VB.Line lneTileEditGrid + Index = 6 + X1 = 112 + X2 = 112 + Y1 = 0 + Y2 = 128 + End + Begin VB.Line lneTileEditGrid + Index = 5 + X1 = 96 + X2 = 96 + Y1 = 0 + Y2 = 128 + End + Begin VB.Line lneTileEditGrid + Index = 4 + X1 = 80 + X2 = 80 + Y1 = 0 + Y2 = 128 + End + Begin VB.Line lneTileEditGrid + Index = 3 + X1 = 64 + X2 = 64 + Y1 = 0 + Y2 = 128 + End + Begin VB.Line lneTileEditGrid + Index = 2 + X1 = 48 + X2 = 48 + Y1 = 0 + Y2 = 128 + End + Begin VB.Line lneTileEditGrid + Index = 1 + X1 = 32 + X2 = 32 + Y1 = 0 + Y2 = 128 + End + Begin VB.Line lneTileEditGrid + Index = 0 + X1 = 16 + X2 = 16 + Y1 = 0 + Y2 = 128 + End + Begin VB.Shape shpCanvasBorder + Height = 1920 + Left = 0 + Top = 0 + Width = 1920 + End + End + Begin VB.PictureBox picViewSprite + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H80000005& + BorderStyle = 0 'None + ForeColor = &H80000008& + Height = 1680 + Left = 120 + MouseIcon = "frmOverworldEditor.frx":2823 + MousePointer = 99 'Custom + ScaleHeight = 112 + ScaleMode = 3 'Pixel + ScaleWidth = 72 + TabIndex = 0 + Top = 120 + Width = 1080 + Begin VB.Shape shpSelectedTile + BorderColor = &H000000FF& + Height = 240 + Left = 0 + Top = 0 + Width = 240 + End + End + Begin VB.PictureBox picSelectedColor + Appearance = 0 'Flat + BackColor = &H80000005& + ForeColor = &H80000008& + Height = 495 + Left = 5880 + ScaleHeight = 465 + ScaleWidth = 1185 + TabIndex = 1 + Top = 5160 + Width = 1215 + Begin VB.Label lblPaletteIndex + Alignment = 2 'Center + BackColor = &H00FFFFFF& + Caption = "Index: 00" + BeginProperty Font + Name = "Tahoma" + Size = 6.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 240 + Left = 0 + TabIndex = 15 + Top = 255 + Width = 1215 + End + End + Begin VB.Label lblCurrentGame + Height = 255 + Left = 120 + TabIndex = 14 + Top = 2280 + Width = 5535 + End + Begin VB.Label lblMouseOverColor + Caption = "Mouse-over" + Height = 255 + Left = 7200 + TabIndex = 13 + Top = 4920 + Width = 1215 + End + Begin VB.Label lblTransformationOptions + Caption = "Transformation Options" + Height = 255 + Left = 5880 + TabIndex = 11 + Top = 5760 + Width = 2535 + End + Begin VB.Label lblSelectedColor + Caption = "Selected Color" + Height = 255 + Left = 5880 + TabIndex = 10 + Top = 4920 + Width = 1215 + End + Begin VB.Label lblDrawingCanvas + Caption = "Drawing Canvas" + Height = 255 + Left = 5880 + TabIndex = 9 + Top = 2640 + Width = 1935 + End + Begin VB.Label lblPallete + Caption = "Pallete" + Height = 255 + Left = 7920 + TabIndex = 8 + Top = 2640 + Width = 735 + End + Begin VB.Menu mnuFile + Caption = "File" + Begin VB.Menu mnuOpen + Caption = "Open..." + End + Begin VB.Menu mnuSave + Caption = "Save" + End + Begin VB.Menu mnuSeperator1 + Caption = "-" + End + Begin VB.Menu mnuImportBitmap + Caption = "Import Bitmap..." + End + Begin VB.Menu mnuExportBitmap + Caption = "Export Bitmap..." + End + Begin VB.Menu mnuSeperator2 + Caption = "-" + End + Begin VB.Menu mnuExit + Caption = "Exit" + End + End + Begin VB.Menu mnuTools + Caption = "Tools" + Begin VB.Menu mnuShowGridlines + Caption = "Show Gridlines" + Checked = -1 'True + End + End + Begin VB.Menu mnuHelp + Caption = "Help" + Begin VB.Menu mnuAbout + Caption = "About..." + End + End +End +Attribute VB_Name = "frmOverworldEditor" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Private m_lngSpritePalleteHeaders As Long +Private m_lngSpriteBank As Long +Private m_lngSpriteMax As Long +Private m_lngGraphicWidthBlocks As Long +Private m_lngGraphicHeightBlocks As Long +Private m_lngGraphicStartOffset As Long +Private m_strCurrentROM As String +Private m_lngCurrentMouseX As Long +Private m_lngCurrentMouseY As Long +Private m_lngPaletteCurrentMouseX As Long +Private m_lngPaletteCurrentMouseY As Long +Private m_lngEditCurrentMouseX As Long +Private m_lngEditCurrentMouseY As Long +Private m_lngCurrentTile As Long +Private m_lngSelectedPaletteEntry As Byte +Private m_blnStartColorDrag As Boolean +Private m_blnROMOpened As Boolean + +Dim Buffer() As Long +Dim EditBuffer() As Byte +Dim Data1 As Byte, Data2 As Byte +Dim Data3 As Byte, Data4 As Byte +Dim iFreeFile As Integer +Dim i As Integer +Dim X As Integer, Y As Integer +Dim PaletteData(0 To 15) As Integer +Dim PaletteData2(0 To 15) As Long +Dim XLine As Long, YLine As Long + +Private Sub cmdGo_Click() + If Val(txtSpriteIndex.Text) >= 0 And Val(txtSpriteIndex.Text) <= m_lngSpriteMax Then + LoadSpriteStructure Val(txtSpriteIndex.Text), Val(txtSpriteFrame.Text) + End If +End Sub + +Private Sub cmdIndexBack_Click() + If Val(txtSpriteIndex.Text) > 0 Then txtSpriteIndex.Text = txtSpriteIndex.Text - 1 + txtSpriteFrame.Text = 0 + LoadSpriteStructure Val(txtSpriteIndex.Text), Val(txtSpriteFrame.Text) +End Sub + +Private Sub cmdIndexForward_Click() + If Val(txtSpriteIndex.Text) < m_lngSpriteMax Then txtSpriteIndex.Text = txtSpriteIndex.Text + 1 + txtSpriteFrame.Text = 0 + LoadSpriteStructure Val(txtSpriteIndex.Text), Val(txtSpriteFrame.Text) +End Sub + +Private Sub cmdSpriteFrameBackwards_Click() + If Val(txtSpriteFrame.Text) > 0 Then txtSpriteFrame.Text = txtSpriteFrame.Text - 1 + LoadSpriteStructure Val(txtSpriteIndex.Text), Val(txtSpriteFrame.Text) +End Sub + +Private Sub cmdSpriteFrameForward_Click() + If Val(txtSpriteFrame.Text) < 255 Then txtSpriteFrame.Text = txtSpriteFrame.Text + 1 + LoadSpriteStructure Val(txtSpriteIndex.Text), Val(txtSpriteFrame.Text) +End Sub + +Private Sub Form_Load() + ToggleEditing False +End Sub + +Private Sub mnuAbout_Click() + frmAbout.Show +End Sub + +Private Sub mnuExit_Click() + Unload Me +End Sub + +Private Sub mnuExportBitmap_Click() + 'Dim bmpHeader As BITMAPINFOHEADER + Dim bmpFileHeader As BITMAPFILEHEADER + Dim bmpInfoHeader As BITMAPINFOHEADER + Dim bytCurrentRow() As Byte + Dim bytTempBuffer() As Byte + Dim bytTempBuffer2() As Byte + Dim lngCurrentPosition As Long + Dim lWidth As Long, lHeight As Long + lWidth = (m_lngGraphicWidthBlocks * 8) + lHeight = (m_lngGraphicHeightBlocks * 8) + + ReDim bytTempBuffer(((m_lngGraphicWidthBlocks * 8) * (m_lngGraphicHeightBlocks * 8)) - 1) + ReDim bytTempBuffer2((((m_lngGraphicWidthBlocks * 8) * (m_lngGraphicHeightBlocks * 8)) / 2) - 1) + + bmpFileHeader.bfType = 19778 'BM + bmpFileHeader.bfSize = 118 + (((m_lngGraphicWidthBlocks * 8) * (m_lngGraphicHeightBlocks * 8)) \ 2) + bmpFileHeader.bfOffBits = 118 + + bmpInfoHeader.biSize = 40 + bmpInfoHeader.biWidth = m_lngGraphicWidthBlocks * 8 + bmpInfoHeader.biHeight = m_lngGraphicHeightBlocks * 8 + bmpInfoHeader.biPlanes = 1 + bmpInfoHeader.biCompression = 0 + bmpInfoHeader.biSizeImage = ((m_lngGraphicWidthBlocks * 8) * (m_lngGraphicHeightBlocks * 8)) \ 2 + bmpInfoHeader.biXPelsPerMeter = 0 + bmpInfoHeader.biYPelsPerMeter = 0 + bmpInfoHeader.biBitCount = 4 + bmpInfoHeader.biClrUsed = 0 + bmpInfoHeader.biClrImportant = 0 + + For YLine = 0 To m_lngGraphicHeightBlocks - 1 + For XLine = 0 To m_lngGraphicWidthBlocks - 1 + For Y = 0 To 7 + For X = 0 To 7 + bytTempBuffer((((XLine * 8) + X) + ((YLine * 8) + Y) * (m_lngGraphicWidthBlocks * 8))) = EditBuffer(lngCurrentPosition + X) + Next X + lngCurrentPosition = lngCurrentPosition + 8 + Next Y + Next XLine + Next YLine + + lngCurrentPosition = 0 + For i = 0 To UBound(bytTempBuffer) Step 2 + bytTempBuffer2(lngCurrentPosition) = (bytTempBuffer(i + 1) * 16) Or bytTempBuffer(i) + Next i + + + Open App.Path & "\Dump.bmp" For Binary As #1 + Put #1, , bmpFileHeader + Put #1, , bmpInfoHeader + Put #1, , PaletteData2 + Put #1, , bytTempBuffer2 + Close #1 +End Sub + +Private Sub mnuOpen_Click() + Dim oOpenDialog As New clsCommonDialog + Dim sResult As String + Dim sGameCode As String * 4 + sResult = oOpenDialog.ShowOpen(Me.hWnd, "Open ROM Image...", , "GameBoy Advance ROM's (*.gba)|*.gba|", FILEMUSTEXIST Or PATHMUSTEXIST) + If Len(sResult) > 0 Then + m_strCurrentROM = sResult + If FileExists(m_strCurrentROM) Then + m_blnROMOpened = True + iFreeFile = FreeFile + Open m_strCurrentROM For Binary As #iFreeFile + Seek #iFreeFile, &HAD& + Get #iFreeFile, , sGameCode + If Len(ReadINI(sGameCode, "Name", App.Path & "\Sprites.ini")) > 0 Then + lblCurrentGame.Caption = sGameCode & " - " & ReadINI(sGameCode, "Name", App.Path & "\Sprites.ini") + m_lngSpriteBank = Val(ReadINI(sGameCode, "SpriteBank", App.Path & "\Sprites.ini")) + 1 + m_lngSpritePalleteHeaders = Val(ReadINI(sGameCode, "SpritePalleteHeaders", App.Path & "\Sprites.ini")) + 1 + m_lngSpriteMax = Val(ReadINI(sGameCode, "SpriteCount", App.Path & "\Sprites.ini")) + If m_lngSpriteBank = 1 Or m_lngSpritePalleteHeaders = 1 Then + MsgBox "Error Loading INI Settings for this game...", vbExclamation, "Error" + Exit Sub + End If + Else + MsgBox "Error Loading INI Settings for this game...", vbExclamation, "Error" + Exit Sub + End If + Close #iFreeFile + + txtSpriteFrame.Text = 0 + txtSpriteIndex.Text = 0 + + LoadSpriteStructure Val(txtSpriteIndex.Text), Val(txtSpriteFrame.Text) + ToggleEditing True + End If + End If +End Sub + +Private Sub mnuSave_Click() + + SaveSprite m_strCurrentROM, m_lngGraphicStartOffset, m_lngGraphicHeightBlocks, m_lngGraphicWidthBlocks + +End Sub + +Private Sub mnuShowGridlines_Click() + mnuShowGridlines.Checked = Not mnuShowGridlines.Checked + For i = 0 To lnePalleteGrid.UBound + lnePalleteGrid(i).Visible = mnuShowGridlines.Checked + Next i + For i = 0 To lneTileEditGrid.UBound + lneTileEditGrid(i).Visible = mnuShowGridlines.Checked + Next i + shpCanvasBorder.Visible = mnuShowGridlines.Checked + shpPalleteBorder.Visible = mnuShowGridlines.Checked +End Sub + +Private Sub picEditTile_Click() + EditBuffer((m_lngCurrentTile * 64) + (m_lngEditCurrentMouseX + m_lngEditCurrentMouseY * 8)) = m_lngSelectedPaletteEntry + Call DrawTileEdit +End Sub + +Private Sub picEditTile_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + If X + 1 > picEditTile.Width Or Y + 1 > picEditTile.Height Or X < 0 Or Y < 0 Then Exit Sub + 'Make sure its left click + If Button = 1 Then + EditBuffer((m_lngCurrentTile * 64) + (m_lngEditCurrentMouseX + m_lngEditCurrentMouseY * 8)) = m_lngSelectedPaletteEntry + Call DrawTileEdit + m_blnStartColorDrag = True + End If +End Sub + +Private Sub picEditTile_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + picMouseOverColor.BackColor = Colour15To24RGB(PaletteData(EditBuffer((m_lngCurrentTile * 64) + (m_lngEditCurrentMouseX + m_lngEditCurrentMouseY * 8)))) + If Fix(X \ 16) = m_lngEditCurrentMouseX And m_lngEditCurrentMouseY = Fix(Y \ 16) Then Exit Sub + m_lngEditCurrentMouseX = Fix(X \ 16) + m_lngEditCurrentMouseY = Fix(Y \ 16) + If m_blnStartColorDrag = True Then + If X + 1 > picEditTile.Width Or Y + 1 > picEditTile.Height Or X < 0 Or Y < 0 Then Exit Sub + EditBuffer((m_lngCurrentTile * 64) + (m_lngEditCurrentMouseX + m_lngEditCurrentMouseY * 8)) = m_lngSelectedPaletteEntry + Call DrawTileEdit + Call DrawSpriteView + End If +End Sub + +Private Sub picEditTile_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + If Len(m_strCurrentROM) <= 0 Or m_blnROMOpened = False Then Exit Sub + If Button = 1 Then + m_blnStartColorDrag = False + If X + 1 > picEditTile.Width Or Y + 1 > picEditTile.Height Or X < 0 Or Y < 0 Then Exit Sub + EditBuffer((m_lngCurrentTile * 64) + (m_lngEditCurrentMouseX + m_lngEditCurrentMouseY * 8)) = m_lngSelectedPaletteEntry + Call DrawTileEdit + Call DrawSpriteView + End If + If Button = 2 Then + If X + 1 > picEditTile.Width Or Y + 1 > picEditTile.Height Or X < 0 Or Y < 0 Then Exit Sub + m_lngSelectedPaletteEntry = EditBuffer((m_lngCurrentTile * 64) + (m_lngEditCurrentMouseX + m_lngEditCurrentMouseY * 8)) + picSelectedColor.BackColor = Colour15To24RGB(PaletteData(m_lngSelectedPaletteEntry)) + lblPaletteIndex.Caption = "Index: " & Right("00" & Hex(m_lngSelectedPaletteEntry), 2) + Exit Sub + End If +End Sub + +Private Sub picSelectPalette_Click() + m_lngSelectedPaletteEntry = m_lngPaletteCurrentMouseX + (m_lngPaletteCurrentMouseY * 2) + picSelectedColor.BackColor = Colour15To24RGB(PaletteData(m_lngSelectedPaletteEntry)) + lblPaletteIndex.Caption = "Index: " & Right("00" & Hex(m_lngSelectedPaletteEntry), 2) +End Sub + +Private Sub picSelectPalette_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + m_lngPaletteCurrentMouseX = Fix(X \ 16) + m_lngPaletteCurrentMouseY = Fix(Y \ 16) + picMouseOverColor.BackColor = Colour15To24RGB(PaletteData(m_lngPaletteCurrentMouseX + (m_lngPaletteCurrentMouseY * 2))) +End Sub + +Private Sub picViewSprite_Click() + m_lngCurrentTile = m_lngCurrentMouseX + (m_lngCurrentMouseY * m_lngGraphicWidthBlocks) + shpSelectedTile.Top = m_lngCurrentMouseY * 16 + shpSelectedTile.Left = m_lngCurrentMouseX * 16 + Call DrawTileEdit +End Sub + +Private Sub picViewSprite_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + m_lngCurrentMouseX = Fix(X \ 16) + m_lngCurrentMouseY = Fix(Y \ 16) +End Sub + +Private Sub LoadSprite(FilePath As String, SpriteOffset As Long, PaletteOffset As Long, Height As Long, Width As Long) + 'Set the global image properties + m_lngGraphicHeightBlocks = Height + m_lngGraphicWidthBlocks = Width + 'Gets us a new file handle. + iFreeFile = FreeFile + 'Current position in decoding + Dim lngCurrentPosition As Long + 'Resizes the buffers for the required space. + ReDim Buffer(0 To ((m_lngGraphicHeightBlocks * 8) * (m_lngGraphicWidthBlocks * 8))) + ReDim EditBuffer(0 To ((m_lngGraphicHeightBlocks * 8) * (m_lngGraphicWidthBlocks * 8))) + 'Resize the Sprite View (Double-Size mode!) + picViewSprite.Width = (m_lngGraphicWidthBlocks * 8) * 2 + picViewSprite.Height = (m_lngGraphicHeightBlocks * 8) * 2 + 'Reset current tile + m_lngCurrentTile = 0 + shpSelectedTile.Top = 0 + shpSelectedTile.Left = 0 + 'Set offsets + m_lngGraphicStartOffset = SpriteOffset + 'Opens the ROM + Open FilePath For Binary As #iFreeFile + 'Goto the offset of the Palette + Seek #iFreeFile, PaletteOffset + 'Load the Palette up + Get #iFreeFile, , PaletteData + 'Goto offset of sprite + Seek #iFreeFile, SpriteOffset + 'The Y-Line is the row of blocks we are reading + For YLine = 0 To m_lngGraphicHeightBlocks - 1 + 'The X-Line is the column of blocks we are reading + For XLine = 0 To m_lngGraphicWidthBlocks - 1 + For Y = 0 To 7 + 'We are reading the data in chunks of DWORD's! HOW EFFECIENT OF ME! + 'I MUST BE GAWD! + Get #iFreeFile, , Data1 + Get #iFreeFile, , Data2 + Get #iFreeFile, , Data3 + Get #iFreeFile, , Data4 + '4BPP graphics are 4-bits per pixel, so 4 bytes is 8 pixels or 1 row. + 'they are in reverse order. XXXXRRRR + 'RRRR = First Pixel + 'XXXX = Second Pixel + 'Below ...that could probely be shortend to a loop. + EditBuffer(lngCurrentPosition + 0) = (Data1 And &HF) 'High Nibble + EditBuffer(lngCurrentPosition + 1) = (Data1 \ 16) 'Low Nibble + EditBuffer(lngCurrentPosition + 2) = (Data2 And &HF) 'High Nibble + EditBuffer(lngCurrentPosition + 3) = (Data2 \ 16) 'Low Nibble + EditBuffer(lngCurrentPosition + 4) = (Data3 And &HF) 'High Nibble + EditBuffer(lngCurrentPosition + 5) = (Data3 \ 16) 'Low Nibble + EditBuffer(lngCurrentPosition + 6) = (Data4 And &HF) 'High Nibble + EditBuffer(lngCurrentPosition + 7) = (Data4 \ 16) 'Low Nibble + 'Increase current position by 8 + lngCurrentPosition = lngCurrentPosition + 8 + Next Y + Next XLine + Next YLine + Close #iFreeFile +End Sub + +Private Sub SaveSprite(FilePath As String, SpriteOffset As Long, Height As Long, Width As Long) + 'Current position in decoding + Dim lngCurrentPosition As Long + Dim bytTempBuffer() As Byte + On Error GoTo ErrSaveSprite + ReDim bytTempBuffer((UBound(EditBuffer) \ 2) - 1) + 'Make sure file is open + If Len(m_strCurrentROM) <= 0 Or m_blnROMOpened = False Then Exit Sub + 'Gets us a new file handle. + iFreeFile = FreeFile + 'Opens the ROM + Open m_strCurrentROM For Binary As #iFreeFile + 'Goto offset of sprite + Seek #iFreeFile, SpriteOffset + For i = 0 To UBound(EditBuffer) - 1 Step 2 + bytTempBuffer(lngCurrentPosition) = EditBuffer(i) Or (EditBuffer(i + 1) * 16) + lngCurrentPosition = lngCurrentPosition + 1 + Next i + Put #iFreeFile, , bytTempBuffer + Close #iFreeFile + + On Error GoTo 0 + Exit Sub + +ErrSaveSprite: + + MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure SaveSprite of frmOverworldEditor", vbCritical + + +End Sub + +Private Sub DrawPalette() + 'Display Palette + For i = 0 To 15 + PaletteData2(i) = Colour15To24(PaletteData(i)) + Next i + Blit32 PaletteData2, picSelectPalette, 2, 8 + picSelectPalette.Refresh +End Sub + +Private Sub DrawTileEdit() + Dim lngTempBuffer(0 To 63) As Long + Dim i As Integer + For Y = 0 To 7 + For X = 0 To 7 + lngTempBuffer(X + Y * 8) = Colour15To24(PaletteData(EditBuffer((m_lngCurrentTile * 64) + (X + Y * 8)))) + Next X + Next Y + Blit32 lngTempBuffer, picEditTile, 8, 8 + picEditTile.Refresh +End Sub + +Private Sub DrawSpriteView() + Dim lngCurrentPosition As Long + For YLine = 0 To m_lngGraphicHeightBlocks - 1 + For XLine = 0 To m_lngGraphicWidthBlocks - 1 + For Y = 0 To 7 + For X = 0 To 7 + Buffer((((XLine * 8) + X) + ((YLine * 8) + Y) * (m_lngGraphicWidthBlocks * 8))) = Colour15To24(PaletteData(EditBuffer(lngCurrentPosition + X))) + Next X + lngCurrentPosition = lngCurrentPosition + 8 + Next Y + Next XLine + Next YLine + Blit32 Buffer, picViewSprite, m_lngGraphicWidthBlocks * 8, m_lngGraphicHeightBlocks * 8 + picViewSprite.Refresh +End Sub + +Private Sub LoadSpriteStructure(Index As Integer, Frame As Integer) + + Dim PrimarySpriteHeader As SpriteHeader + Dim SecondarySpriteHeader As SpriteHeader2 + Dim PalleteHeaders(0 To 26) As PalleteHeader + Dim j As Integer + On Error GoTo ErrLoadSpriteStructure + + iFreeFile = FreeFile + + 'Make sure the ROM is Open + If Len(m_strCurrentROM) <= 0 Or m_blnROMOpened = False Then Exit Sub + + Open m_strCurrentROM For Binary As #iFreeFile + '217 sprites + 'Seek #iFreeFile, &H3718D5 + (36 * Index) + Seek #iFreeFile, m_lngSpriteBank + (36 * Index) + Get #iFreeFile, , PrimarySpriteHeader + + lblSpriteNumber.Caption = "Sprite #: " & Index + lblStarterBytes.Caption = "Starter Bytes: " & Right("0000" & Hex(PrimarySpriteHeader.StarterBytes), 4) + lblPalleteNumber.Caption = "Pallete #: " & Right("00" & Hex(PrimarySpriteHeader.PalleteModifier), 2) + lblUnknownData.Caption = "Unknown Data: " & Right("00" & Hex(PrimarySpriteHeader.Unknown1(0)), 2) & " " & _ + Right("00" & Hex(PrimarySpriteHeader.Unknown1(1)), 2) & " " & _ + Right("00" & Hex(PrimarySpriteHeader.Unknown1(2)), 2) + lblSpriteDataSize.Caption = "Sprite Data Size: " & Right("0000" & Hex(PrimarySpriteHeader.SpriteDataSize), 4) + lblSpriteWidth.Caption = "Width: " & PrimarySpriteHeader.Width + lblSpriteHeight.Caption = "Height: " & PrimarySpriteHeader.Height + lblUnknownData2.Caption = "Unknown Data 2: " & Right("00" & Hex(PrimarySpriteHeader.Unknown2), 2) & " " & Right("00" & Hex(PrimarySpriteHeader.Unknown3), 2) & " " & Right("0000" & Hex(PrimarySpriteHeader.Unknown4), 4) + lblSpritePointer.Caption = "Sprite Pointer: " & Right("00000000" & Hex(PrimarySpriteHeader.SpriteHeader2Pointer), 8) + lblUnknownPointer1.Caption = "Unknown Pointer 1: " & Right("00000000" & Hex(PrimarySpriteHeader.Pointer1), 8) + lblUnknownPointer2.Caption = "Unknown Pointer 2: " & Right("00000000" & Hex(PrimarySpriteHeader.Pointer2), 8) + lblUnknownPointer3.Caption = "Unknown Pointer 3: " & Right("00000000" & Hex(PrimarySpriteHeader.Pointer3), 8) + lblUnknownPointer4.Caption = "Unknown Pointer 4: " & Right("00000000" & Hex(PrimarySpriteHeader.Pointer5), 8) + + + Seek #iFreeFile, (PrimarySpriteHeader.SpriteHeader2Pointer - &H8000000) + 1 + (8 * Frame) + Get #iFreeFile, , SecondarySpriteHeader + + lblSpritePointerHdr2.Caption = "Sprite Pointer: " & Right("00000000" & Hex(SecondarySpriteHeader.SpritePointer), 8) + lblSpriteDataSizeHdr2.Caption = "Data Size: " & Right("0000" & Hex(SecondarySpriteHeader.SpriteDataSize), 4) + lblUnknownHdr2.Caption = "Unknown 1: " & Right("0000" & Hex(SecondarySpriteHeader.Unknown), 4) + + Seek #iFreeFile, m_lngSpritePalleteHeaders + Get #iFreeFile, , PalleteHeaders + + Close #iFreeFile + + For i = 0 To UBound(PalleteHeaders) + If PalleteHeaders(i).Index = PrimarySpriteHeader.PalleteModifier Then + j = i + Exit For + End If + Next i + + Call LoadSprite(m_strCurrentROM, (SecondarySpriteHeader.SpritePointer - &H8000000) + 1, (PalleteHeaders(j).DataPointer - &H8000000) + 1, PrimarySpriteHeader.Height / 8, PrimarySpriteHeader.Width / 8) + Call DrawSpriteView + Call DrawTileEdit + Call DrawPalette + + On Error GoTo 0 + Exit Sub + +ErrLoadSpriteStructure: + + MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure LoadSpriteStructure of frmOverworldEditor", vbCritical, "Error" + +End Sub + + +Private Sub ToggleEditing(blnEnable As Boolean) + picEditTile.Enabled = blnEnable + picSelectPalette.Enabled = blnEnable + picViewSprite.Enabled = blnEnable + cmdGo.Enabled = blnEnable + cmdIndexBack.Enabled = blnEnable + cmdIndexForward.Enabled = blnEnable + cmdSpriteFrameBackwards.Enabled = blnEnable + cmdSpriteFrameForward.Enabled = blnEnable + txtSpriteFrame.Enabled = blnEnable + txtSpriteIndex.Enabled = blnEnable +End Sub diff --git a/frmOverworldEditor.frx b/frmOverworldEditor.frx new file mode 100644 index 0000000..91399e6 Binary files /dev/null and b/frmOverworldEditor.frx differ diff --git a/modGraphicEditing.bas b/modGraphicEditing.bas new file mode 100644 index 0000000..5fc63ab --- /dev/null +++ b/modGraphicEditing.bas @@ -0,0 +1,158 @@ +Attribute VB_Name = "modGraphicEditing" +Option Explicit + +Public Type SpriteHeader + StarterBytes As Integer + PalleteModifier As Byte + Unknown1(2) As Byte + SpriteDataSize As Integer + Width As Integer + Height As Integer + Unknown2 As Byte + Unknown3 As Byte + Unknown4 As Integer + Pointer1 As Long + Pointer2 As Long + Pointer3 As Long + SpriteHeader2Pointer As Long + Pointer5 As Long +End Type + +Public Type SpriteHeader2 + SpritePointer As Long + SpriteDataSize As Integer + Unknown As Integer +End Type + +Public Type PalleteHeader + DataPointer As Long + Index As Byte + UnknownData(2) As Byte +End Type + + +Public Type BITMAPINFOHEADER + biSize As Long + biWidth As Long + biHeight As Long + biPlanes As Integer + biBitCount As Integer + biCompression As Long + biSizeImage As Long + biXPelsPerMeter As Long + biYPelsPerMeter As Long + biClrUsed As Long + biClrImportant As Long +End Type + +Public Type BITMAPINFO + bmiHeader As BITMAPINFOHEADER + bmiColor0 As Long + bmiColor1 As Long + bmiColor2 As Long +End Type + +Public Type BITMAPFILEHEADER + bfType As Integer + bfSize As Long + bfReserved1 As Integer + bfReserved2 As Integer + bfOffBits As Long +End Type + +Public Type BITMAPV4HEADER + bV4Size As Long + bV4Width As Long + bV4Height As Long + bV4Planes As Integer + bV4BitCount As Integer + bV4V4Compression As Long + bV4SizeImage As Long + bV4XPelsPerMeter As Long + bV4YPelsPerMeter As Long + bV4ClrUsed As Long + bV4ClrImportant As Long + bV4RedMask As Long + bV4GreenMask As Long + bV4BlueMask As Long + bV4AlphaMask As Long + bV4CSType As Long + bV4Endpoints As Long + bV4GammaRed As Long + bV4GammaGreen As Long + bV4GammaBlue As Long +End Type + + +Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long +Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As Any, ByVal lpFileName As String) As Long +Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long +Public Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long +Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long + +Public Function ReadINI(ByVal Section As String, ByVal KeyName As String, ByVal FileName As String) As String + Dim sRet As String + sRet = String(256, Chr(0)) + ReadINI = Left(sRet, GetPrivateProfileString(Section, ByVal KeyName, "", sRet, Len(sRet), FileName)) +End Function + +Public Function WriteINI(sSection As String, sKeyName As String, sNewString As String, sFileName) As Integer + Call WritePrivateProfileString(sSection, sKeyName, sNewString, sFileName) +End Function + + +Public Sub Blit32(Buffer() As Long, ByRef pic As PictureBox, imagewidth As Long, imageheight As Long) + If imagewidth = 0 Or imageheight = 0 Then Exit Sub + Dim bi As BITMAPINFO + With bi.bmiHeader + .biWidth = imagewidth + .biHeight = -imageheight + .biSize = 40 + .biBitCount = 32 + .biPlanes = 1 + End With + If pic.ScaleMode <> 3 Then pic.ScaleMode = 3 + StretchDIBits pic.hdc, 0, 0, pic.ScaleWidth, pic.ScaleHeight, 0, 0, imagewidth, imageheight, Buffer(0), bi, 0, vbSrcCopy +End Sub + +Public Sub Blit15(Buffer() As Integer, ByRef pic As PictureBox, imagewidth As Long, imageheight As Long) + If imagewidth = 0 Or imageheight = 0 Then Exit Sub + Dim bi As BITMAPINFO + With bi.bmiHeader + .biWidth = imagewidth + .biHeight = -imageheight + .biSize = 40 + .biBitCount = 16 + .biPlanes = 1 + End With + If pic.ScaleMode <> 3 Then pic.ScaleMode = 3 + StretchDIBits pic.hdc, 0, 0, pic.ScaleWidth, pic.ScaleHeight, 0, 0, imagewidth, imageheight, Buffer(0), bi, 0, vbSrcCopy +End Sub + +Public Function Colour15To24(ByVal ColourData As Integer) As Long + Dim R As Byte, G As Byte, B As Byte + R = ((ColourData And 31) / 31) * &HFF + G = (((ColourData \ 32) And 31) / 31) * &HFF + B = (((ColourData \ 1024) And 31) / 31) * &HFF + Colour15To24 = CLng(B) + (256 * CLng(G)) + (65536 * CLng(R)) +End Function + +Public Function Colour15To24RGB(ByVal ColourData As Integer) As Long + Dim R As Byte, G As Byte, B As Byte + R = ((ColourData And 31) / 31) * &HFF + G = (((ColourData \ 32) And 31) / 31) * &HFF + B = (((ColourData \ 1024) And 31) / 31) * &HFF + Colour15To24RGB = CLng(R) + (256 * CLng(G)) + (65536 * CLng(B)) +End Function + +Public Function FileExists(sFileName As String) As Boolean + If Len(sFileName$) = 0 Then + FileExists = False + Exit Function + End If + If Len(Dir$(sFileName$)) Then + FileExists = True + Else + FileExists = False + End If +End Function