Qazek

Check Mirage 3.0.7 with MySQL database

One bug - when I equip item and my hp growth, hp bar is longer :P But still engine is very nice, I'm waiting for the next realease :)

Ok, got it :D Thanks for help :)

Blocking print screen is not good xD But look at the code, here is Compressing file: ``` Public Function CompressFile(FilePathIn As String, FilePathOut As String, CompressionLevel As Integer) As Long 'compress a file Dim intNextFreeFile As Integer Dim TheBytes() As Byte Dim lngResult As Long Dim lngFileLen As Long ' Along the way, we are gonna make it look professional and infom the user ' Of the programs actions lngFileLen = FileLen(FilePathIn) 'allocate byte array ReDim TheBytes(lngFileLen - 1) 'read byte array from file Close #10 intNextFreeFile = FreeFile '10 'FreeFile Open FilePathIn For Binary Access Read As #intNextFreeFile Get #intNextFreeFile, , TheBytes() Close #intNextFreeFile 'compress byte array lngResult = CompressByteArray(TheBytes(), CompressionLevel) 'kill any file in place On Error Resume Next Kill FilePathOut On Error GoTo 0 'Write it out intNextFreeFile = FreeFile Open FilePathOut For Binary Access Write As #intNextFreeFile Put #intNextFreeFile, , lngFileLen 'must store the length of the original file Put #intNextFreeFile, , TheBytes() Close #intNextFreeFile Erase TheBytes CompressFile = lngResult End Function ``` And it works with EO and DX8 (tested), but only what I want is to change anything in this function to make my files more difficult to decompress using DecompressFile function. I never worked on a files like that so it's new experience for me ^^

