Jump to content
Search In
  • More options...
Find results that contain...
Find results in...

wartemplar

Members
  • Posts

    30
  • Joined

  • Last visited

    Never

wartemplar's Achievements

Newbie

Newbie (1/14)

0

Reputation

  1. ![](http://www.freemmorpgmaker.com/files/imagehost/pics/c589e779bfdf5ffc9c24c451c4200ad5.bmp)
  2. Can you upload eclipse 208 modificaion game screen 384x484 PLZ!
  3. size game Screen To 384x484 Help me !!!!!!!
  4. size game Screen To 384x484 Help me !!!!!!!
  5. Client in modConstants find : Public Const MAX_CHARS = 3 Change to: Public Const MAX_CHARS = 4 Server: in modConstants find : Public Const MAX_CHARS = 3 Change to: Public Const MAX_CHARS = 4
  6. I need help to activate WASD Movement.
  7. Error in Case "loadspell1" FileData = ReadINI("SK1", "sid", App.Path & "\Scripts\db\" & GetPlayerName(Index) & ".ini", vbNullString) Call SendDataTo(Index, "getspell1" & SEP_CHAR & FileData & END_CHAR) Exit Sub Fix?
  8. The original link does not exist, this is a backup that I found on one site
  9. Post Compressed, Encrypted Graphics (and other optimizations) Edit edit: Disregard any part of this tutorial that says it is incomplete, it has now been finished. EDIT: By the way, it's 4:43 in the morning, sorry if I forgot anything xD Here is installment one of my tutorial to increase the awesome of your game. Please note that this will not function COMPLETELY until I finish the second part of the tutorial. The only problem with this tutorial currently is that the editors will crash when you try to open them unless you have the .bmp files in the GFX folder along with the .gfx files. This will be fixed shortly, along with fixing a lot more of the huge memory usage that diamond takes. Just hang tight and keep your BMP files until I finish the next part. Anyway, on with the description. What this tutorial does is show you how to convert your bitmap files into a compressed, encrypted format, to be read by the engine at runtime. Why use my code instead of other code? It is done COMPLETELY im memory. It decrypts, decompresses, and loads it to the DirectDraw surface without writing a single file to your hard drive. That means that the users can't catch the files and rip them when it's loading. Another advantage is the speed and compression rate. For a 15.8mb bitmap, it compresses to about 1.39 mb, and loads that file in roughly 0.77 seconds. This is complete client side: First off, you need to make a new module. Call it modGFX. Past this code inside of it: Code: Option Explicit Public Declare Function GetTickCount Lib "kernel32" () 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 compressBound Lib "vbzlib1.dll" (ByVal sourceLen As Long) As Long Public Declare Function compress Lib "vbzlib1.dll" (ByRef dest As Any, ByRef destLen As Long, ByRef Source As Any, ByVal sourceLen As Long, ByVal windowBits As Long) As Long Public Declare Function uncompress Lib "vbzlib1.dll" (ByRef dest As Any, ByRef destLen As Long, ByRef Source As Any, ByVal sourceLen As Long, ByVal windowBits As Long) As Long Public Enum zCode Z_OK = 0 Z_BUF_ERROR = -5 End Enum Public Const DIB_RGB_COLORS = 0 'Bitmap file format structures Public Type BITMAPFILEHEADER bfType As Integer bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long 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 RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type Public Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors(0 To 255) As RGBQUAD End Type Public gudtBMPFileHeader As BITMAPFILEHEADER 'Holds the file header Public gudtBMPInfo As BITMAPINFO 'Holds the bitmap info Public gudtBMPData() As Byte 'Holds the pixel data Public Sub CreateResource(ByVal Path As String, ByVal Password As String) Dim Start As Long Dim Temp() As Byte Dim f As Long Start = GetTickCount f = FreeFile Open App.Path & "\GFX\" & Path For Binary As #f ReDim Temp(LOF(f) - 1) Get f, , Temp Close #f Temp = CompressData(Temp) Call Crypt(Temp, Password) f = FreeFile Open App.Path & "\GFX\" & Left$(Path, InStrRev(Path, ".") - 1) & ".gfx" For Binary As #f Put #f, , Temp Close #f Debug.Print "Created """ & App.Path & "\GFX\" & Left$(Path, InStrRev(Path, ".") - 1) & ".gfx"" in " & Format$((GetTickCount - Start) / 1000, ".##") & " seconds." End Sub Public Function ByteToLong(ByVal B1 As Long, ByVal B2 As Long, ByVal B3 As Long, ByVal B4 As Long) As Long ByteToLong = B4 * 16777216 + B3 * 65536 + B2 * 256 + B1 End Function Public Function ByteToInt(ByVal B1 As Long, ByVal B2 As Long) As Long ByteToInt = B2 * 256 + B1 End Function Public Sub LoadGFXDDS(Surface As DirectDrawSurface7, SurfaceDesc As DDSURFACEDESC2, ByVal Path As String, ByVal Password As String) Dim lngTemp As Long Call ExtractResource(Path, Password) SurfaceDesc.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT SurfaceDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN SurfaceDesc.lWidth = gudtBMPInfo.bmiHeader.biWidth SurfaceDesc.lHeight = gudtBMPInfo.bmiHeader.biHeight Set Surface = DD.CreateSurface(SurfaceDesc) lngTemp = Surface.GetDC StretchDIBits lngTemp, 0, 0, gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight, 0, 0, gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight, gudtBMPData(0), gudtBMPInfo, DIB_RGB_COLORS, SRCCOPY Surface.ReleaseDC lngTemp SetMaskColorFromPixel Surface, 0, 0 End Sub Public Sub LoadGFXPicture(Picture As PictureBox, ByVal Path As String, ByVal Password As String) Call ExtractResource(Path, Password) Picture.Width = gudtBMPInfo.bmiHeader.biWidth Picture.Height = gudtBMPInfo.bmiHeader.biHeight StretchDIBits Picture.hDC, 0, 0, gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight, 0, 0, gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight, gudtBMPData(0), gudtBMPInfo, DIB_RGB_COLORS, SRCCOPY End Sub Public Sub ExtractResource(ByVal Path As String, ByVal Password As String) Dim Start As Long Dim Temp() As Byte Dim f As Long Dim i As Long Start = GetTickCount f = FreeFile Open App.Path & "\GFX\" & Left$(Path, InStrRev(Path, ".") - 1) & ".gfx" For Binary As #f ReDim Temp(LOF(f) - 1) Get f, , Temp Close #f Call Crypt(Temp, Password) Temp = DecompressData(Temp) 'Init variables Erase gudtBMPInfo.bmiColors 'Fill the File Header structure gudtBMPFileHeader.bfType = ByteToInt(Temp(0), Temp(1)) gudtBMPFileHeader.bfSize = ByteToLong(Temp(2), Temp(3), Temp(4), Temp(5)) gudtBMPFileHeader.bfReserved1 = ByteToInt(Temp(6), Temp(7)) gudtBMPFileHeader.bfReserved2 = ByteToInt(Temp(8), Temp(9)) gudtBMPFileHeader.bfOffBits = ByteToLong(Temp(10), Temp(11), Temp(12), Temp(13)) 'Fill the Info structure gudtBMPInfo.bmiHeader.biSize = ByteToLong(Temp(14), Temp(15), Temp(16), Temp(17)) gudtBMPInfo.bmiHeader.biWidth = ByteToLong(Temp(18), Temp(19), Temp(20), Temp(21)) gudtBMPInfo.bmiHeader.biHeight = ByteToLong(Temp(22), Temp(23), Temp(24), Temp(25)) gudtBMPInfo.bmiHeader.biPlanes = ByteToInt(Temp(26), Temp(27)) gudtBMPInfo.bmiHeader.biBitCount = ByteToInt(Temp(28), Temp(29)) gudtBMPInfo.bmiHeader.biCompression = ByteToLong(Temp(30), Temp(31), Temp(32), Temp(33)) gudtBMPInfo.bmiHeader.biSizeImage = ByteToLong(Temp(34), Temp(35), Temp(36), Temp(37)) gudtBMPInfo.bmiHeader.biXPelsPerMeter = ByteToLong(Temp(38), Temp(39), Temp(40), Temp(41)) gudtBMPInfo.bmiHeader.biYPelsPerMeter = ByteToLong(Temp(42), Temp(43), Temp(44), Temp(45)) gudtBMPInfo.bmiHeader.biClrUsed = ByteToLong(Temp(46), Temp(47), Temp(48), Temp(49)) gudtBMPInfo.bmiHeader.biClrImportant = ByteToLong(Temp(50), Temp(51), Temp(52), Temp(53)) If gudtBMPInfo.bmiHeader.biClrUsed 0 Then MsgBox "You need to recompress " & Path Call GameDestroy ElseIf gudtBMPInfo.bmiHeader.biBitCount = 8 Then MsgBox "You need to recompress " & Path Call GameDestroy ElseIf gudtBMPInfo.bmiHeader.biSizeImage = 0 Then MsgBox "You need to recompress " & Path Call GameDestroy End If 'Size the BMPData array ReDim gudtBMPData(gudtBMPInfo.bmiHeader.biSizeImage - 1) 'Fill the BMPData array For i = 0 To gudtBMPInfo.bmiHeader.biSizeImage - 1 gudtBMPData(i) = Temp(54 + i) Next 'Ensure info is correct If gudtBMPInfo.bmiHeader.biBitCount = 8 Then gudtBMPFileHeader.bfOffBits = 1078 gudtBMPInfo.bmiHeader.biSizeImage = FileSize(gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight) gudtBMPInfo.bmiHeader.biClrUsed = 0 gudtBMPInfo.bmiHeader.biClrImportant = 0 gudtBMPInfo.bmiHeader.biXPelsPerMeter = 0 gudtBMPInfo.bmiHeader.biYPelsPerMeter = 0 End If Debug.Print "Extracted """ & App.Path & "\GFX\" & Path & """ in " & Format$((GetTickCount - Start) / 1000, ".##") & " seconds." End Sub Public Function CompressData(ByRef sInput() As Byte) As Byte() Dim lInput As Long Dim sOutput() As Byte, lOutput As Long Dim RetVal As zCode On Error GoTo ErrorHandler lInput = UBound(sInput) + 1 If lInput > 0 Then lOutput = compressBound(lInput) ReDim sOutput(0 To (lOutput - 1)) As Byte RetVal = compress(sOutput(0), lOutput, sInput(0), lInput, -15) If RetVal = Z_OK Then ReDim Preserve sOutput(lOutput) CompressData = sOutput End If End If Exit Function ErrorHandler: Debug.Print "Error CompressData: " & Err.Number, Err.Description End Function Public Function DecompressData(ByRef sInput() As Byte) As String Dim lInput As Long Dim sOutput() As Byte, lOutput As Long Dim RetVal As zCode Dim gzISIZE As Long On Error GoTo ErrorHandler lInput = UBound(sInput) + 1 If lInput = 0 Then Exit Function gzISIZE = lInput * 3 If lInput > 0 And gzISIZE > 0 Then Do lOutput = gzISIZE ReDim sOutput(0 To (lOutput - 1)) As Byte RetVal = uncompress(sOutput(0), lOutput, sInput(0), lInput, -15) gzISIZE = gzISIZE + lInput Loop While RetVal = Z_BUF_ERROR ReDim Preserve sOutput(lOutput) DecompressData = sOutput End If Exit Function ErrorHandler: Debug.Print "Error cZLIB.UncompressString: " & Err.Number, Err.Description DecompressData = Err.Number End Function Private Function FileSize(lngWidth As Long, lngHeight As Long) As Long If lngWidth Mod 4 > 0 Then FileSize = ((lngWidth \ 4) + 1) * 4 * lngHeight - 1 Else FileSize = lngWidth * lngHeight - 1 End If End Function Function Crypt(bPlainText() As Byte, Password As String) As String Dim PTLength As Long Dim PWDLength As Integer Dim bPassword() As Byte Dim bXOR() As Byte Dim X As Long PTLength = UBound(bPlainText) PWDLength = Len(Password) bPassword = StrConv(Password, vbFromUnicode) ReDim bXOR(PTLength) As Byte For X = 0 To PTLength bXOR(X) = bPlainText(X) Xor bPassword(X Mod PWDLength) Next Crypt = StrConv(bXOR, vbUnicode) End Function This module provides all of the functions required to create or extract .gfx files, which are my compressed/encrypted bitmaps. It also contains the subs necessary to draw to a DirectDraw surface, or a picturebox. You can also draw to any hDC with extremely minimal modification. You also need to download the DLL I attached to this post for the encryption functions. It's vbzlib1.dll, a very well-known encryption DLL for Visual Basic. Easy to use, high performance. I just threw together a simple, fast, efficient wrapper for it. Attachment: vbzlib1.rar [31.79 KiB] Downloaded 24 times Next, you have to modify the InitSurfaces sub in modDirectX. You can just go ahead and replace it with this if you haven't made any changes: Code: Sub InitSurfaces() Dim i As Long ' Check for files existing If FileExist("GFX\sprites.gfx") = False Or FileExist("GFX\items.gfx") = False Or FileExist("GFX\bigsprites.gfx") = False Or FileExist("GFX\emoticons.gfx") = False Or FileExist("GFX\arrows.gfx") = False Then Call MsgBox("You're missing some graphic files!", vbOKOnly, GAME_NAME) Call GameDestroy End If ' Initialize back buffer DDSD_BackBuffer.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH DDSD_BackBuffer.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN DDSD_BackBuffer.lWidth = (MAX_MAPX + 1) * PIC_X DDSD_BackBuffer.lHeight = (MAX_MAPY + 1) * PIC_Y Set DD_BackBuffer = DD.CreateSurface(DDSD_BackBuffer) ' Init sprite ddsd type and load the bitmap Call LoadGFXDDS(DD_SpriteSurf, DDSD_Sprite, "sprites.bmp", "mypassword") ' Init tiles ddsd type and load the bitmap For i = 0 To ExtraSheets If Dir$(App.Path & "\GFX\tiles" & i & ".gfx") vbNullString Then Call LoadGFXDDS(DD_TileSurf(i), DDSD_Tile(i), "tiles" & i & ".bmp", "mypassword") TileFile(i) = 1 End If Next ' Init items ddsd type and load the bitmap Call LoadGFXDDS(DD_ItemSurf, DDSD_Item, "items.bmp", "mypassword") ' Init big sprites ddsd type and load the bitmap Call LoadGFXDDS(DD_BigSpriteSurf, DDSD_BigSprite, "bigsprites.bmp", "mypassword") ' Init emoticons ddsd type and load the bitmap Call LoadGFXDDS(DD_EmoticonSurf, DDSD_Emoticon, "emoticons.bmp", "mypassword") ' Init spells ddsd type and load the bitmap Call LoadGFXDDS(DD_SpellAnim, DDSD_SpellAnim, "spells.bmp", "mypassword") ' Init arrows ddsd type and load the bitmap Call LoadGFXDDS(DD_ArrowAnim, DDSD_ArrowAnim, "arrows.bmp", "mypassword") End Sub If you have made changes, I'm sure you can figure out what needs to be modified. By the way, when you're using the decryption, you DO need to put .bmp as the extension, even though they're saved as .gfx files. That's just the way I coded it. So now with my rediculously simple tutorial (and thanks to my awesome coding abilities), you can load custom compressed and enctypted bitmaps onto anything with a device context (hDC). Before you can use your custom .gfx files though, you obviously have to make them. This consists of a few very simple steps. First, out of sheer laziness, I've only included support for 24 bit, 8 bit per pixel RGB (R8 G8 B8) bitmaps. A couple of Diamond's GFX files aren't in that format (I think that the sprites and spells are the only two), so just use Photoshop or something to convert them. And second, just use my CreateResource() procedure: Code: Call CreateResource("sprites.bmp", "mypassword") That'll pop out a sprites.gfx file. Yaaaaaaaaaaaaaaaaaay _________________ Image Last edited by Monoxide on Sat Oct 04, 2008 1:00 pm, edited 8 times in total. Sun Aug 31, 2008 12:43 am Report this post Profile Send private message E-mail MSNM/WLM AIM WWW Monoxide Online Junior Admin Joined: Sat May 24, 2008 9:29 pm Posts: 870 Location: Canada Reply with quote Post Re: Compressed, Encrypted Graphics There we go, this'll fix up the item editor. Even if you didn't do my tutorial, it's a good idea to do this one cause it'll decrease the load time of the editor and also decrease it's memory usage. I'll post tutorials to fix the other editors once I finish them. Open frmItemEditor, and change the AutoRedraw property of picSelect, picBow, and picPic to True. Change AutoSize of picBow to False, and it's Left and Right to 0\. Also, change it's width and height to 32\. While you're form-level, delete Timer1 as well. Delete picItems and rename picPic to picItems. Now open the code. Find and delete: Code: Private Sub Timer1_Timer() Call BitBlt(picSelect.hDC, 0, 0, PIC_X, PIC_Y, picItems.hDC, EditorItemX * PIC_X, EditorItemY * PIC_Y, SRCCOPY) End Sub Replace the whole Form_Load sub with: Code: Call ItemEditorDisplayItems Call ItemEditorDisplayItem VScroll1.Max = (ItemHeight - picItems.Height) / PIC_Y Replace the picItems_MouseDown and picItems_MouseMove subs with: Code: If Button = 1 Then EditorItemX = Int(x / PIC_X) EditorItemY = Int(y / PIC_Y) + VScroll1.Value Call ItemEditorDisplayItem End If Replace cmbBow_Click with: Code: lblName.Caption = Arrows(cmbBow.ListIndex + 1).Name Call ItemEditorDisplayArrow Under: Code: Public Sub ItemEditorCancel() InItemsEditor = False Unload frmItemEditor End Sub Add: Code: Public Sub ItemEditorDisplayItems() Dim sRECT As RECT Dim dRECT As RECT With dRECT .Top = 0 .Bottom = frmItemEditor.picItems.Height .Left = 0 .Right = frmItemEditor.picItems.Width End With With sRECT .Left = 0 .Top = frmItemEditor.VScroll1.Value * PIC_Y .Right = frmItemEditor.picItems.Width .Bottom = .Top + frmItemEditor.picItems.Height End With DD_ItemSurf.BltToDC frmItemEditor.picItems.hDC, sRECT, dRECT frmItemEditor.picItems.Refresh End Sub Public Sub ItemEditorDisplayItem() Dim sRECT As RECT Dim dRECT As RECT With dRECT .Top = 0 .Bottom = .Top + SIZE_Y .Left = 0 .Right = .Left + SIZE_X End With With sRECT .Left = EditorItemX * PIC_X .Top = EditorItemY * PIC_Y .Right = .Left + PIC_X .Bottom = .Top + PIC_Y End With DD_ItemSurf.BltToDC frmItemEditor.picSelect.hDC, sRECT, dRECT frmItemEditor.picSelect.Refresh End Sub Public Sub ItemEditorDisplayArrow() Dim sRECT As RECT Dim dRECT As RECT With dRECT .Top = 0 .Bottom = .Top + SIZE_Y .Left = 0 .Right = .Left + SIZE_X End With With sRECT .Left = 0 .Top = Arrows(frmItemEditor.cmbBow.ListIndex + 1).Pic * PIC_Y .Right = PIC_X .Bottom = .Top + PIC_Y End With DD_ArrowAnim.BltToDC frmItemEditor.picBow.hDC, sRECT, dRECT frmItemEditor.picBow.Refresh End Sub Replace VScroll1_Change with: Code: Call ItemEditorDisplayItems In modGameLogic, in ItemEditorInit, find and delete: Code: frmItemEditor.picItems.Picture = LoadPicture(App.Path & "\GFX\items.bmp") And: Code: frmItemEditor.picBow.Top = (Arrows(Item(EditorIndex).Data3).Pic * 32) * -1 In modDirectX, under LoadSurfaces, find: Code: Call LoadGFXDDS(DD_ItemSurf, DDSD_Item, "items.bmp", "mypassword") And under it, add: Code: ItemHeight = gudtBMPInfo.bmiHeader.biHeight Find: Code: Public rec As RECT Public rec_pos As RECT And under it, add: Code: Public ItemHeight As Long Fixing the character create menu: Open frmNewChar and replace Form_Load with: Code: Call LoadGFXPicture(Picsprites, "sprites.bmp", "mypassword") UPDATE, FINALLY. Okay, at this point, it's quite a while later, and I've decided to do something a little differently to make things easier. This won't affect the .gfx files or anything, just the way things in the editors are drawn, so you'll be modifying a little bit of the code you modified earlier in this tutorial xD Below the sub ItemEditorDisplayArrow(), add: Code: Public Sub SurfToDC(ByVal Surface As DirectDrawSurface7, ByVal Picture As PictureBox, ByVal SourceX As Long, ByVal SourceY As Long, ByVal SourceW As Long, ByVal SourceH As Long, ByVal DestX As Long, ByVal DestY As Long, ByVal DestW As Long, ByVal DestH As Long) Dim sRECT As RECT Dim dRECT As RECT With sRECT .Left = SourceX .Top = SourceY .Right = SourceX + SourceW .Bottom = SourceY + SourceH End With With dRECT .Left = DestX .Top = DestY .Right = DestX + DestW .Bottom = DestY + DestH End With Surface.BltToDC Picture.hDC, sRECT, dRECT Picture.Refresh End Sub Replace Sub ItemEditorDisplayArrow() with: Code: Public Sub ItemEditorDisplayArrow() Call SurfToDC(DD_ArrowAnim, frmItemEditor.picBow, 0, Arrows(frmItemEditor.cmbBow.ListIndex + 1).Pic * PIC_X, PIC_X, PIC_Y, 0, 0, PIC_X, PIC_Y) End Sub Replace Sub ItemEditorDisplayItem() with: Code: Public Sub ItemEditorDisplayItem() Call SurfToDC(DD_ItemSurf, frmItemEditor.picSelect, EditorItemX * PIC_X, EditorItemY * PIC_Y, PIC_X, PIC_Y, 0, 0, PIC_X, PIC_Y) End Sub Replace Sub ItemEditorDisplayItems(): Code: Public Sub ItemEditorDisplayItems() Call SurfToDC(DD_ItemSurf, frmItemEditor.picItems, 0, frmItemEditor.VScroll1.Value * PIC_Y, frmItemEditor.picItems.Width, frmItemEditor.picItems.Height, 0, 0, frmItemEditor.picItems.Width, frmItemEditor.picItems.Height) End Sub Now on to fixing the NPC editor. Open frmNpcEditor and delete picSprites. Set the AutoRedraw property of picSprite to true. Delete tmrSprite. Find and delete Sub tmrSprite_Timer() Find Sub BigNpc_Click() and replace it with: Code: Private Sub BigNpc_Click() If BigNpc.Value = Checked Then picSprite.Width = 64 picSprite.Height = 64 picSprite.Left = (73 - 64) / 2 ' "73" is the scale width/height of Picture 1 picSprite.Top = (73 - 64) / 2 Else picSprite.Width = SIZE_X picSprite.Height = SIZE_Y picSprite.Left = (73 - SIZE_X) / 2 picSprite.Top = (73 - SIZE_Y) / 2 End If Call NpcEditorBltSprite End Sub Find Sub scrlSprite_Change() and replace with: Code: Private Sub scrlSprite_Change() lblSprite.Caption = STR(scrlSprite.Value) Call NpcEditorBltSprite End Sub Private Sub scrlSprite_Scroll() Call scrlSprite_Change End Sub Replace Sub Form_Load() with: Code: Private Sub Form_Load() scrlDropItem.Max = MAX_NPC_DROPS Call NpcEditorBltSprite End Sub In modGameLogic: Find and delete: Code: frmNpcEditor.Picsprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp") Replace Sub NpcEditorBltSprite() with: Code: Public Sub NpcEditorBltSprite() If frmNpcEditor.BigNpc.Value = Checked Then Call SurfToDC(DD_BigSpriteSurf, frmNpcEditor.picSprite, 3 * 64, frmNpcEditor.scrlSprite.Value * 64, 64, 64, 0, 0, 64, 64) Else Call SurfToDC(DD_SpriteSurf, frmNpcEditor.picSprite, 3 * SIZE_X, frmNpcEditor.scrlSprite.Value * SIZE_Y, SIZE_X, SIZE_Y, 0, 0, SIZE_X, SIZE_Y) End If End Sub That should be it for the NPC editor, more to come soon. EDIT AGAIN: Here's some more stuff, time to fix the emoticon editor. Yeah, I'm getting the easy stuff out of the way first xD Open up frmEmoticonEditor. Delete picEmoticons. Delete Timer1\. Set the AutoRedraw property of picEmoticon to True. At the very top of the code, add: Code: Option Explicit Replace Sub Form_Load() with: Code: Private Sub Form_Load() Call ListSounds(App.Path & "\SFX\", 3) lstSound.Text = Emoticons(EditorIndex - 1).Sound Call SurfToDC(DD_EmoticonSurf, picEmoticon, 0, scrlEmoticon.Value * PIC_Y, PIC_X, PIC_Y, 0, 0, PIC_X, PIC_Y) End Sub Replace scrlEmoticon_Change() with: Code: Private Sub scrlEmoticon_Change() Call SurfToDC(DD_EmoticonSurf, picEmoticon, 0, scrlEmoticon.Value * PIC_Y, PIC_X, PIC_Y, 0, 0, PIC_X, PIC_Y) lblEmoticon.Caption = scrlEmoticon.Value End Sub Private Sub scrlEmoticon_Scroll() Call scrlEmoticon_Change End Sub Find and delete Sub Timer1_Timer(). Open modGameLogic. Find and delete: Code: frmEmoticonEditor.picEmoticons.Picture = LoadPicture(App.Path & "\GFX\emoticons.bmp") I'll get some more done when I wake up tomorrow Edit: Time for the arrow editor. Open up frmEditArrows. Delete picArrows. Rename picEmoticon (yes, there's a picEmoticon for some reason, it was right under picArrows) to picArrows, and set it's AutoRedraw property to True. Onto code. Add this to the very top: Code: Option Explicit Replace Sub scrlArrow_Change() with: Code: Private Sub scrlArrow_Change() lblArrow.Caption = "Arrow: " & scrlArrow.Value Call SurfToDC(DD_ArrowAnim, frmEditArrows.picArrows, 0, scrlArrow.Value * PIC_Y, PIC_X, PIC_Y, 0, 0, PIC_X, PIC_Y) End Sub Private Sub scrlArrow_Scroll() Call scrlArrow_Change End Sub Open modGameLogic, and in Sub ArrowEditorInit() find and delete: Code: frmEditArrows.picArrows.Picture = LoadPicture(App.Path & "\GFX\arrows.bmp") Now I just wanna make a small change to the item editor, so that when you drag the scrollbar it doesn't wait until you let go to display the items. Below Sub VScroll1_Change() add: Code: Private Sub VScroll1_Scroll() Call VScroll1_Change End Sub Now onto the most difficult part, the map editor. Select shpSelected and copy it. Delete picBackSelect. This should delete shpSelected as well. Now select picBack and paste shpSelected onto it. Change the AutoRedraw property of picBack to True. Open the code. At the very top, add: Code: Option Explicit Dim LastVal As Long Find Sub optLight_Click() and replace it with: Code: Private Sub optlight_Click() fraLayers.Visible = False fraAttribs.Visible = False sclTileset.Value = 6 sclTileset.Enabled = False End Sub Find Sub optTiles_Click() and replace it with: Code: Private Sub optTiles_Click() fraLayers.Visible = True fraAttribs.Visible = False sclTileset.Enabled = True sclTileset.Value = 0 End Sub Find and delete Sub optNPC_Click() Replace Sub scrlPicture_Change() with: Code: Private Sub scrlPicture_Change() shpSelected.Top = shpSelected.Top + (LastVal - scrlPicture.Value) * 32 LastVal = scrlPicture.Value Call EditorTileScroll End Sub Private Sub scrlPicture_Scroll() Call scrlPicture_Change End Sub Find and delete Sub Form_Resize() Replace all four instances of picBackSelect_ with picBack_ Find: Code: EditorTileY = Int((shpSelected.Top + PIC_Y) / PIC_Y) And replace with: Code: EditorTileY = Int((shpSelected.Top + PIC_Y) / PIC_Y) + scrlPicture.Value Find: Code: EditorTileY = Int(shpSelected.Top / PIC_Y) And replace with: Code: EditorTileY = Int(shpSelected.Top / PIC_Y) + scrlPicture.Value Replace Sub sclTileset_Change() with: Code: Private Sub sclTileset_Change() EditorSet = sclTileset.Value Call EditorTileScroll scrlPicture.Max = Int((DDSD_Tile(EditorSet).lHeight - picBack.Height) / PIC_Y) + 1 lblTileset = sclTileset.Value End Sub Private Sub sclTileset_Scroll() Call sclTileset_Change End Sub Open modGameLogic. Find and replace Sub EditorTileScroll() with: Code: Public Sub EditorTileScroll() With frmMapEditor.picBack Call SurfToDC(DD_TileSurf(EditorSet), frmMapEditor.picBack, 0, frmMapEditor.scrlPicture.Value * PIC_Y, .Width, .Height, 0, 0, .Width, .Height) End With End Sub Find and replace SubEditorInit() with: Code: Public Sub EditorInit() Dim i As Long Call StopMidi InEditor = True InSpawnEditor = False frmMapEditor.Show vbModeless, frmMirage Call EditorTileScroll frmMapEditor.scrlPicture.Max = Int((DDSD_Tile(EditorSet).lHeight - frmMapEditor.picBack.Height) / PIC_Y) + 1 frmMapEditor.picBack.Width = 448 If GameTime = TIME_NIGHT Then frmMapEditor.chkDayNight.Value = 1 If GameTime = TIME_DAY Then frmMapEditor.chkDayNight.Value = 0 End Sub Replace Sub EditorChooseTile() with: Code: Public Sub EditorChooseTile(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then EditorTileX = Int(X / PIC_X) EditorTileY = Int(Y / PIC_Y) End If frmMapEditor.shpSelected.Top = EditorTileY * PIC_Y frmMapEditor.shpSelected.Left = EditorTileX * PIC_Y End Sub Well, you should be done. I'm gonna test it out now to make sure everything works. I'll tell you when I'm done. EDIT MOAR: There were just a couple things that I missed. I updated a little of the code earlier, and here's a few more changes that need to be made: frmTalk: Delete picSprites. Delete Timer1\. Set the AutoRedraw property of picPic to True. In frmTalk's code: Find and delete Sub Form_Load() Find and delete Sub Timer1_Timer() Change Sub Timer2_Timer() to: Code: Private Sub Timer2_Timer() If frmTalk.Visible Then animi = animi + 1 If animi > 4 Then animi = 3 End If If Speech(SpeechConvo1).Num(SpeechConvo2).SaidBy = 0 Then Call SurfToDC(DD_SpriteSurf, Picpic, animi * SIZE_X, Int(Npc(SpeechConvo3).Sprite) * SIZE_Y - (SIZE_Y - PIC_Y), SIZE_X, SIZE_Y, 0, 0, SIZE_X, SIZE_Y) Else Call SurfToDC(DD_SpriteSurf, Picpic, animi * SIZE_X, Int(Player(MyIndex).Sprite) * SIZE_Y - (SIZE_Y - PIC_Y), SIZE_X, SIZE_Y, 0, 0, SIZE_X, SIZE_Y) End If End If End Sub frmSpriteChange: Delete picSprites. Set the AutoRedraw property of picSprite to True. Code: At the very top, add: Code: Option Explicit Delete Sub Timer1_Timer() Replace Form_Load() with: Code: Private Sub Form_Load() If SpritePic < scrlSprite.Min Then SpritePic = scrlSprite.Min scrlSprite.Value = SpritePic If SpriteItem < scrlItem.Min Then SpriteItem = scrlItem.Min scrlItem.Value = SpriteItem If SpritePrice < scrlCost.Min Then SpritePrice = scrlCost.Min scrlCost.Value = SpritePrice picSprite.Width = SIZE_X * 15 picSprite.Height = SIZE_Y * 15 Call SurfToDC(DD_SpriteSurf, picSprite, 3 * SIZE_X, scrlSprite.Value * SIZE_Y - (SIZE_Y - PIC_Y), SIZE_X, SIZE_Y, 0, 0, SIZE_X, SIZE_Y) End Sub Replace Sub scrlSprite_Change() with: Code: Private Sub scrlSprite_Change() lblSprite.Caption = scrlSprite.Value Call SurfToDC(DD_SpriteSurf, picSprite, 3 * SIZE_X, scrlSprite.Value * SIZE_Y - (SIZE_Y - PIC_Y), SIZE_X, SIZE_Y, 0, 0, SIZE_X, SIZE_Y) End Sub In modGameLogic, find and delete: Code: frmSpriteChange.Picsprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp") frmTrade: Delete picItems. Delete tmrItems. Set the AutoRedraw of every picture on this form to True. At the very top of the code, add: Code: Option Explicit Delete Sub Form_Load() Delete Sub Deal_MouseMove() Delete Sub tmrItems_Timer() Replace from Sub Label1_Click() to Sub Label6_Click() with: Code: Private Sub Label1_Click() Dim xx As Long For xx = 1 To 6 Trade(xx).Selected = NO Next xx Trade(1).Selected = YES shopType.Left = Label1.Left shopType.Height = Label1.Height shopType.Width = Label1.Width Trade(1).SelectedItem = 1 Call BltShopInv Call ItemSelected(1, 1) End Sub Private Sub Label2_Click() Dim xx As Long For xx = 1 To 6 Trade(xx).Selected = NO Next xx Trade(2).Selected = YES shopType.Left = Label2.Left shopType.Height = Label2.Height shopType.Width = Label2.Width Trade(2).SelectedItem = 1 Call BltShopInv Call ItemSelected(1, 2) End Sub Private Sub Label3_Click() Dim xx As Long For xx = 1 To 6 Trade(xx).Selected = NO Next xx Trade(3).Selected = YES shopType.Left = Label3.Left shopType.Height = Label3.Height shopType.Width = Label3.Width Trade(3).SelectedItem = 1 Call BltShopInv Call ItemSelected(1, 3) End Sub Private Sub Label4_Click() Dim xx As Long For xx = 1 To 6 Trade(xx).Selected = NO Next xx Trade(4).Selected = YES shopType.Left = Label4.Left shopType.Height = Label4.Height shopType.Width = Label4.Width Trade(4).SelectedItem = 1 Call BltShopInv Call ItemSelected(1, 4) End Sub Private Sub Label5_Click() Dim xx As Long For xx = 1 To 6 Trade(xx).Selected = NO Next xx Trade(5).Selected = YES shopType.Left = Label5.Left shopType.Height = Label5.Height shopType.Width = Label5.Width Trade(5).SelectedItem = 1 Call BltShopInv Call ItemSelected(1, 5) End Sub Private Sub Label6_Click() Dim xx As Long For xx = 1 To 6 Trade(xx).Selected = NO Next xx Trade(6).Selected = YES shopType.Left = Label6.Left shopType.Height = Label6.Height shopType.Width = Label6.Width Trade(6).SelectedItem = 1 Call BltShopInv Call ItemSelected(1, 6) End Sub In modGameLogic: Above Sub ItemSelected() add: Code: Sub BltShopInv() Dim i As Long Dim Selected As Byte Dim Pic As Long For i = 1 To 6 If Trade(i).Selected = YES Then Selected = i Exit For End If Next If Selected = 0 Then Exit Sub For i = 1 To MAX_TRADES If Trade(Selected).Items(i).ItemGetNum > 0 Then Pic = Item(Trade(Selected).Items(i).ItemGetNum).Pic Call SurfToDC(DD_ItemSurf, frmTrade.picItem(i - 1), (Pic - Int(Pic / 6) * 6) * PIC_X, Int(Pic / 6) * PIC_Y, PIC_X, PIC_Y, 0, 0, PIC_X, PIC_Y) Else frmTrade.picItem(i - 1).Picture = LoadPicture() End If Next End Sub Replace Sub ClearItemSelected() with: Code: Sub ClearItemSelected() frmTrade.lblTradeFor.Caption = vbNullString frmTrade.lblQuantity.Caption = vbNullString frmTrade.descName.Caption = vbNullString frmTrade.descQuantity.Caption = vbNullString frmTrade.descStr.Caption = "Strength: 0" frmTrade.descDef.Caption = "Defense: 0" frmTrade.descMagi.Caption = "Magic: 0" frmTrade.descSpeed.Caption = "Speed: 0" frmTrade.descAStr.Caption = "Strength: 0" frmTrade.descADef.Caption = "Defense: 0" frmTrade.descAMagi.Caption = "Magic: 0" frmTrade.descASpeed.Caption = "Speed: 0" frmTrade.descHp.Caption = "HP: 0" frmTrade.descMp.Caption = "MP: 0" frmTrade.descAExp.Caption = "EXP: 0%" frmTrade.desc.Caption = vbNullString frmTrade.picItem(66).Picture = LoadPicture() End Sub Find: Code: Call BltShopInv frmTrade.Show vbModeless, frmMirage And replace it with: Code: Call BltShopInv Call ItemSelected(1, 1) frmTrade.Show vbModeless, frmMirage Well…there you go guys. This should be the complete tutorial.
  10. hi this is still not working Can I put a tutorial with pictures?
×
×
  • Create New...