From a8856756f6be5b134770dbab1b69474dfd6bcd27 Mon Sep 17 00:00:00 2001 From: xeons Date: Thu, 10 Jul 2014 23:56:29 -0500 Subject: [PATCH] Initial commit --- OverworldEditor.vbp | 39 ++ OverworldEditor.vbw | 4 + README.md | 51 ++ Sprites.ini | 41 ++ clsCommonDialog.cls | 147 ++++++ frmAbout.frm | 117 +++++ frmAbout.frx | Bin 0 -> 11078 bytes frmOverworldEditor.frm | 1113 ++++++++++++++++++++++++++++++++++++++++ frmOverworldEditor.frx | Bin 0 -> 10613 bytes modGraphicEditing.bas | 158 ++++++ 10 files changed, 1670 insertions(+) create mode 100644 OverworldEditor.vbp create mode 100644 OverworldEditor.vbw create mode 100644 README.md create mode 100644 Sprites.ini create mode 100644 clsCommonDialog.cls create mode 100644 frmAbout.frm create mode 100644 frmAbout.frx create mode 100644 frmOverworldEditor.frm create mode 100644 frmOverworldEditor.frx create mode 100644 modGraphicEditing.bas 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 0000000000000000000000000000000000000000..16468a6a99587781aae0288867a8f225004e6e90 GIT binary patch literal 11078 zcmeHLcT`lz8vn^QVnbs?BY15T1q7*z6j4x$h|&oPOIcXy3y3s>jo45zQQX*2P{4vp zG}Q=1^E7eg8IAE7qmM)r6H7#oiFyLw_sv~a*OYh8`}3W%19NBQ_m%n0ckh04?+hLU zq~`&BsRepK1dd~^G3t#07s5@C>nZ(2pA$@h``@QKuqN?gvQ$ZBNj`k zbZc~Dq-|_0l`;jfu~b4uYRp_POlxH~K}=F|KntY~lZ&J;6r>_SE@Eaf-9-qto?Lrx*ga(m6g%Pey-;B6SVS32Md;`=q{RyX)hbZr zS-2?#v~X60#W7U4P2C;6B{Fj@YD9s8mL>r@2P9`=!i|_a)-qSmGa~Cc9`sJZ?J)9i!X3;&2*$q8;xg8a@^V&f`{bePGtz16DEUxNEp@s zD1NODM{}t!a;A?2e<&WEdt=aba6aCSnt;nNg%NR6B@_SJSA&kV-b1yk|5-7o}A9Et_bW;mFKwFuFhco!6nzdkwx+ zSs>ntLx9B~Jg5r8uiL}HAD9P;(HvyBSK^~2I~Wabdo{MMn-uH~!yY(e_ z{J{#6`@v~sPXyU5fZupq1Y51gqjURk@%%OXUK2}mMxwJe7GG+3ap3T1%JsC2_6Gb|N0o*{b)CC9#~In3`N(jP~1GY9`}ydKrwYVJSRJ#DqDrc z!Kabn`2qG6Rl;qw74qEUaiMq`#en9kjY3yVG%ghRpfvalHf86)%+v*sZq;MqVhtLS zBJg2h6+A7j!of5jPUbQAB*~thF>kVu1z#6~<20^M3df3dmyj!;4jUV1)NCz9Qba3G zWT{Y_aRf!)1qiT|V$2{7wnZePHO&>5mj~l1-J8}l7i^1EVC;}{XjbK7eqbwhY$zmM z4*6M1?BCUZWd((3USEOf!xo_}dpyD|heEla1bYioaU`M-PADDdzPO_)sxNADlaZWQ zhzP5pI7hm^W`$_kP=TfSg*Z}o7zyEF=)<06o7=<9)LF06S|d^rqiibAAN&Z(NOa0sipuNJl~HJ@`7`$5iSE1_mG{Gz@Jmm*MN^1ov^{VQ+4RS18lY^qhn@OV+}H zGe=B4kEq%%MAvk|r|1IC1eYQwdlOtt%}{^q5j2YzA|j~)RfQkos)Z-=O&y5A|6YD! zCigoYJm|R3dJowJX#ei}8^FyUe!O+-$De)%Zr{0kk6_KYwtt@g^1{WhE`9y=rOW@i z^3Bz6uU-E)-h2Op4?p_&_$MctTUuLNK0SHrvwxgE^Z6HNYijrGt*dX?xBtMw#>Rt( z4j*Z#uWNeu=&`pqZLZp)erM~p?K^^lcWmFb^Bwh;s_I?4SCqfGa@FcJYb(~R_w!r7 zu42QQ)vH!kZhWg?QDISWN$KJ@$|C*zB9|;(R$5YARJfc7r79PsrDtSjW#{B%t8(-5 z(-tTfGX992H$N_3o{$(BnV6KUNSQw`R)B#yb3?yavilSdPcJV|k16hxC%L(51$Gnc z9VR+DIlH(xJ2_5tu%BS3#m8D$T3L@9Z)0m~Gk%=4m8Hd40e@|{nfVBA{xB{;vYB_U~uXw@+{O+_55| zH@R1OvR=OSW z$j||k=ar3hmC0L7Nyn6QrkLOgb~ga#LY}lP`X$@IY5x9PMAxxWCQ=L9QySih38D)2rd* z6@VSJTd=mI3VRaPAyP&6{)Gce2642_Dp*j~N^D~cAw-N~8q znK_hka;#mn2<~2PnCZP13nMb(-030%}1tG$%le) z;-O(Y6oeCL4H;>Oi-x#ph=hhFq^YSAPKFv%(h#5_F7!{8{P2Vm7Y&Ptz{QbPt6(dp z`2e0c@Wg>94m@$-i36EXC7;BBCk{Mu&=3c5LzVQ215X@y;=mIJa!r+R;=mIJo;dJC zfT#I2_J>y9102wP+ne+&6_vl?AfzuYHGse%a?KO z+BMv`aRaw+-^POn5Afv46LkE}qqe#lWo2a)U0N*tlQV5YSL#w_;9r%Z;^LxiJUd4P z%J%tr3qgAWD9^JbpQ_spv?-qD_t*%w4^a9R(tA+gEdSuyA#-%e+tW+P?&Q=~$lF5V zwiV_O()Bp&@irFPDTO3WDSC`HZx0>DGB?ZC!-g^iZMuG*sJoMNcZw!C%gvOjd$HUs zIHZqFDIld!Okwyu8w;73g`m?5SlPc@sB0)!wva(P`CygxSuG>Hbs6y8o4{k*#{1GZ zM3t2wPe?E1@=}wzRJkfCIX92XmaFo(ECpf8TrOLcm7QWnwO;%;X|`T(kf8qrD~lgr)M*#xmg)(rp%;5 zZfb}>mnct9&$Z$F1^>h(nfc6+r%|gvdqNhuNmeM7iOS^6JdVt{{M=+ke!3m!uiy%^ z^0_2sQl=$I(ix#bE-jPM(|5rZkReY>CPTJ_2xV@*Jl#j0t4!ov?CiPF5NEr=hO=Vb zGh}ED5imsH|0Dv2vtoAQNauovvtl|QcwP)=#q60doE00+iVbJQhO=VBS+U`)*l<>C hI4d@s6&ucqg_BytSuvg88qSKfpG$_b;{SS9{2yqSy(j= 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 0000000000000000000000000000000000000000..91399e6c4372e5844a815d1dc05d773e0034ea8a GIT binary patch literal 10613 zcmeHM2~-r<(*9spS5Q#_MMvCF0YO$pU_eCN5EWSr>VP=nKH!4jHXtG@%3vZgYIN8H zT*#=H7-QlP%+titpP-3x{V|%DxJ1lvqMoSz>h^$QH0LDm{d!)~4|(F>sA&mX@Y*f(Y1c0XUEhsX$K1^cbjx zd}BJ9z3g)whr`ncgDaT~OJ+;T;q1p}aqZeQ4DQ$OrC@WfIRecQXpX=iMnFjL2By@M ze}qCYL4!mCjijYgv6u-6rD73*SjtQ=nn_D4mP*9tLI@=ykvV}#B%y&h@p&yNai!+w zLZL*+xD13ehq<{_EFlYwD`0v;G0)>qVkRmQ@DfsqNI(KY-nf8(u|z^*3&<6+PU?(L zWX5GcUB)K^Gy|_L64DeVrb&PZ%z%U(5U?JpzhpBDLgJDEx=`vczCip^KrG<-0>+2X z#HYwL3Q*U?H^rI+$X~HU(#V%EK3Q*E3ZYOS6bU3R^(6ukks8@-j@RdJ!X>`w75C`^ zM8D_1B0wQ*%4gAO8UQwGD!}u}g$Ce*-Gpyi8@8rQfMUll-%A1J9g8R<6Y!m;9@540 z0W}Fw`p09eoicRbQ zdX^z{A#8k3(KWr8CSH&@asnN2YEb~rEFFfz@hltH%mbfyo)=I-d-z7EIchvMtx0KDaFi!p<2Fx$fpr<3G3mo@@D+p&FK ziWK<;7j8rJUCf~ zas6`;?PU#Z+-@w7JPxN$E-0Vvk8@{#!1=Qm@LOpdxS~irqj{c{#i8cpd7M3Q1LgDN zq}Q3QU5a_byWz*3GttlHF1WA!5a-(gWpDMu-J^xLxi5#VaUz}-OvKIoIkPT?fsEcW`i5E{-pn zgjTe#+y*%!DQO-?J62$&d?7xHv&R^x_n?|P8_xY4(39?yLmk}Wo}0KjsmnI zTR!~;AlSnLHJ@FCazZ#pj~aOmxQF2$_Ypw-(W6IU=EQKEHC(`OH+T5-9{`tb zc4$GFHpFi*)-KP6tE?L)mvM+Heun6xX9!HK#i`I0NK|csr?nl*Zasu?>(eH;@rBa@6QCV}nCOgU5~;7dA4akuDDi92PV@c*Ka{;X%U!1LO^KFYm!ae1`h^ z`TP6%4)qx_*xSp*a31L5I>^o4!_(8l-EEMo%Rpxny?39!4*mKMaCCBV9MHd?L*G8V zd3u+wcHO$mdf4~u)vKp{4_Wtac3r#hj1E>EJ9W0Uu?1{xtUGt=Xhms>L95nn+FDq) zYY((1`FF%Z#{T#J^h*RlmY&(Rxh1H5>`p|McVNTs$(0cq&6+QHr8@F?v* zs_CbGy}Xg084UEUT?Yy3VetalxDgrOU`;aCBs0_kPq`u#r`-Omu)?<|+6w2wkhTnOPm-aOYGQ7TE4EE^hQMqzq6corr?VU|)XoaWRK9q$ zGXj0BlA)hE3Rg1yz)>AzwL?E`6dZ`&M${MkXC{C`zEQl=mnM z?H-PGu}S#$;x#-hj>q$&N%*BC9@lCwBTJD4U*fxW1=d9l#71QmvS+xUIAH|toH&dp z1(bs+53*c%yQ&gJM9)^bVB^ecWK8Uj6)Q538?VLs=t_+7PQq;W;rMBzFP@c7qxuz% z`C*Ef(2Jm%_*28zJ&+EQ$CWLwvolVR15M#VFup*99%< z7Vz?rL&>=jY6*=ng6=^&YqfyZO$*bH#&oY}-Q1{EQp?61v`V5WiRMN$B}poY?nZPi z(TJ%fBU&x9MKmMH8fhLQ(Tzkm65U92j_5SMmeI)vE%~6Odym9v4mWC*%o{>FyHN@x zAB;4gk$f|fA4ZywR0+w3lIY}zk@=w{Iyr45B_sJ_Bwvi=gpnqssR@ZribfJL62VBm z&_PIcIHHp;Mivj=7dN_ECA(sp58%iLj(p(A2abH;$Olp(B%9;|M?P@mgOPk7GlV2h zK5*m%M?P@m1DPfyI{Cnn4;=ZxkpmpfZzN+JDRLyFBpXT^D_L&fZ8I4qdY}Z;rcFa~ zaxyYAGm)2?x*p)+*}8Szb!x@=i$16`Gv1j_b{7cBwR22h@7Nj{;m8kkZ%%kMD}tPW86=F|I_ z(PKx3jtd*#n7sY``RqE4)k7-IiNmGjMWy;$&wk&hAY;9}9 z1Wf7rMWSv<(hVt^_$)V5rf$V@GjEVyHpPILUNQOMi)_qiVitm@{yoZgny=paZeJ${a%J@u@XJ1CAQ9EK}u=n6t5hOUoTVYZD)6nCIkW8Dwk*P8p z5Vm$Xg+65ul^;9h$%XJqAO@RCLG9l?RU69;8}*J~mD&gU!!6DJy>tB=Ls&>F$U?Y{ zT2lzy($nN4DvdIgJWLT5MTaU(p;9EM6_dc8q^#BikYqCsC%b?}mb;8YDkZEY>x0L{=G zfxj^VrtH(jlzrHqfHWCiQme-Sx(&914)e3B0u&oMw3HNT>cT$D&T>@+S(ce+uE}zk zZ)KT~9-P^}h1(^WEUbD%M~n7_`gVcx(VcqAbTL`OGS3E^kLg49rBC$GHYGLOsd~65^%%E?) z!YCUQoZc#&QkhWjX@_$dQYxk-85LbJFAkED&KFYO_cv5NJQltg07D;0A zRC-yOS$;1o`f~(6l@0rI-;4ceiPrr7bWw%5utF*e(S&)c6>^OtM574Pu;Lk_OPEli z3ZdeuOO7r{jx9+}s9dY6R7V+1m2+)!bwka}*HgjVQhaDjaV1sFf{J716_t9vc;;nR z=cRu^HM3+>ZAo6OuFOzgezCm#l1^_ZsjRNtSF7K9=JyT%w#mISg*S6~9x%9EDdaZPy)HWlbU4Z)X2lHJOBDoH$rL3+V zZrHc`oA>R1`c7${|Nm12-mq`ivwiCjb`t5*0q3J+Ds{D)Py2{0ja-pqHdN6yC?PK0 zEW_2aeYW9S1a`3(ZPTDo9h4qmU$#`P3tZoM;J6UkbzPs9t!?MatnA+oT#b%lC`hvx zY)Tu@E1N$2$=9^^OS+kVJ-s?-ol~H@Trnxb!lwJsxq4N>Frio^g?@d2`sznZ1m^Gw zr7r{QwKbSp_W8mLG8ui*fF)dr(urseghYazkRGDxOrI+F^Xn(}*+)SCi!zijr2k9V z|E66SKBT{7!hz{w#3$7^;p-OvI_0r|;~3U6G~>8BLPGlw8|zhQ`5>4!q9*UY8kqi@Q<(c&v9}{ sY&BsOp@Fcj0qa+pR)GGG=NLZkZbFV$hsU+l623X2&G#rp=U;?>0;lZ}-~a#s literal 0 HcmV?d00001 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