I found this on my cd ;_; ``` Option Explicit 'the following are for compression/decompression Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Declare Function compress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long Private Declare Function compress2 Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long, ByVal level As Long) As Long Private Declare Function uncompress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long 'the following are for compression/decompression Dim lngCompressedSize As Long Dim lngDecompressedSize As Long Public Enum CZErrors 'for compression/decompression Z_OK = 0 Z_STREAM_END = 1 Z_NEED_DICT = 2 Z_ERRNO = -1 Z_STREAM_ERROR = -2 Z_DATA_ERROR = -3 Z_MEM_ERROR = -4 Z_BUF_ERROR = -5 Z_VERSION_ERROR = -6 End Enum Public Enum CompressionLevels 'for compression/decompression Z_NO_COMPRESSION = 0 Z_BEST_SPEED = 1 'note that levels 2-8 exist, too Z_BEST_COMPRESSION = 9 Z_DEFAULT_COMPRESSION = -1 End Enum Public Property Get ValueCompressedSize() As Long 'size of an object after compression ValueCompressedSize = lngCompressedSize End Property Private Property Let ValueCompressedSize(ByVal New_ValueCompressedSize As Long) lngCompressedSize = New_ValueCompressedSize End Property Public Property Get ValueDecompressedSize() As Long 'size of an object after decompression ValueDecompressedSize = lngDecompressedSize End Property Private Property Let ValueDecompressedSize(ByVal New_ValueDecompressedSize As Long) lngDecompressedSize = New_ValueDecompressedSize End Property Public Function CompressByteArray(TheData() As Byte, CompressionLevel As Integer) As Long 'compress a byte array Dim lngResult As Long Dim lngBufferSize As Long Dim arrByteArray() As Byte lngDecompressedSize = UBound(TheData) + 1 'Allocate memory for byte array lngBufferSize = UBound(TheData) + 1 lngBufferSize = lngBufferSize + (lngBufferSize * 0.01) + 12 ReDim arrByteArray(lngBufferSize) 'Compress byte array (data) lngResult = compress2(arrByteArray(0), lngBufferSize, TheData(0), UBound(TheData) + 1, CompressionLevel) 'Truncate to compressed size ReDim Preserve TheData(lngBufferSize - 1) CopyMemory TheData(0), arrByteArray(0), lngBufferSize 'Set property lngCompressedSize = UBound(TheData) + 1 'return error code (if any) CompressByteArray = lngResult End Function Public Function CompressString(Text As String, CompressionLevel As Integer) As Long 'compress a string Dim lngOrgSize As Long Dim lngReturnValue As Long Dim lngCmpSize As Long Dim strTBuff As String ValueDecompressedSize = Len(Text) 'Allocate string space for the buffers lngOrgSize = Len(Text) strTBuff = String(lngOrgSize + (lngOrgSize * 0.01) + 12, 0) lngCmpSize = Len(strTBuff) 'Compress string (temporary string buffer) data lngReturnValue = compress2(ByVal strTBuff, lngCmpSize, ByVal Text, Len(Text), CompressionLevel) 'Crop the string and set it to the actual string. Text = Left$(strTBuff, lngCmpSize) 'Set compressed size of string. ValueCompressedSize = lngCmpSize 'Cleanup strTBuff = "" 'return error code (if any) CompressString = lngReturnValue End Function Public Function DecompressByteArray(TheData() As Byte, OriginalSize As Long) As Long 'decompress a byte array Dim lngResult As Long Dim lngBufferSize As Long Dim arrByteArray() As Byte lngDecompressedSize = OriginalSize lngCompressedSize = UBound(TheData) + 1 'Allocate memory for byte array lngBufferSize = OriginalSize lngBufferSize = lngBufferSize + (lngBufferSize * 0.01) + 12 ReDim arrByteArray(lngBufferSize) 'Decompress data lngResult = uncompress(arrByteArray(0), lngBufferSize, TheData(0), UBound(TheData) + 1) 'Truncate buffer to compressed size ReDim Preserve TheData(lngBufferSize - 1) CopyMemory TheData(0), arrByteArray(0), lngBufferSize 'return error code (if any) DecompressByteArray = lngResult End Function Public Function DecompressString(Text As String, OriginalSize As Long) As Long 'decompress a string Dim lngResult As Long Dim lngCmpSize As Long Dim strTBuff As String 'Allocate string space strTBuff = String(ValueDecompressedSize + (ValueDecompressedSize * 0.01) + 12, 0) lngCmpSize = Len(strTBuff) ValueDecompressedSize = OriginalSize 'Decompress lngResult = uncompress(ByVal strTBuff, lngCmpSize, ByVal Text, Len(Text)) 'Make string the size of the uncompressed string Text = Left$(strTBuff, lngCmpSize) ValueCompressedSize = lngCmpSize 'return error code (if any) DecompressString = lngResult End Function Public Function CompressFile(FilePathIn As String, FilePathOut As String, CompressionLevel As Integer) As Long 'compress a file Dim intNextFreeFile As Integer Dim TheBytes() As Byte Dim lngResult As Long Dim lngFileLen As Long ' Along the way, we are gonna make it look professional and infom the user ' Of the programs actions lngFileLen = FileLen(FilePathIn) 'allocate byte array ReDim TheBytes(lngFileLen - 1) 'read byte array from file Close #10 intNextFreeFile = FreeFile '10 'FreeFile Open FilePathIn For Binary Access Read As #intNextFreeFile Get #intNextFreeFile, , TheBytes() Close #intNextFreeFile 'compress byte array lngResult = CompressByteArray(TheBytes(), CompressionLevel) 'kill any file in place On Error Resume Next Kill FilePathOut On Error GoTo 0 'Write it out intNextFreeFile = FreeFile Open FilePathOut For Binary Access Write As #intNextFreeFile Put #intNextFreeFile, , lngFileLen 'must store the length of the original file Put #intNextFreeFile, , TheBytes() Close #intNextFreeFile Erase TheBytes CompressFile = lngResult End Function Public Function DecompressFile(FilePathIn As String, FilePathOut As String) As Long 'decompress a file Dim intNextFreeFile As Integer Dim TheBytes() As Byte Dim lngResult As Long Dim lngFileLen As Long 'allocate byte array ReDim TheBytes(FileLen(FilePathIn) - 1) 'read byte array from file intNextFreeFile = FreeFile Open FilePathIn For Binary Access Read As #intNextFreeFile Get #intNextFreeFile, , lngFileLen 'the original (uncompressed) file's length Get #intNextFreeFile, , TheBytes() Close #intNextFreeFile 'decompress lngResult = DecompressByteArray(TheBytes(), lngFileLen) 'kill any file already there On Error Resume Next Kill FilePathOut On Error GoTo 0 'Write it out intNextFreeFile = FreeFile Open FilePathOut For Binary Access Write As #intNextFreeFile Put #intNextFreeFile, , TheBytes() Close #intNextFreeFile Erase TheBytes DecompressFile = lngResult End Function ``` And it works perfectly, but if anyone knows that algoritm, then he could easily decompress files.

Hello! I am looking for something what could secure my graphics from stealing I mean compression/encryption with password etc. I am using EO 3.0 with DirectX8.

It looks really promissing :) Is map editor using autotiles?

Ok I found what is wrong, in Sub RenderTexture i found: ``` If sY + sHeight > textureHeight Then Exit Sub ``` But when I remove it it drawing second HP bar under first. Maybe I should use RenderTextureByRects but i don't know how to use it xD

Hey! I need to create vertical HP and MP bars for my game. My code: ``` HPBar = 94 * (GetPlayerVital(MyIndex, Vitals.HP) / GetPlayerMaxVital(MyIndex, Vitals.HP)) HPBar = 94 - HPBar RenderTexture Tex_GUI(1), 0, 16 + HPBar, 0, HPBar, 94, 94, 94, 94 ``` But it only shows HP bar picture when HP > 123\. If hp =< 123, hp bar is unvisible. Any ideas?

Client is loading really long because all graphics are loaded at start. So how to change it to load images only when I need?

Everything. Now i've got all RMVX animations in my game but I need more for battles.

Hello I'm looking for animations in rmvx style for my game. Thanks ;)

Sorry for english This simple fix just stop rendering empty map tile slots. It's really helpfull when you using big maps with autotilesets in your game. Only Client Side Find: ``` DrawMapFringeTile ``` In this sub under: ``` For I = MapLayer.Fringe To MapLayer.Fringe2 ``` Put this: ``` If .Layer(I).Tileset 0 Then ``` And now before: ``` Next ``` Put: ``` End If ``` Now let's go to the DrawMapTile Sub and do the same things (add the same If) like before. In my game I've got 5-10 more FPS :P

I removed some unused things like hotbar, I removed some unused packets, I removed game editors, I changed some longs to bytes (in packets too), I changed max constants to minimum (like only 40 player slots not 70), I optimized PlayerData and PlayerMove packets and subs. Something else? xD

Hello! I need to make my server stable for 20-30 players so my answer is how to do that. Any tricks to optimize NPC's logic or anything else which could be really helpfull?

It's only requirement ifs code optimalization. Before: ``` Select Case Item(itemnum).Type ``` Paste: ``` ' stat requirements For i = 1 To Stats.Stat_Count - 1 If GetPlayerRawStat(index, i) < Item(itemnum).Stat_Req(i) Then PlayerMsg index, "You do not meet the stat requirements to equip this item.", BrightRed Exit Sub End If Next ' level requirement If GetPlayerLevel(index) < Item(itemnum).LevelReq Then PlayerMsg index, "You do not meet the level requirement to equip this item.", BrightRed Exit Sub End If ' class requirement If Item(itemnum).ClassReq > 0 Then If Not GetPlayerClass(index) = Item(itemnum).ClassReq Then PlayerMsg index, "You do not meet the class requirement to equip this item.", BrightRed Exit Sub End If End If ' access requirement If Not GetPlayerAccess(index) >= Item(itemnum).AccessReq Then PlayerMsg index, "You do not meet the access requirement to equip this item.", BrightRed Exit Sub End If ``` And now remove requirement ifs from ITEM_TYPE_WEAPON, ITEM_TYPE_ARMOR etc. For example for ITEM_TYPE_ARMOR: ``` Case ITEM_TYPE_ARMOR If GetPlayerEquipment(index, Armor) > 0 Then tempItem = GetPlayerEquipment(index, Armor) End If SetPlayerEquipment index, itemnum, Armor PlayerMsg index, "You equip " & CheckGrammar(Item(itemnum).Name), BrightGreen TakeInvItem index, itemnum, 0 If tempItem > 0 Then GiveInvItem index, tempItem, 0 ' give back the stored item tempItem = 0 End If Call SendWornEquipment(index) Call SendMapEquipment(index) ' send vitals Call SendVital(index, Vitals.HP) Call SendVital(index, Vitals.MP) ' send vitals to party if in one If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index ' send the sound SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, itemnum ``` ;)

Ok I solved it. Sorry but I posted wrong code XD But i need just to check everything in web adress, on my site adress "[http://diamond.ugu.pl/](http://diamond.ugu.pl/)" works perfectly but "http://www.diamond.ugu.pl/" (which i choose in web.navigate) doesn't work XD Sorry for all of that mistakes and thank you :)

Ok thank you all for answers. I found one bug with web adress - i need to use http:// and / at end. But it only works on google site: So this is my google code: ``` Private Sub Command1_Click() web.Navigate "http://www.google.com/" 'here I can use any adress site.Caption = web.LocationURL End Sub Private Sub Command2_Click() If web.LocationURL = "http://www.google.com/" Then 'but here adress must have http:// and at the end / text.Caption = "Wszystko dziala ok! / OK' it's work" Else text.Caption = "Nie ma tej strony / Bad site" End If End Sub ``` And here is code of my game site: ``` Private Sub Command1_Click() web.Navigate "http://www.diamond.ugu.pl/" 'open it site.Caption = web.LocationURL 'label "site" caption End Sub Private Sub Command2_Click() If web.LocationName = "http://www.diamond.ugu.pl/" Then ' text.Caption = "Wszystko dziala ok!/ Ok, it works" Else text.Caption = "Nie ma tej strony/something is wrong" End If End Sub ``` Only adress difference but with my website doesn't work

Hello! I need help with one small mod for my game. I added Microsoft Internet Controler and now I need a modification wich could check websites on my in game web browser. I tried to do something like that: ``` WebBrowser.Navigate = "www.google.com"

I have one problem with my HP bar. I need to make it vertical. How it should look in source?

Hello! I have one question about optimalization server and client data sending. Is it a good idea to change data types from Long to Byte? For example: Edited ver of SendAddChar Sub: ``` Public Sub SendAddChar(ByVal name As String, ByVal Sex As Byte, ByVal ClassNum As Byte, ByVal Sprite As Byte) Dim buffer As clsBuffer ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler Set buffer = New clsBuffer buffer.WriteLong CAddChar buffer.WriteString name buffer.WriteByte Sex buffer.WriteByte ClassNum buffer.WriteByte Sprite SendData buffer.ToArray() Set buffer = Nothing ' Error handler Exit Sub errorhandler: HandleError "SendAddChar", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ``` And here is original ver: ``` Public Sub SendAddChar(ByVal name As String, ByVal Sex As Long, ByVal ClassNum As Long, ByVal Sprite As Long) Dim buffer As clsBuffer ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler Set buffer = New clsBuffer buffer.WriteLong CAddChar buffer.WriteString name buffer.WriteLong Sex buffer.WriteLong ClassNum buffer.WriteLong Sprite SendData buffer.ToArray() Set buffer = Nothing ' Error handler Exit Sub errorhandler: HandleError "SendAddChar", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ```

Dr.Swizl: So i need to remove everything  But what about Essence on DX8?

Hello! I'm looking for a simply vb6 engine, without features like in EO. I just need something with client server connection, login & register system, player movement and dx8.

How to use background layer? XD

Yes, but I'm not sure. For me TakeInvItem function works perfectly