diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..6f578ae --- /dev/null +++ b/.gitignore @@ -0,0 +1,16 @@ +MSSCCPRJ.SCC +WorldEditor.exe +WorldEditor.vbw +EXTRAS/ +FONT/ +MIDI/ +MP3/ +WAV/ +[r,R]enders/ +LOGS/ +WorldEditor.ini +dats/ +graphics/ +grhindex/ +inits/ +maps/ diff --git a/Codigo/Application.bas b/Codigo/Application.bas index e16dad0..60edf44 100644 --- a/Codigo/Application.bas +++ b/Codigo/Application.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "Application" +'@Folder("WorldEditor.Modules") '************************************************************** ' Application.bas - General API methods regarding the Application in general. '************************************************************** @@ -40,3 +41,29 @@ Public Function IsAppActive() As Boolean '*************************************************** IsAppActive = (GetActiveWindow <> 0) End Function + + +Public Sub LogError(ByVal errStr As String) + + Dim path As String + Dim oFile As Integer + + Dim logsPath As String + logsPath = App.path & "\LOGS\" + + ' Check for logs folder + If Dir(logsPath, vbDirectory) = "" Then + Call MkDir(logsPath) + End If + + path = logsPath & "\Errores_" & format(Now, "yyyyMMdd") & ".log" + oFile = FreeFile + + Open path For Append As #oFile + Print #oFile, time & " - " & errStr + Close #oFile + + Exit Sub + + +End Sub diff --git a/Codigo/LaVolpe Button/lvButtons.ctl b/Codigo/LaVolpe Button/lvButtons.ctl index 8d19fe4..db92a6f 100644 --- a/Codigo/LaVolpe Button/lvButtons.ctl +++ b/Codigo/LaVolpe Button/lvButtons.ctl @@ -29,7 +29,9 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False +'@Folder("WorldEditor.UserControls") Option Explicit + Option Compare Text ' LaVolpe Button (c) by LaVolpe oct/2005 @@ -62,11 +64,11 @@ Public Event Click() Attribute Click.VB_MemberFlags = "200" Public Event DoubleClick(Button As Integer) ' added benefit Public Event OLECompleteDrag(Effect As Long) -Public Event OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) -Public Event OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) +Public Event OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) +Public Event OLEDragOver(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) Public Event OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean) -Public Event OLESetData(Data As DataObject, DataFormat As Integer) -Public Event OLEStartDrag(Data As DataObject, AllowedEffects As Long) +Public Event OLESetData(data As DataObject, DataFormat As Integer) +Public Event OLEStartDrag(data As DataObject, AllowedEffects As Long) ' GDI32 Function Calls ' ===================================================================== @@ -118,7 +120,7 @@ Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As An ' USER32 Function Calls ' ===================================================================== ' General Windows related functions -Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal imageType As Long, ByVal newWidth As Long, ByVal newHeight As Long, ByVal lFlags As Long) As Long +Private Declare Function CopyImage Lib "user32" (ByVal Handle As Long, ByVal imageType As Long, ByVal newWidth As Long, ByVal newHeight As Long, ByVal lFlags As Long) As Long Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long Private Declare Function DrawFocusRect Lib "user32" (ByVal hDC As Long, lpRect As RECT) As Long Private Declare Function DrawIconEx Lib "user32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long @@ -225,7 +227,7 @@ Private Type ImageProperties TransImage As Long TransSize As POINTAPI Align As ImagePlacementConstants ' image alignment (6 options) - Size As Integer ' image size (5 options) + size As Integer ' image size (5 options) iRect As RECT ' cached image's bounding rectangle SourceSize As POINTAPI ' cached source image dimensions Type As Long ' cached source image type (bmp/ico) @@ -511,7 +513,7 @@ Attribute Picture.VB_Description = "The image used to display on the button." ' Sets the button image which to display Set myImage.Image = xPic -If myImage.Size = 0 Then myImage.Size = 16 +If myImage.size = 0 Then myImage.size = 16 GetGDIMetrics "Picture" If myProps.bShape > lv_RoundFlat Then ' custom shapes If xPic Is Nothing Then @@ -633,16 +635,16 @@ If myProps.bShape > lv_RoundFlat Then If Not Ambient.UserMode Then MsgBox "The picture size cannot be changed for Shaped buttons", vbInformation + vbOKOnly Exit Property End If -myImage.Size = (nSize + 2) * 8 ' I just want the size as pixel x pixel +myImage.size = (nSize + 2) * 8 ' I just want the size as pixel x pixel CalculateBoundingRects True ' recalculate text/image bounding rects RedrawButton PropertyChanged "ImgSize" If myProps.bShape > lv_RoundFlat Then Call UserControl_Resize End Property Public Property Get PictureSize() As ImageSizeConstants -If myImage.Size = 0 Then myImage.Size = 16 +If myImage.size = 0 Then myImage.size = 16 ' parameters are 0,1,2,3,4 & 5, but we store them as 16,24,32,40, & 44 -PictureSize = Choose(myImage.Size / 8 - 1, lv_16x16, lv_24x24, lv_32x32, lv_Fill_Stretch, lv_Fill_ScaleUpDown) +PictureSize = Choose(myImage.size / 8 - 1, lv_16x16, lv_24x24, lv_32x32, lv_Fill_Stretch, lv_Fill_ScaleUpDown) End Property Public Property Let MousePointer(nPointer As MousePointerConstants) @@ -676,21 +678,21 @@ Public Property Get MouseIcon() As StdPicture Set MouseIcon = UserControl.MouseIcon End Property -Public Property Set Font(nFont As StdFont) -Attribute Font.VB_Description = "Font used to display the caption." -Attribute Font.VB_ProcData.VB_Invoke_PropertyPutRef = ";Font" +Public Property Set font(nFont As StdFont) +Attribute font.VB_Description = "Font used to display the caption." +Attribute font.VB_ProcData.VB_Invoke_PropertyPutRef = ";Font" ' Sets the control's font & also the logical font to use on off-screen DC -Set UserControl.Font = nFont +Set UserControl.font = nFont GetGDIMetrics "Font" CalculateBoundingRects False ' recalculate caption's text/image bounding rects RedrawButton PropertyChanged "Font" End Property -Public Property Get Font() As StdFont -Set Font = UserControl.Font +Public Property Get font() As StdFont +Set font = UserControl.font End Property Public Property Let FontStyle(nStyle As FontStyles) @@ -698,7 +700,7 @@ Attribute FontStyle.VB_Description = "Various font attributes that can be change ' Allows direct changes to font attributes -With UserControl.Font +With UserControl.font .Bold = ((nStyle And lv_Bold) = lv_Bold) .Italic = ((nStyle And lv_Italic) = lv_Italic) .Underline = ((nStyle And lv_Underline) = lv_Underline) @@ -710,9 +712,9 @@ RedrawButton End Property Public Property Get FontStyle() As FontStyles Dim nStyle As Integer -nStyle = nStyle Or Abs(UserControl.Font.Bold) * 2 -nStyle = nStyle Or Abs(UserControl.Font.Italic) * 4 -nStyle = nStyle Or Abs(UserControl.Font.Underline) * 8 +nStyle = nStyle Or Abs(UserControl.font.Bold) * 2 +nStyle = nStyle Or Abs(UserControl.font.Italic) * 4 +nStyle = nStyle Or Abs(UserControl.font.Underline) * 8 FontStyle = nStyle End Property @@ -1136,19 +1138,19 @@ End Select If (myImage.SourceSize.X + myImage.SourceSize.Y) > 0 Then ' image in use, calculations for image rectangle - If myImage.Size < 33 Then + If myImage.size < 33 Then Select Case myImage.Align Case lv_LeftEdge, lv_LeftOfCaption - imgOffset.Left = myImage.Size + imgOffset.Left = myImage.size bImgWidthAdj = True Case lv_RightEdge, lv_RightOfCaption - imgOffset.Right = myImage.Size + imgOffset.Right = myImage.size bImgWidthAdj = True Case lv_TopCenter - imgOffset.Top = myImage.Size + imgOffset.Top = myImage.size bImgHeightAdj = True Case lv_BottomCenter - imgOffset.Bottom = myImage.Size + imgOffset.Bottom = myImage.size bImgHeightAdj = True End Select End If @@ -1159,8 +1161,8 @@ If Len(myProps.bCaption) Then Dim sCaption As String ' note: Replace$ not compatible with VB5 sCaption = Replace$(myProps.bCaption, "||", vbNewLine) ' calculate total available button width available for text - cRect.Right = adjWidth - 8 - (myImage.Size * Abs(CInt(bImgWidthAdj))) - cRect.Bottom = ScaleHeight - 8 - (myImage.Size * Abs(CInt(bImgHeightAdj = True And myImage.Align > lv_RightOfCaption))) + cRect.Right = adjWidth - 8 - (myImage.size * Abs(CInt(bImgWidthAdj))) + cRect.Bottom = ScaleHeight - 8 - (myImage.size * Abs(CInt(bImgHeightAdj = True And myImage.Align > lv_RightOfCaption))) ' calculate size of rectangle to hold that text, using multiline flag DrawText ButtonDC.hDC, sCaption, Len(sCaption), cRect, DT_CALCRECT Or DT_WORDBREAK If myProps.bCaptionStyle Then @@ -1217,12 +1219,12 @@ If (myImage.SourceSize.X + myImage.SourceSize.Y) > 0 Then End Select If myImage.Align < lv_TopCenter Then OffsetRect tRect, 0, (ScaleHeight - cRect.Bottom) \ 2 - iRect.Top = (ScaleHeight - myImage.Size) \ 2 + iRect.Top = (ScaleHeight - myImage.size) \ 2 Else - iRect.Left = (adjWidth - myImage.Size) \ 2 + lEdge + iRect.Left = (adjWidth - myImage.size) \ 2 + lEdge End If - iRect.Right = iRect.Left + myImage.Size - iRect.Bottom = iRect.Top + myImage.Size + iRect.Right = iRect.Left + myImage.size + iRect.Bottom = iRect.Top + myImage.size Else OffsetRect tRect, 0, (ScaleHeight - cRect.Bottom) \ 2 End If @@ -1232,7 +1234,7 @@ If tRect.Left < 4 + lEdge Then tRect.Left = 4 + lEdge If tRect.Right > rEdge - 4 Then tRect.Right = rEdge - 4 If tRect.Bottom > ScaleHeight - 5 Then tRect.Bottom = ScaleHeight - 5 myProps.bRect = tRect -Select Case myImage.Size +Select Case myImage.size Case Is < 33 If iRect.Top < 4 Then iRect.Top = 4 If iRect.Left < 4 + lEdge Then iRect.Left = 4 + lEdge @@ -1367,7 +1369,7 @@ Select Case myProps.bShape ' resize the button to fit the image DelayDrawing True ScaleImage ScaleWidth, ScaleHeight, Wd, Ht - UserControl.Size Wd * Screen.TwipsPerPixelX, Ht * Screen.TwipsPerPixelY + UserControl.size Wd * Screen.TwipsPerPixelX, Ht * Screen.TwipsPerPixelY myProps.bSegPts.Y = ScaleWidth bNoRefresh = False rgn2Use = CreateRectRgn(0, 0, ScaleWidth, ScaleHeight) @@ -1587,9 +1589,9 @@ newDC = CreateCompatibleDC(UserControl.hDC) If myImage.Type Then ' icons myImage.TransImage = CreateCompatibleBitmap(UserControl.hDC, newSizeX, newSizeY) oldBMP = SelectObject(newDC, myImage.TransImage) - DrawIconEx newDC, 0, 0, myImage.Image.handle, newSizeX, newSizeY, 0&, 0&, &H3 + DrawIconEx newDC, 0, 0, myImage.Image.Handle, newSizeX, newSizeY, 0&, 0&, &H3 Else ' bitmaps - myImage.TransImage = CopyImage(myImage.Image.handle, myImage.Type, newSizeX, newSizeY, ByVal 0&) + myImage.TransImage = CopyImage(myImage.Image.Handle, myImage.Type, newSizeX, newSizeY, ByVal 0&) oldBMP = SelectObject(newDC, myImage.TransImage) End If ' determine the mask color (top left corner pixel) @@ -1793,7 +1795,7 @@ End If If myImage.Type = CI_ICON Then ' ' draw icon directly onto the temporary DC ' ' for icons, we can draw directly on the destination DC - DrawIconEx hMemDC, dRect.Left, dRect.Top, myImage.Image.handle, imgWidth, imgHeight, 0, 0, &H3 + DrawIconEx hMemDC, dRect.Left, dRect.Top, myImage.Image.Handle, imgWidth, imgHeight, 0, 0, &H3 Else ' draw transparent bitmap onto the temporary DC DrawTransparentBitmap hMemDC, dRect, myImage.TransImage, rcImage, , imgWidth, imgHeight @@ -1856,12 +1858,12 @@ Case "Font" ' called when font is changed or control is initialized Dim newFont As LOGFONT newFont.lfCharSet = 1 - newFont.lfFaceName = UserControl.Font.name & Chr$(0) - newFont.lfHeight = (UserControl.Font.Size * -20) / Screen.TwipsPerPixelY - newFont.lfWeight = UserControl.Font.Weight - newFont.lfItalic = Abs(CInt(UserControl.Font.Italic)) - newFont.lfStrikeOut = Abs(CInt(UserControl.Font.Strikethrough)) - newFont.lfUnderline = Abs(CInt(UserControl.Font.Underline)) + newFont.lfFaceName = UserControl.font.name & Chr$(0) + newFont.lfHeight = (UserControl.font.size * -20) / Screen.TwipsPerPixelY + newFont.lfWeight = UserControl.font.Weight + newFont.lfItalic = Abs(CInt(UserControl.font.Italic)) + newFont.lfStrikeOut = Abs(CInt(UserControl.font.Strikethrough)) + newFont.lfUnderline = Abs(CInt(UserControl.font.Underline)) If ButtonDC.OldFont Then DeleteObject SelectObject(ButtonDC.hDC, CreateFontIndirect(newFont)) Else @@ -1875,9 +1877,9 @@ Case "Picture" myImage.SourceSize.X = 0 myImage.SourceSize.Y = 0 Else - GetGDIObject myImage.Image.handle, LenB(bmpInfo), bmpInfo + GetGDIObject myImage.Image.Handle, LenB(bmpInfo), bmpInfo If bmpInfo.bmBits = 0 Then - GetIconInfo myImage.Image.handle, icoInfo + GetIconInfo myImage.Image.Handle, icoInfo If icoInfo.hbmColor <> 0 Then ' downside... API creates 2 bitmaps that we need to destroy since they aren't used in this ' routine & are not destroyed automatically. To prevent memory leak, we destroy them here @@ -2615,14 +2617,14 @@ Private Sub UserControl_OLECompleteDrag(Effect As Long) RaiseEvent OLECompleteDrag(Effect) End Sub -Private Sub UserControl_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) +Private Sub UserControl_OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) ' not used by me, but we'll send the event -RaiseEvent OLEDragDrop(Data, Effect, Button, Shift, X, Y) +RaiseEvent OLEDragDrop(data, Effect, Button, Shift, X, Y) End Sub -Private Sub UserControl_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) +Private Sub UserControl_OLEDragOver(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) ' not used by me, but we'll send the event -RaiseEvent OLEDragOver(Data, Effect, Button, Shift, X, Y, State) +RaiseEvent OLEDragOver(data, Effect, Button, Shift, X, Y, State) End Sub Private Sub UserControl_OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean) @@ -2630,14 +2632,14 @@ Private Sub UserControl_OLEGiveFeedback(Effect As Long, DefaultCursors As Boolea RaiseEvent OLEGiveFeedback(Effect, DefaultCursors) End Sub -Private Sub UserControl_OLESetData(Data As DataObject, DataFormat As Integer) +Private Sub UserControl_OLESetData(data As DataObject, DataFormat As Integer) ' not used by me, but we'll send the event -RaiseEvent OLESetData(Data, DataFormat) +RaiseEvent OLESetData(data, DataFormat) End Sub -Private Sub UserControl_OLEStartDrag(Data As DataObject, AllowedEffects As Long) +Private Sub UserControl_OLEStartDrag(data As DataObject, AllowedEffects As Long) ' not used by me, but we'll send the event -RaiseEvent OLEStartDrag(Data, AllowedEffects) +RaiseEvent OLEStartDrag(data, AllowedEffects) End Sub Private Sub UserControl_Paint() @@ -2663,7 +2665,7 @@ With myProps End With On Error Resume Next -If Not (TypeOf Parent Is MDIForm) Then Set UserControl.Font = Parent.Font +If Not (TypeOf Parent Is MDIForm) Then Set UserControl.font = Parent.font On Error GoTo 0 cParentBC = ConvertColor(Ambient.BackColor) curBackColor = vbButtonFace ' this will be the button's initial backcolor @@ -2698,7 +2700,7 @@ With PropBag myProps.bValue = .ReadProperty("Value", False) myProps.bCustomClick = .ReadProperty("CustomClick", 0) Set myImage.Image = .ReadProperty("Image", Nothing) - myImage.Size = .ReadProperty("ImgSize", 16) + myImage.size = .ReadProperty("ImgSize", 16) myImage.Align = .ReadProperty("ImgAlign", 0) myProps.bForeHover = .ReadProperty("cFHover", vbButtonText) UserControl.Enabled = .ReadProperty("Enabled", True) @@ -2738,7 +2740,7 @@ With PropBag .WriteProperty "CapAlign", myProps.bCaptionAlign, 0 .WriteProperty "BackStyle", myProps.bBackStyle, 0 .WriteProperty "Shape", myProps.bShape, 0 - .WriteProperty "Font", UserControl.Font, Nothing + .WriteProperty "Font", UserControl.font, Nothing .WriteProperty "cFore", UserControl.ForeColor, vbButtonText .WriteProperty "cFHover", myProps.bForeHover, vbButtonText .WriteProperty "cBhover", myProps.bBackHover, curBackColor @@ -2752,7 +2754,7 @@ With PropBag .WriteProperty "CustomClick", myProps.bCustomClick, 0 .WriteProperty "ImgAlign", myImage.Align, 0 .WriteProperty "Image", myImage.Image, Nothing - .WriteProperty "ImgSize", myImage.Size, 16 + .WriteProperty "ImgSize", myImage.size, 16 .WriteProperty "Enabled", UserControl.Enabled, True .WriteProperty "cBack", curBackColor .WriteProperty "mPointer", UserControl.MousePointer, 0 diff --git a/Codigo/LaVolpe Button/modLvTimer.bas b/Codigo/LaVolpe Button/modLvTimer.bas index 0751ca7..d224918 100644 --- a/Codigo/LaVolpe Button/modLvTimer.bas +++ b/Codigo/LaVolpe Button/modLvTimer.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modLvTimer" +'@Folder("WorldEditor.Modules") Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long) Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long diff --git a/Codigo/UcRenderOptions.ctl b/Codigo/UcRenderOptions.ctl new file mode 100644 index 0000000..626e557 --- /dev/null +++ b/Codigo/UcRenderOptions.ctl @@ -0,0 +1,223 @@ +VERSION 5.00 +Begin VB.UserControl UcRenderOptions + ClientHeight = 3690 + ClientLeft = 0 + ClientTop = 0 + ClientWidth = 2865 + ScaleHeight = 3690 + ScaleWidth = 2865 + Begin VB.Frame frameDraw + Caption = "Draw" + Height = 2955 + Left = 30 + TabIndex = 9 + Top = 630 + Width = 1455 + Begin VB.CheckBox chkBlocks + Caption = "Block" + Height = 315 + Left = 270 + TabIndex = 18 + Top = 2580 + Width = 975 + End + Begin VB.CheckBox chkTriggers + Caption = "Triggers" + Height = 315 + Left = 270 + TabIndex = 17 + Top = 2280 + Width = 975 + End + Begin VB.CheckBox chkExits + Caption = "Exits" + Height = 315 + Left = 270 + TabIndex = 16 + Top = 1980 + Width = 975 + End + Begin VB.CheckBox chkNpcs + Caption = "Npcs" + Height = 315 + Left = 270 + TabIndex = 15 + Top = 1680 + Width = 975 + End + Begin VB.CheckBox chkObjects + Caption = "Objects" + Height = 315 + Left = 270 + TabIndex = 14 + Top = 1380 + Value = 1 'Checked + Width = 975 + End + Begin VB.CheckBox chkLayer4 + Caption = "Layer 4" + Height = 315 + Left = 270 + TabIndex = 13 + Top = 1080 + Value = 1 'Checked + Width = 975 + End + Begin VB.CheckBox chkLayer3 + Caption = "Layer 3" + Height = 315 + Left = 270 + TabIndex = 12 + Top = 780 + Value = 1 'Checked + Width = 975 + End + Begin VB.CheckBox chkLayer2 + Caption = "Layer 2" + Height = 315 + Left = 270 + TabIndex = 11 + Top = 510 + Value = 1 'Checked + Width = 975 + End + Begin VB.CheckBox chkFloor + Caption = "Floor" + Height = 315 + Left = 270 + TabIndex = 10 + Top = 240 + Value = 1 'Checked + Width = 975 + End + End + Begin VB.Frame FrameSize + Caption = "Size" + Height = 555 + Left = 30 + TabIndex = 4 + Top = 30 + Width = 2745 + Begin VB.TextBox txtHeight + Height = 285 + Left = 2040 + TabIndex = 8 + Text = "100" + Top = 180 + Width = 615 + End + Begin VB.TextBox txtWidth + Height = 285 + Left = 810 + TabIndex = 6 + Text = "100" + Top = 180 + Width = 615 + End + Begin VB.Label lblHeight + Caption = "Height" + Height = 225 + Left = 1530 + TabIndex = 7 + Top = 210 + Width = 645 + End + Begin VB.Label lblWidth + Caption = "Width" + Height = 225 + Left = 300 + TabIndex = 5 + Top = 210 + Width = 645 + End + End + Begin VB.Frame FrameFormat + Caption = "Format" + Height = 1605 + Left = 1620 + TabIndex = 0 + Top = 630 + Width = 1155 + Begin VB.OptionButton optJpg + Caption = "Jpg" + Height = 285 + Left = 150 + TabIndex = 3 + Top = 1200 + Width = 885 + End + Begin VB.OptionButton optBmp + Caption = "Bmp" + Height = 285 + Left = 150 + TabIndex = 2 + Top = 810 + Width = 885 + End + Begin VB.OptionButton optPng + Caption = "Png" + Height = 285 + Left = 180 + TabIndex = 1 + Top = 420 + Value = -1 'True + Width = 885 + End + End +End +Attribute VB_Name = "UcRenderOptions" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'@Folder("WorldEditor.UserControls") +Option Explicit + +Public Sub ConfigureExporter(ByRef exporter As clsMapExport) + + Call exporter.SetOptions(GetOptions()) + +End Sub + +Private Function GetOptions() As MapExportOptions + +'TODO make validations + +GetOptions.Width = txtWidth.Text +GetOptions.Height = txtHeight.Text + +GetOptions.floor = IIf(chkFloor.Value = vbChecked, True, False) +GetOptions.layer2 = IIf(chkLayer2.Value = vbChecked, True, False) +GetOptions.layer3 = IIf(chkLayer3.Value = vbChecked, True, False) +GetOptions.layer4 = IIf(chkLayer4.Value = vbChecked, True, False) +GetOptions.objects = IIf(chkObjects.Value = vbChecked, True, False) +GetOptions.npcs = IIf(chkNpcs.Value = vbChecked, True, False) +GetOptions.exits = IIf(chkExits.Value = vbChecked, True, False) +GetOptions.triggers = IIf(chkTriggers.Value = vbChecked, True, False) +GetOptions.blocks = IIf(chkBlocks.Value = vbChecked, True, False) + +If optPng.Value Then + GetOptions.format = png +ElseIf optBmp.Value Then + GetOptions.format = bmp +Else + GetOptions.format = jpg +End If + +End Function + +Private Sub txtWidth_KeyPress(KeyAscii As Integer) + If (Not IsNumeric(Chr$(KeyAscii))) And _ + (KeyAscii <> 8) And _ + (KeyAscii <> 44) And _ + (KeyAscii <> 46) Then KeyAscii = 0 +End Sub + +Private Sub txtHeight_KeyPress(KeyAscii As Integer) + If (Not IsNumeric(Chr$(KeyAscii))) And _ + (KeyAscii <> 8) And _ + (KeyAscii <> 44) And _ + (KeyAscii <> 46) Then KeyAscii = 0 +End Sub + + diff --git a/Codigo/clsIniReader.cls b/Codigo/clsIniReader.cls index 8481a61..38c945e 100644 --- a/Codigo/clsIniReader.cls +++ b/Codigo/clsIniReader.cls @@ -11,6 +11,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False +'@Folder("WorldEditor.Class") '************************************************************** ' clsIniReader.cls - Loads INI files into memory and applies Binary Search to get values at high speed. ' Use it instead of GetVar when reading several values form the same file at once, otherwise it's not usefull. @@ -59,7 +60,7 @@ Option Base 0 Private Type ChildNode Key As String - value As String + Value As String End Type '' @@ -110,13 +111,13 @@ Private Sub Class_Terminate() 'Last Modify Date: 5/01/2006 ' '************************************************************** - Dim i As Long + Dim I As Long 'Clean up If MainNodes Then - For i = 1 To MainNodes - 1 - Erase fileData(i).values - Next i + For I = 1 To MainNodes - 1 + Erase fileData(I).values + Next I Erase fileData End If @@ -135,17 +136,17 @@ Public Sub Initialize(ByVal file As String) 'Last Modify Date: 5/01/2006 'Opens the requested file and loads it's data into memory '************************************************************** - Dim handle As Integer + Dim Handle As Integer Dim Text As String Dim Pos As Long 'Get a free handle and start reading line by line until the end - handle = FreeFile + Handle = FreeFile - Open file For Input As handle + Open file For Input As Handle - Do Until EOF(handle) - Line Input #handle, Text + Do Until EOF(Handle) + Line Input #Handle, Text 'Is it null?? If Len(Text) Then @@ -171,7 +172,7 @@ Public Sub Initialize(ByVal file As String) 'Add it to the main node's value ReDim Preserve .values(.numValues) As ChildNode - .values(.numValues).value = Right$(Text, Len(Text) - Pos) + .values(.numValues).Value = Right$(Text, Len(Text) - Pos) .values(.numValues).Key = UCase$(Left$(Text, Pos - 1)) .numValues = .numValues + 1 @@ -182,19 +183,19 @@ Public Sub Initialize(ByVal file As String) End If Loop - Close handle + Close Handle - Dim i As Long + Dim I As Long If MainNodes Then 'Sort main nodes to allow binary search Call SortMainNodes(0, MainNodes - 1) 'Sort values of each node to allow binary search - For i = 0 To MainNodes - 1 - If fileData(i).numValues Then _ - Call SortChildNodes(fileData(i), 0, fileData(i).numValues - 1) - Next i + For I = 0 To MainNodes - 1 + If fileData(I).numValues Then _ + Call SortChildNodes(fileData(I), 0, fileData(I).numValues - 1) + Next I End If End Sub @@ -303,18 +304,18 @@ Public Function GetValue(ByVal Main As String, ByVal Key As String) As String 'Last Modify Date: 5/01/2006 'Returns a value if the key and main node exist, or a nullstring otherwise '************************************************************** - Dim i As Long + Dim I As Long Dim j As Long 'Search for the main node - i = FindMain(UCase$(Main)) + I = FindMain(UCase$(Main)) - If i >= 0 Then + If I >= 0 Then 'If valid, binary search among keys - j = FindKey(fileData(i), UCase$(Key)) + j = FindKey(fileData(I), UCase$(Key)) 'If we found it we return it - If j >= 0 Then GetValue = fileData(i).values(j).value + If j >= 0 Then GetValue = fileData(I).values(j).Value End If End Function diff --git a/Codigo/clsInterval.cls b/Codigo/clsInterval.cls new file mode 100644 index 0000000..4eb7231 --- /dev/null +++ b/Codigo/clsInterval.cls @@ -0,0 +1,38 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "clsInterval" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'@Folder("WorldEditor.Class") +Option Explicit +'Private Declare Function GetTickCount Lib "kernel32" () As Long + +Private interval As Long +Private time As Long +Private can As Boolean +Public Sub Init(Inter As Long) + interval = Inter + time = GetTickCount + interval +End Sub +Public Function ICan() As Boolean + If GetTickCount <= interval Then + time = GetTickCount + interval + End If + If GetTickCount >= time Then + can = True + time = GetTickCount + interval + End If + + ICan = can + can = False + +End Function + diff --git a/Codigo/clsMapExport.cls b/Codigo/clsMapExport.cls new file mode 100644 index 0000000..645db59 --- /dev/null +++ b/Codigo/clsMapExport.cls @@ -0,0 +1,156 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "clsMapExport" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'@Folder("WorldEditor.Class") +Option Explicit +Public Event OnCaptured() + +Private WithEvents Picture As MyPicture +Attribute Picture.VB_VarHelpID = -1 +Private format As eFormatPic +Private device As Integer +Private formatExtension(3) As String +Private options As MapExportOptions + +Friend Sub SetOptions(ByRef newOptions As MapExportOptions) + options = newOptions +End Sub +Public Property Let OutputFormat(ByVal newFormat As eFormatPic) + format = newFormat +End Property + +Public Property Get OutputFormat() As eFormatPic + OutputFormat = format +End Property + +Public Sub SetPicture(ByRef slavePicture As MyPicture) + Set Picture = slavePicture + + Picture.Width = options.Width + Picture.Height = options.Height + + device = wGL_Graphic.Create_Device_From_Display(Picture.hwnd, options.Width, options.Height) +End Sub + +Public Sub Capture() + If device <> -1 Then + Call Invalidate(Picture.hwnd) + End If +End Sub + +Private Sub Class_Initialize() + device = -1 + Set Picture = Nothing + format = eFormatPic.bmp + + formatExtension(eFormatPic.bmp) = "bmp" + formatExtension(eFormatPic.jpg) = "jpg" + formatExtension(eFormatPic.png) = "png" + +End Sub + +Public Sub Save() + Call wGL_Graphic.Capture(Picture.hwnd, App.path & "\Renders\" & NumMap_Save & "." & formatExtension(options.format)) +End Sub + +Private Sub picture_Paint() + Call wGL_Graphic.Use_Device(device) + Call wGL_Graphic.Clear(CLEAR_COLOR Or CLEAR_DEPTH Or CLEAR_STENCIL, &H0, 1#, 0) + Call wGL_Graphic_Renderer.Update_Projection(&H0, 3200, 3200) + + Dim Drawable As Integer + Dim DrawableX As Integer + Dim DrawableY As Integer + + Dim X As Integer + Dim Y As Integer + + Dim MinY As Integer + Dim MaxY As Integer + Dim MinX As Integer + Dim MaxX As Integer + MinY = 1 + MaxY = 100 + MinX = 1 + MaxX = 100 + + + If options.floor Then + For Y = MinY To MaxY + DrawableY = (Y - 1) * TilePixelHeight + For X = MinX To MaxX + DrawableX = (X - 1) * TilePixelWidth + Call DrawGrh(MapData(X, Y).Graphic(1), DrawableX, DrawableY, GetDepth(1, X, Y), 0, 1) + Next X + Next Y + End If + + Dim Results() As wGL_Swarm_Result + Call g_Swarm.Query(MinX, MinY, MaxX, MaxY, Results) + + For Drawable = 0 To UBound(Results) + With Results(Drawable) + + DrawableX = (.X - 1) * TilePixelWidth + DrawableY = (.Y - 1) * TilePixelHeight + + Select Case (.Layer) + Case 1 + If options.layer2 Then + Call DrawGrh(MapData(.X, .Y).Graphic(2), DrawableX, DrawableY, GetDepth(2, .X, .Y), 1, 1) + End If + Case 2 + If options.layer3 Then + Call DrawGrh(MapData(.X, .Y).Graphic(3), DrawableX, DrawableY, GetDepth(3, .X, .Y, 2), 1, 1, , , , True) + End If + Case 3 + If options.layer4 Then + Call DrawGrh(MapData(.X, .Y).Graphic(4), DrawableX, DrawableY, GetDepth(4, .X, .Y), 1, 1) + End If + Case 4 + If options.objects Then + Call DrawGrh(MapData(.X, .Y).ObjGrh, DrawableX, DrawableY, GetDepth(3, .X, .Y, 1), 1, 1, , , , True) + End If + Case 5 + If options.npcs Then + Call CharRender(MapData(.X, .Y).CharIndex, DrawableX, DrawableY) + End If + Case modEdicion.BLOCK_LAYER + If options.blocks Then + Call DrawGrhIndex(modEdicion.BlockGrhIndex, DrawableX, DrawableY, GetDepth(modEdicion.BLOCK_LAYER, .X, .Y, 1), True) + End If + Case modEdicion.EXIT_LAYER + If options.exits Then + Call DrawGrhIndex(modEdicion.ExitGrhIndex, DrawableX, DrawableY, GetDepth(modEdicion.EXIT_LAYER, .X, .Y, 1), True) + End If + Case modEdicion.TRIGGER_LAYER + If options.triggers Then + Call Draw_Text(FuentesJuego.Talk.id, FuentesJuego.Talk.Tamanio, DrawableX + 16, DrawableY + 16, GetDepth(modEdicion.TRIGGER_LAYER, .X, .Y, 1), FuentesJuego.Talk.color, FONT_ALIGNMENT_MIDDLE Or FONT_ALIGNMENT_CENTER, CStr(MapData(.X, .Y).Trigger)) + End If + End Select + End With + Next Drawable + + Call wGL_Graphic_Renderer.Flush + Call wGL_Graphic.Commit + Call Save + RaiseEvent OnCaptured +End Sub + +Private Sub Class_Terminate() + On Error Resume Next + Set Picture = Nothing + Call wGL_Graphic.Destroy_Device(device) + device = -1 +End Sub + diff --git a/Codigo/clsSurfaceManDyn.cls b/Codigo/clsSurfaceManDyn.cls index 9a52982..b582c44 100644 --- a/Codigo/clsSurfaceManDyn.cls +++ b/Codigo/clsSurfaceManDyn.cls @@ -80,7 +80,7 @@ Private Declare Function GetTickCount Lib "kernel32" () As Long Private Const DIB_PAL_COLORS As Long = 1 Private Const DIB_RGB_COLORS As Long = 0 Private Declare Function SetDIBitsToDevice Lib "GDI32.dll" _ - (ByVal hdc As Long, ByVal XDest As Long, ByVal YDest As Long, _ + (ByVal hDC As Long, ByVal XDest As Long, ByVal YDest As Long, _ ByVal dwWidth As Long, ByVal dwHeight As Long, ByVal xSrc As Long, _ ByVal ySrc As Long, ByVal uStartScan As Long, ByVal CScanLine As Long, _ lpBits As Any, lpbmi As BITMAPINFO, ByVal fuColorUse As Long) As Long @@ -162,96 +162,7 @@ Private Property Get clsSurfaceManager_Surface(ByVal fileIndex As Long) As Direc End Property Private Function LoadSurface(ByVal fileIndex As Long) As DirectDrawSurface7 -'************************************************************** -'Author: Nicolas Matias Gonzalez (NIGO) -'Last Modify Date: 05/11/2009 -'Loads the surface named fileIndex + ".bmp" and inserts it to the -'surface list in the listIndex position -'************************************************************** -On Error GoTo ErrHandler - Dim newSurface As SURFACE_ENTRY_DYN - Dim ddsd As DDSURFACEDESC2 - Dim ddck As DDCOLORKEY - Dim data() As Byte - Dim bmpInfo As BITMAPINFO - Dim sDC As Long - - 'get Bitmap - Call Get_Bitmap(ResourcePath, CStr(fileIndex) & ".BMP", bmpInfo, data) - - 'Set up the surface desc - ddsd.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH - If useVideoMemory Then - ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY - Else - ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY - End If - ddsd.lWidth = bmpInfo.bmiHeader.biWidth - ddsd.lHeight = bmpInfo.bmiHeader.biHeight - - With newSurface - .fileIndex = fileIndex - - 'Set last access time (if we didn't we would reckon this texture as the one lru) - .lastAccess = GetTickCount - - 'Load surface - Set .Surface = DirectDraw.CreateSurface(ddsd) - - sDC = .Surface.GetDC - - Call SetDIBitsToDevice(sDC, 0, 0, bmpInfo.bmiHeader.biWidth, bmpInfo.bmiHeader.biHeight, 0, 0, 0, bmpInfo.bmiHeader.biHeight, data(0), bmpInfo, DIB_RGB_COLORS) - - Call .Surface.ReleaseDC(sDC) - - 'Set colorkey - ddck.high = 0 - ddck.low = 0 - Call .Surface.SetColorKey(DDCKEY_SRCBLT, ddck) - - 'Retrieve the updated surface desc - Call .Surface.GetSurfaceDesc(ddsd) - End With - - 'Insert surface to the list - With surfaceList(fileIndex Mod HASH_TABLE_SIZE) - .surfaceCount = .surfaceCount + 1 - - ReDim Preserve .SurfaceEntry(1 To .surfaceCount) As SURFACE_ENTRY_DYN - - .SurfaceEntry(.surfaceCount) = newSurface - - Set LoadSurface = newSurface.Surface - End With - - 'Update used bytes - usedBytes = usedBytes + ddsd.lHeight * ddsd.lPitch - - 'Check if we have exceeded our allowed share of memory usage - Do While usedBytes > maxBytesToUse - 'Remove a file. If no file could be removed we continue, if the file was previous to our surface we update the index - If Not RemoveLRU() Then - Exit Do - End If - Loop -Exit Function - -ErrHandler: - If Err.Number = DDERR_OUTOFMEMORY Or Err.Number = DDERR_OUTOFVIDEOMEMORY Then - 'Remove a surface and try again - If RemoveLRU() Then - Resume - Else - MsgBox "No hay memoria disponible! El programa abortará. Cierra algunos programas e intenta de nuevo" - End - End If - Else - MsgBox "Un error inesperado ocurrió al intentar cargar el gráfico " & CStr(fileIndex) & ".BMP" & ". " & vbCrLf & _ - "El código de error es " & CStr(Err.Number) & " - " & Err.Description & vbCrLf & vbCrLf & "Copia este mensaje y notifica a los administradores.", _ - vbOKOnly Or vbCritical Or vbExclamation, "Error" - End - End If End Function Private Function RemoveLRU() As Boolean diff --git a/Codigo/clsTextDrawer.cls b/Codigo/clsTextDrawer.cls index 04c9ac0..be4a1d2 100644 --- a/Codigo/clsTextDrawer.cls +++ b/Codigo/clsTextDrawer.cls @@ -11,6 +11,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False +'@Folder("WorldEditor.Class") Option Explicit Private Type RECTO ' xD @@ -20,22 +21,22 @@ Private Type RECTO ' xD Bottom As Long End Type -Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long -Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long -Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long -Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long -Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long +Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long +Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long +Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long +Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long +Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, _ - ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, _ + ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, _ ByVal u As Long, ByVal s As Long, ByVal c As Long, ByVal OP As Long, ByVal CP As Long, _ ByVal Q As Long, ByVal PAF As Long, ByVal f As String) As Long -Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long -Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long +Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As size) As Long +Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function InvalidateRect Lib "user32" ( _ ByVal hwnd As Long, lpRect As RECTO, ByVal bErase As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long -Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long +Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Const WM_PAINT As Long = &HF @@ -75,13 +76,13 @@ Private Const TEXTBUFFER_SIZE As Long = 1024 * 2 Private Type TextInfo X As Long - y As Long + Y As Long color As Long centered As Boolean Text As String End Type -Private Type Size +Private Type size cx As Long cy As Long End Type @@ -90,7 +91,7 @@ Private TextBuffer(TEXTBUFFER_SIZE - 1) As TextInfo Private textCount As Long Private lngFont As Long -Private oldFont As Long +Private OldFont As Long Private Const MAX_COLORS As Byte = 255 @@ -99,10 +100,10 @@ Private useVideoMemory As Boolean Private TextSurfaces(MAX_COLORS - 1) As Long Private Surface(MAX_COLORS - 1) As DirectDrawSurface7 Private CantColors As Long -Private surfacesize As Size +Private surfacesize As size Private letters As String Private lettersrect(255) As RECT - +Private font As Integer Public Function InitText(ByRef DD As DirectDraw7, ByVal videoMemory As Boolean) '************************************************************** 'Author: Alejandro Salvo (Salvito) @@ -110,221 +111,43 @@ Public Function InitText(ByRef DD As DirectDraw7, ByVal videoMemory As Boolean) ' '************************************************************** -Dim ret As Size + + font = wGL_Graphic_Renderer.Create_Font(LoadBytes("FONT/Primary.ttf")) + +Dim ret As size Dim tsize As Integer -Dim i As Long -Dim hdc As Long +Dim I As Long -Set DirectDraw = DD -useVideoMemory = videoMemory - -hdc = GetDC(frmMain.hwnd) -lngFont = CreateFont(13, 0, 0, 0, FW_BOLD, 0, 0, 0, DEFAULT_CHARSET, OUT_TT_ONLY_PRECIS, CLIP_LH_ANGLES Or CLIP_DEFAULT_PRECIS, PROOF_QUALITY, TRUETYPE_FONTTYPE, "Tahoma") ' Hardocodeo la que usan siempre, la de frmMain. -oldFont = SelectObject(hdc, lngFont) tsize = 0 letters = "" -For i = 32 To 255 - letters = letters & Chr$(i) - - Call GetTextExtentPoint32(hdc, Chr$(i), 1, ret) +For I = 32 To 255 + letters = letters & Chr$(I) - lettersrect(i).Left = tsize - lettersrect(i).Right = tsize + ret.cx - lettersrect(i).Top = 0 - lettersrect(i).Bottom = 13 + lettersrect(I).Left = tsize + lettersrect(I).Right = tsize + ret.cx + lettersrect(I).Top = 0 + lettersrect(I).Bottom = 13 tsize = tsize + ret.cx - If i = 126 Then i = 160 -Next i - -surfacesize.cy = ret.cy -surfacesize.cx = tsize - -If oldFont <> 0 Then - Call SelectObject(hdc, oldFont) -End If - -DeleteObject lngFont -Call ReleaseDC(frmMain.hwnd, hdc) + If I = 126 Then I = 160 +Next I -Set Surface(0) = CreateSurface(0) ' Creo el color Negro CantColors = 1 End Function -Private Function GetTextSurface(ByVal color As Long) As DirectDrawSurface7 -'************************************************************** -'Author: Alejandro Salvo (Salvito) -'Last Modify Date: 07/31/2010 -' -'************************************************************** -Dim i As Long - -For i = 0 To CantColors - If TextSurfaces(i) = color Then - Set GetTextSurface = Surface(i) - Exit Function - End If -Next i - -If CantColors < MAX_COLORS Then 'creo la nueva surface - Set Surface(CantColors) = CreateSurface(color) - TextSurfaces(CantColors) = color - Set GetTextSurface = Surface(CantColors) - CantColors = CantColors + 1 -End If - -End Function - -Private Function CreateSurface(ByVal color As Long) As DirectDrawSurface7 -'************************************************************** -'Author: Alejandro Salvo (Salvito) -'Last Modify Date: 07/31/2010 -' -'************************************************************** -On Error GoTo ErrHandler - - Dim newSurface As DirectDrawSurface7 - Dim ddsd As DDSURFACEDESC2 - Dim ddck As DDCOLORKEY - Dim bkcolor As Long - Dim hdc As Long - - 'Set up the surface desc - ddsd.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH - If useVideoMemory Then - ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY - Else - ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY - End If - ddsd.lWidth = surfacesize.cx - ddsd.lHeight = surfacesize.cy - - Set newSurface = DirectDraw.CreateSurface(ddsd) - bkcolor = &H0 - If color = vbBlack Then bkcolor = &H10101 - - 'Dibujo el texto - hdc = newSurface.GetDC - lngFont = CreateFont(13, 0, 0, 0, FW_BOLD, 0, 0, 0, DEFAULT_CHARSET, OUT_TT_ONLY_PRECIS, CLIP_LH_ANGLES Or CLIP_DEFAULT_PRECIS, PROOF_QUALITY, TRUETYPE_FONTTYPE, "Tahoma") ' Hardocodeo la que usan siempre, la de frmMain. - oldFont = SelectObject(hdc, lngFont) - SetBkMode hdc, TEXT_OPAQUE - SetBkColor hdc, bkcolor - SetTextColor hdc, color - TextOut hdc, 0, 0, letters, Len(letters) - If oldFont <> 0 Then Call SelectObject(hdc, oldFont) - DeleteObject lngFont - newSurface.ReleaseDC hdc - 'Podria haber usado el DrawText del dx aca, pero soy jodido - - ddck.high = bkcolor - ddck.low = bkcolor - Call newSurface.SetColorKey(DDCKEY_SRCBLT, ddck) - Set CreateSurface = newSurface - -Exit Function - -ErrHandler: - If Err.Number = DDERR_OUTOFVIDEOMEMORY Then - ' No video memory? Try system memory! We want all surfaces loaded! - ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY - Resume - End If - 'If Err.Number = DDERR_OUTOFMEMORY Or Err.Number = DDERR_OUTOFVIDEOMEMORY Then - ' MsgBox "No hay memoria disponible! El programa abortará. Cierra algunos programas e intenta de nuevo" - ' End - 'Else - MsgBox "Un error inesperado ocurrió al intentar crear el texto" & ". " & vbCrLf & _ - "El código de error es " & CStr(Err.Number) & " - " & Err.Description & vbCrLf & vbCrLf & "Copia este mensaje y notifica a los administradores.", _ - vbOKOnly Or vbCritical Or vbExclamation, "Error" - End - 'End If -End Function - -Public Function DrawText(ByVal X As Long, ByVal y As Long, ByRef Text As String, ByVal color As Long, ByRef Surface As DirectDrawSurface7) -'************************************************************** -'Author: Alejandro Salvo (Salvito) -'Last Modify Date: 07/31/2010 -' -'************************************************************** - Dim i As Integer - Dim tx As Long - Dim textSurface As DirectDrawSurface7 - Dim bytestring() As Byte - - bytestring = StrConv(Text, vbFromUnicode) - tx = X - - Set textSurface = GetTextSurface(color) - - For i = 0 To UBound(bytestring) - Call Surface.BltFast(tx, y, textSurface, lettersrect(bytestring(i)), DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT) - tx = tx + lettersrect(bytestring(i)).Right - lettersrect(bytestring(i)).Left - Next i -End Function -Public Function DrawTextToDC(ByVal hdc As Long, Optional ByVal Shadow As Boolean, Optional ByVal FontSize As Long = 13) As Long +Public Sub DrawText(ByVal X As Long, ByVal Y As Long, ByRef Text As String, ByVal color As Long, ByRef Surface As DirectDrawSurface7) '************************************************************** 'Author: Alejandro Salvo (Salvito) 'Last Modify Date: 07/31/2010 ' '************************************************************** -'Forma alternativa de dibujar texto con GDI -'La forma de usarla es llamando a la funcion AddText de ahi abajo -Dim i As Long -Dim lastcolor As Long -Dim ret As Size -Dim tRect As RECTO - -'Aplico mi font -lngFont = CreateFont(FontSize, 0, 0, 0, FW_BOLD, 0, 0, 0, DEFAULT_CHARSET, OUT_TT_ONLY_PRECIS, CLIP_LH_ANGLES Or CLIP_DEFAULT_PRECIS, PROOF_QUALITY, TRUETYPE_FONTTYPE, "Tahoma") ' Hardocodeo la que usan siempre, la de frmMain. -oldFont = SelectObject(hdc, lngFont) - -'Le doy fondo transparente -SetBkMode hdc, TEXT_TRANSPARENT - -'Primero dibujo toda la capa en negro -SetTextColor hdc, vbBlack - -If Shadow Then - For i = 0 To textCount - 1 - With (TextBuffer(i)) - If .centered Then ' ya lo dejo acomodado - Call GetTextExtentPoint32(hdc, .Text, Len(.Text), ret) - .X = .X - ret.cx \ 2 - .y = .y - ret.cy \ 2 - End If - - TextOut hdc, .X - 2, .y - 1, .Text, Len(.Text) - End With - Next i -End If - -'Y ahora toda la capa en color -For i = 0 To textCount - 1 - With (TextBuffer(i)) - If .color <> lastcolor Then ' si es igual me ahorro una llamada a un api, costo beneficio me va - SetTextColor hdc, .color - lastcolor = .color - End If - - If (Not Shadow) And .centered Then - Call GetTextExtentPoint32(hdc, .Text, Len(.Text), ret) - .X = .X - ret.cx \ 2 - .y = .y - ret.cy \ 2 - End If - - TextOut hdc, .X, .y, .Text, Len(.Text) - End With -Next i - +End Sub -textCount = 0 ' Se resetea -If oldFont <> 0 Then Call SelectObject(hdc, oldFont) -DeleteObject lngFont +Public Function DrawTextToDC(ByVal hDC As Long, Optional ByVal Shadow As Boolean, Optional ByVal FontSize As Long = 13) As Long -DrawTextToDC = 0 End Function Public Function AddText(ByVal xPos As Integer, ByVal yPos As Integer, ByVal fontcolor As Long, ByRef strText As String, Optional ByVal centered As Boolean = False) As Long @@ -338,7 +161,7 @@ If LenB(strText) > 0 Then If textCount < TEXTBUFFER_SIZE Then With TextBuffer(textCount) .X = xPos - .y = yPos + .Y = yPos .color = fontcolor .Text = strText .centered = centered @@ -359,10 +182,10 @@ Private Sub Class_Terminate() ' '************************************************************** -Dim i As Long +Dim I As Long -For i = 0 To CantColors - Set Surface(i) = Nothing -Next i +For I = 0 To CantColors + Set Surface(I) = Nothing +Next I End Sub diff --git a/Codigo/frmAbout.frm b/Codigo/frmAbout.frm index de60459..0c8767c 100644 --- a/Codigo/frmAbout.frm +++ b/Codigo/frmAbout.frm @@ -21,24 +21,15 @@ Begin VB.Form frmAbout TabIndex = 4 Top = 3840 Width = 1335 - _ExtentX = 2355 - _ExtentY = 661 - Caption = "&Aceptar" - CapAlign = 2 - BackStyle = 2 - BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - cGradient = 0 - Mode = 0 - Value = 0 'False - cBack = -2147483633 + _extentx = 2355 + _extenty = 661 + caption = "&Aceptar" + capalign = 2 + backstyle = 2 + cgradient = 0 + mode = 0 + value = 0 + cback = -2147483633 End Begin VB.Label lblTitle AutoSize = -1 'True @@ -201,6 +192,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form.Helpers") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by diff --git a/Codigo/frmAutoGuardarMapa.frm b/Codigo/frmAutoGuardarMapa.frm index 73f5b53..ce2f8bf 100644 --- a/Codigo/frmAutoGuardarMapa.frm +++ b/Codigo/frmAutoGuardarMapa.frm @@ -24,8 +24,8 @@ Begin VB.Form frmAutoGuardarMapa CapAlign = 2 BackStyle = 2 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False @@ -49,8 +49,8 @@ Begin VB.Form frmAutoGuardarMapa CapAlign = 2 BackStyle = 2 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False @@ -93,8 +93,8 @@ Begin VB.Form frmAutoGuardarMapa CapAlign = 2 BackStyle = 2 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False @@ -165,6 +165,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by diff --git a/Codigo/frmCargando.frm b/Codigo/frmCargando.frm index 9197629..e206ea8 100644 --- a/Codigo/frmCargando.frm +++ b/Codigo/frmCargando.frm @@ -263,6 +263,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form.Helpers") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by diff --git a/Codigo/frmConfigSup.frm b/Codigo/frmConfigSup.frm index a416fba..5077486 100644 --- a/Codigo/frmConfigSup.frm +++ b/Codigo/frmConfigSup.frm @@ -19,24 +19,15 @@ Begin VB.Form frmConfigSup TabIndex = 15 Top = 2280 Width = 1935 - _ExtentX = 3413 - _ExtentY = 661 - Caption = "&Aceptar" - CapAlign = 2 - BackStyle = 2 - BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - cGradient = 0 - Mode = 0 - Value = 0 'False - cBack = -2147483633 + _extentx = 3413 + _extenty = 661 + caption = "&Aceptar" + capalign = 2 + backstyle = 2 + cgradient = 0 + mode = 0 + value = 0 + cback = -2147483633 End Begin VB.CommandButton cmdDM Caption = "+" @@ -362,6 +353,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form.Tools") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -490,6 +482,6 @@ Private Sub MOSAICO_Click() If Val(mAncho.Text) <= 0 Then mAncho.Text = "1" If Val(mLargo.Text) <= 0 Then mLargo.Text = "1" -MosaicoChecked = (MOSAICO.value = vbChecked) +MosaicoChecked = (MOSAICO.Value = vbChecked) Call ActualizarMosaico End Sub diff --git a/Codigo/frmErrors.frm b/Codigo/frmErrors.frm new file mode 100644 index 0000000..a58786a --- /dev/null +++ b/Codigo/frmErrors.frm @@ -0,0 +1,56 @@ +VERSION 5.00 +Begin VB.Form frmErrors + BorderStyle = 1 'Fixed Single + Caption = "Errores" + ClientHeight = 2445 + ClientLeft = 45 + ClientTop = 390 + ClientWidth = 8250 + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + Moveable = 0 'False + ScaleHeight = 163 + ScaleMode = 3 'Pixel + ScaleWidth = 550 + StartUpPosition = 2 'CenterScreen + Begin VB.TextBox txtErrors + Enabled = 0 'False + Height = 2025 + Left = 180 + MultiLine = -1 'True + TabIndex = 0 + Top = 210 + Width = 7905 + End +End +Attribute VB_Name = "frmErrors" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +'@Folder("WorldEditor.Form.Helpers") +Option Explicit +Public Sub AddError(message As String) + txtErrors.Text = txtErrors.Text & message & vbCrLf +End Sub + +Public Sub ClearErrors() + txtErrors.Text = "" +End Sub + +Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) + If KeyCode = vbKeyEscape Then + Me.Hide + End If +End Sub +Private Sub txtErrors_KeyUp(KeyCode As Integer, Shift As Integer) + If KeyCode = vbKeyEscape Then + Me.Hide + End If +End Sub + +Public Function HasErrors() As Boolean + HasErrors = LenB(txtErrors.Text) > 0 +End Function + diff --git a/Codigo/frmFKEditor.frm b/Codigo/frmFKEditor.frm index 64cd6b0..bceb642 100644 --- a/Codigo/frmFKEditor.frm +++ b/Codigo/frmFKEditor.frm @@ -89,6 +89,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form") Option Explicit Private bLluvia() As Byte diff --git a/Codigo/frmGrafico.frm b/Codigo/frmGrafico.frm index 2975b85..ab4fa64 100644 --- a/Codigo/frmGrafico.frm +++ b/Codigo/frmGrafico.frm @@ -53,6 +53,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by diff --git a/Codigo/frmInformes.frm b/Codigo/frmInformes.frm index 59c2d58..37f3477 100644 --- a/Codigo/frmInformes.frm +++ b/Codigo/frmInformes.frm @@ -1,17 +1,39 @@ VERSION 5.00 +Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.ocx" Begin VB.Form frmInformes BorderStyle = 1 'Fixed Single Caption = "Informes" ClientHeight = 5565 ClientLeft = 45 ClientTop = 435 - ClientWidth = 6645 + ClientWidth = 12315 Icon = "frmInformes.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 5565 - ScaleWidth = 6645 + ScaleWidth = 12315 StartUpPosition = 2 'CenterScreen + Begin MSComctlLib.ListView lstObjResults + DragMode = 1 'Automatic + Height = 3735 + Left = 6720 + TabIndex = 6 + Top = 120 + Width = 5535 + _ExtentX = 9763 + _ExtentY = 6588 + View = 3 + LabelWrap = -1 'True + HideSelection = -1 'True + Checkboxes = -1 'True + FlatScrollBar = -1 'True + _Version = 393217 + ForeColor = -2147483640 + BackColor = -2147483643 + BorderStyle = 1 + Appearance = 1 + NumItems = 0 + End Begin VB.TextBox txtInfo Height = 3855 Left = 120 @@ -24,18 +46,18 @@ Begin VB.Form frmInformes End Begin WorldEditor.lvButtons_H cmdObjetos Height = 495 - Left = 120 + Left = 240 TabIndex = 1 Top = 4200 - Width = 2055 - _ExtentX = 3625 + Width = 1515 + _ExtentX = 2672 _ExtentY = 873 Caption = "&Objetos" CapAlign = 2 BackStyle = 2 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False @@ -59,8 +81,8 @@ Begin VB.Form frmInformes CapAlign = 2 BackStyle = 2 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False @@ -74,18 +96,18 @@ Begin VB.Form frmInformes End Begin WorldEditor.lvButtons_H cmdTranslados Height = 495 - Left = 2280 + Left = 3360 TabIndex = 3 Top = 4200 - Width = 2175 - _ExtentX = 3836 + Width = 1515 + _ExtentX = 2672 _ExtentY = 873 Caption = "&Translados" CapAlign = 2 BackStyle = 2 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False @@ -99,18 +121,68 @@ Begin VB.Form frmInformes End Begin WorldEditor.lvButtons_H cmdNPCs Height = 495 - Left = 4560 + Left = 4920 TabIndex = 4 Top = 4200 - Width = 1935 - _ExtentX = 3413 + Width = 1515 + _ExtentX = 2672 _ExtentY = 873 Caption = "&NPCs/Hostiles" CapAlign = 2 BackStyle = 2 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + cGradient = 0 + Mode = 0 + Value = 0 'False + cBack = -2147483633 + End + Begin WorldEditor.lvButtons_H cmdArboles + Height = 495 + Left = 1800 + TabIndex = 5 + Top = 4200 + Width = 1515 + _ExtentX = 2672 + _ExtentY = 873 + Caption = "&Recursos" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + cGradient = 0 + Mode = 0 + Value = 0 'False + cBack = -2147483633 + End + Begin WorldEditor.lvButtons_H cmdBorrarObjetos + Height = 495 + Left = 6720 + TabIndex = 7 + Top = 3960 + Width = 5475 + _ExtentX = 9657 + _ExtentY = 873 + Caption = "&Eliminar Objetos Seleccionados" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False @@ -156,6 +228,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form.Tools") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -177,6 +250,15 @@ Attribute VB_Exposed = False '************************************************************** Option Explicit +Private Sub cmdArboles_Click() + Call SetObjRemoveVisibility(False) + Call InformeRecursos +End Sub + +Private Sub cmdBorrarObjetos_Click() + Call BorrarObjetosSeleccionados +End Sub + Private Sub cmdCerrar_Click() '************************************************* 'Author: ^[GS]^ @@ -186,10 +268,10 @@ Unload Me End Sub '' -' Genera el informe de Objetos +' Genera el informe de Recursos (Arboles, Yacimientos, Cardúmenes ' -Private Sub ActalizarObjetos() +Private Sub InformeRecursos() '************************************************* 'Author: ^[GS]^ 'Last modified: 20/05/06 @@ -202,18 +284,77 @@ If Not MapaCargado Then Exit Sub End If -txtInfo.Text = "Informe de Objetos (X,Y)" +txtInfo.Text = "Informe de Recursos (X,Y)" For Y = YMinMapSize To YMaxMapSize For X = XMinMapSize To XMaxMapSize If MapData(X, Y).OBJInfo.objindex > 0 Then - txtInfo.Text = txtInfo.Text & vbCrLf & X & "," & Y & " tiene " & MapData(X, Y).OBJInfo.Amount & " del Objeto " & MapData(X, Y).OBJInfo.objindex & " - " & ObjData(MapData(X, Y).OBJInfo.objindex).name + If IsResource(ObjData(MapData(X, Y).OBJInfo.objindex).ObjType) Then + txtInfo.Text = txtInfo.Text & vbCrLf & X & "," & Y & " tiene " & MapData(X, Y).OBJInfo.Amount & " del Objeto " & MapData(X, Y).OBJInfo.objindex & " - " & ObjData(MapData(X, Y).OBJInfo.objindex).Name + End If End If Next X Next Y End Sub +'' +' Genera el informe de Objetos +' + +Private Sub ActalizarObjetos() +'************************************************* +'Author: ^[GS]^ +'Last modified: 20/05/06 +'************************************************* +On Error Resume Next + Dim Y As Integer + Dim X As Integer + Dim Count As Integer + Dim lstItem As listItem + + + If Not MapaCargado Then + Exit Sub + End If + + Call SetObjRemoveVisibility(True) + txtInfo.Text = "Informe de Objetos (X,Y)" + + lstObjResults.ListItems.Clear + With lstObjResults + .ColumnHeaders.Clear + .ColumnHeaders.Add 1, , "", 300 + .ColumnHeaders.Add 2, , "X-Y", 800 + .ColumnHeaders.Add 3, , "Amount", 1000 + .ColumnHeaders.Add 4, , "Objeto", .Width + End With + + Count = 1 + + For Y = YMinMapSize To YMaxMapSize + For X = XMinMapSize To XMaxMapSize + If MapData(X, Y).OBJInfo.objindex > 0 Then + If Not IsResource(ObjData(MapData(X, Y).OBJInfo.objindex).ObjType) Then + + txtInfo.Text = txtInfo.Text & vbCrLf & X & "," & Y & " tiene " & MapData(X, Y).OBJInfo.Amount & " " & ObjData(MapData(X, Y).OBJInfo.objindex).name + With lstObjResults + Set lstItem = .ListItems.Add(, , Count) + lstItem.SubItems(1) = X & "-" & Y + lstItem.SubItems(2) = MapData(X, Y).OBJInfo.Amount + lstItem.SubItems(3) = ObjData(MapData(X, Y).OBJInfo.objindex).name & " (" & MapData(X, Y).OBJInfo.objindex & ")" + End With + + Count = Count + 1 + End If + End If + Next X + Next Y + + lstObjResults.Refresh + +End Sub + '' ' Genera el informe de NPCs ' @@ -240,9 +381,9 @@ For Y = YMinMapSize To YMaxMapSize If NPCIndex > 0 Then If NpcData(NPCIndex).Hostile Then - txtInfo.Text = txtInfo.Text & vbCrLf & X & "," & Y & " tiene " & NpcData(NPCIndex).name & " (Hostil)" + txtInfo.Text = txtInfo.Text & vbCrLf & X & "," & Y & " tiene " & NpcData(NPCIndex).Name & " (Hostil)" Else - txtInfo.Text = txtInfo.Text & vbCrLf & X & "," & Y & " tiene " & NpcData(NPCIndex).name + txtInfo.Text = txtInfo.Text & vbCrLf & X & "," & Y & " tiene " & NpcData(NPCIndex).Name End If End If Next X @@ -290,6 +431,7 @@ Private Sub cmdNPCs_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* +Call SetObjRemoveVisibility(False) Call ActalizarNPCs End Sub @@ -298,6 +440,7 @@ Private Sub cmdObjetos_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* +Call SetObjRemoveVisibility(True) Call ActalizarObjetos End Sub @@ -306,5 +449,65 @@ Private Sub cmdTranslados_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* +Call SetObjRemoveVisibility(False) Call ActalizarTranslados End Sub + + +Private Function IsResource(ByVal ObjType As Integer) As Boolean + IsResource = ObjType = 4 Or ObjType = 22 Or ObjType = 45 +End Function + +Private Sub AddObjectToList(ByVal index As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal objindex As Integer) +On Error GoTo ErrHandler + + Dim listItem As MSComctlLib.listItem + + Set listItem = lstObjResults.ListItems.Add(index, "", X & "-" & Y & " - " & MapData(X, Y).OBJInfo.Amount & " - " & ObjData(MapData(X, Y).OBJInfo.objindex).name) + Call listItem.ListSubItems.Add(1, "", X & "-" & Y) + + Exit Sub + +ErrHandler: + Debug.Print Err.Number + +End Sub + + +Private Sub SetObjRemoveVisibility(ByVal Visible As Boolean) + If Visible Then + Me.Width = 12400 + Call cmdBorrarObjetos.SetFocus + Else + Me.Width = 6720 + Call Me.SetFocus + End If +End Sub + +Private Sub BorrarObjetosSeleccionados() +On Error GoTo ErrHandler + Dim I As Integer + + Dim X As Integer + Dim Y As Integer + Dim TxtCoords() As String + + If MsgBox("¿Deseas eliminar los objetos de las coordenadas seleccionadas?", vbYesNo) = vbYes Then + For I = 1 To lstObjResults.ListItems.Count + If lstObjResults.ListItems.Item(I).Checked Then + TxtCoords = Split(lstObjResults.ListItems.Item(I).ListSubItems(1).Text, "-") + X = Int(TxtCoords(0)) + Y = Int(TxtCoords(1)) + Call QuitarObjeto(X, Y, True) + End If + Next I + + Call ActalizarObjetos + End If + + Exit Sub + +ErrHandler: + Debug.Print Err.Number +End Sub + diff --git a/Codigo/frmMain.frm b/Codigo/frmMain.frm index 4ca5395..ad2bff9 100644 --- a/Codigo/frmMain.frm +++ b/Codigo/frmMain.frm @@ -1,30 +1,221 @@ VERSION 5.00 -Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.OCX" +Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" +Object = "{97FD4A65-A045-4F5C-8C6C-262505F7C013}#6.0#0"; "Argentum.ocx" Begin VB.Form frmMain BorderStyle = 1 'Fixed Single Caption = "WorldEditor" - ClientHeight = 10740 + ClientHeight = 13680 ClientLeft = 390 ClientTop = 840 - ClientWidth = 15270 + ClientWidth = 21735 Icon = "frmMain.frx":0000 KeyPreview = -1 'True LinkTopic = "Form1" - ScaleHeight = 716 + ScaleHeight = 912 ScaleMode = 3 'Pixel - ScaleWidth = 1018 + ScaleWidth = 1449 StartUpPosition = 1 'CenterOwner Visible = 0 'False WindowState = 2 'Maximized + Begin VB.Timer Timer_KeyPress + Interval = 1 + Left = 720 + Top = 12120 + End + Begin VB.Frame frameSurface + Caption = "Surface" + Height = 4815 + Left = 30 + TabIndex = 33 + Top = 1800 + Width = 4335 + Begin VB.ComboBox cGrh + Appearance = 0 'Flat + BackColor = &H80000012& + ForeColor = &H80000014& + Height = 330 + Left = 2880 + TabIndex = 40 + Text = "1" + Top = 3360 + Width = 1335 + End + Begin VB.ComboBox cCapas + Appearance = 0 'Flat + BackColor = &H80000012& + ForeColor = &H80000014& + Height = 330 + ItemData = "frmMain.frx":628A + Left = 1080 + List = "frmMain.frx":629A + TabIndex = 39 + Text = "1.Piso" + Top = 3360 + Width = 1335 + End + Begin VB.ListBox lListado + BackColor = &H80000012& + ForeColor = &H80000014& + Height = 2400 + Index = 0 + ItemData = "frmMain.frx":62C5 + Left = 120 + List = "frmMain.frx":62CC + Sorted = -1 'True + TabIndex = 38 + Tag = "-1" + Top = 240 + Width = 4095 + End + Begin VB.ComboBox cFiltro + BackColor = &H80000012& + ForeColor = &H80000014& + Height = 330 + Index = 0 + Left = 600 + TabIndex = 37 + Top = 2880 + Width = 3615 + End + Begin WorldEditor.lvButtons_H cQuitarEnTodasLasCapas + Height = 375 + Left = 120 + TabIndex = 34 + Top = 4200 + Width = 2175 + _ExtentX = 3836 + _ExtentY = 661 + Caption = "Quitar en &Capas 2 y 3" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 + End + Begin WorldEditor.lvButtons_H cQuitarEnEstaCapa + Height = 375 + Left = 120 + TabIndex = 35 + Top = 3840 + Width = 2175 + _ExtentX = 3836 + _ExtentY = 661 + Caption = "&Quitar en esta Capa" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 + End + Begin WorldEditor.lvButtons_H cSeleccionarSuperficie + Height = 735 + Left = 2400 + TabIndex = 36 + Top = 3840 + Width = 1815 + _ExtentX = 3201 + _ExtentY = 1296 + Caption = "&Insertar Superficie" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 + End + Begin VB.Label lbFiltrar + AutoSize = -1 'True + BackColor = &H80000012& + Caption = "Filtrar:" + ForeColor = &H80000014& + Height = 210 + Index = 0 + Left = 120 + TabIndex = 43 + Top = 2880 + Width = 450 + End + Begin VB.Label lbGrh + AutoSize = -1 'True + BackColor = &H80000012& + Caption = "Grh:" + ForeColor = &H80000014& + Height = 210 + Left = 2520 + TabIndex = 42 + Top = 3360 + Width = 315 + End + Begin VB.Label lbCapas + AutoSize = -1 'True + BackColor = &H80000012& + Caption = "Capa Actual:" + ForeColor = &H80000014& + Height = 210 + Left = 120 + TabIndex = 41 + Top = 3360 + Width = 930 + End + End + Begin ArgentumOCX.MyPicture PreviewGrh + CausesValidation= 0 'False + Height = 3735 + Left = 30 + TabIndex = 32 + Top = 6600 + Width = 4335 + _ExtentX = 7646 + _ExtentY = 6588 + End + Begin ArgentumOCX.MyPicture picMain + CausesValidation= 0 'False + Height = 12015 + Left = 4380 + TabIndex = 31 + Top = 900 + Width = 16455 + _ExtentX = 29025 + _ExtentY = 21193 + End Begin VB.PictureBox picRadar BackColor = &H00400040& BorderStyle = 0 'None Height = 1590 - Left = 120 + Left = 30 ScaleHeight = 106 ScaleMode = 3 'Pixel ScaleWidth = 107 - TabIndex = 97 + TabIndex = 28 Top = 120 Width = 1605 Begin VB.Label FPS @@ -44,7 +235,7 @@ Begin VB.Form frmMain ForeColor = &H00C0FFFF& Height = 150 Left = 1065 - TabIndex = 99 + TabIndex = 30 Top = 1440 Width = 450 End @@ -64,7 +255,7 @@ Begin VB.Form frmMain ForeColor = &H00FFFFFF& Height = 150 Left = 120 - TabIndex = 98 + TabIndex = 29 Top = 1440 Width = 675 End @@ -88,1681 +279,1270 @@ Begin VB.Form frmMain End End Begin WorldEditor.lvButtons_H SelectPanel - Height = 1035 + Height = 435 Index = 6 - Left = 13320 - TabIndex = 46 - Top = 30 - Width = 1815 - _extentx = 3201 - _extenty = 1826 - caption = "Tri&gger's (F12)" - capalign = 2 - backstyle = 2 - shape = 1 - cgradient = 8421631 - mode = 1 - value = 0 'False - customclick = 1 - imgsize = 24 - imgalign = 5 - cback = -2147483633 - lockhover = 1 + Left = 15330 + TabIndex = 24 + Top = 60 + Width = 1725 + _ExtentX = 3043 + _ExtentY = 767 + Caption = "Tri&gger's (F12)" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + LockHover = 1 + cGradient = 8421631 + Mode = 1 + Value = 0 'False + CustomClick = 1 + ImgAlign = 5 + ImgSize = 24 + cBack = -2147483633 End Begin WorldEditor.lvButtons_H SelectPanel - Height = 1035 + Height = 435 Index = 5 - Left = 11805 - TabIndex = 45 - Top = 30 - Width = 2565 - _extentx = 4524 - _extenty = 1826 - caption = "&Objetos (F11)" - capalign = 2 - backstyle = 2 - shape = 3 - cgradient = 8421631 - mode = 1 - value = 0 'False - customclick = 1 - imgsize = 24 - imgalign = 5 - cback = -2147483633 - lockhover = 1 + Left = 13530 + TabIndex = 23 + Top = 60 + Width = 1725 + _ExtentX = 3043 + _ExtentY = 767 + Caption = "&Objetos (F11)" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + LockHover = 1 + cGradient = 8421631 + Mode = 1 + Value = 0 'False + CustomClick = 1 + ImgAlign = 5 + ImgSize = 24 + cBack = -2147483633 End Begin WorldEditor.lvButtons_H SelectPanel - Height = 1035 + Height = 435 Index = 4 - Left = 10320 - TabIndex = 44 - Top = 30 - Width = 2535 - _extentx = 4471 - _extenty = 1826 - caption = "NPC's &Hostiles (F9)" - capalign = 2 - backstyle = 2 - shape = 3 - cgradient = 8421631 - mode = 1 - value = 0 'False - customclick = 1 - imgsize = 24 - imgalign = 5 - cback = -2147483633 - lockhover = 1 + Left = 11730 + TabIndex = 22 + Top = 60 + Width = 1725 + _ExtentX = 3043 + _ExtentY = 767 + Caption = "NPC's &Hostiles (F9)" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + LockHover = 1 + cGradient = 8421631 + Mode = 1 + Value = 0 'False + CustomClick = 1 + ImgAlign = 5 + ImgSize = 24 + cBack = -2147483633 End Begin WorldEditor.lvButtons_H SelectPanel - Height = 1035 + Height = 435 Index = 3 - Left = 8955 - TabIndex = 43 - Top = 30 - Width = 2415 - _extentx = 4260 - _extenty = 1826 - caption = "&NPC's (F8)" - capalign = 2 - backstyle = 2 - shape = 3 - cgradient = 8421631 - mode = 1 - value = 0 'False - customclick = 1 - imgsize = 24 - imgalign = 5 - cback = -2147483633 - lockhover = 1 + Left = 9930 + TabIndex = 21 + Top = 60 + Width = 1725 + _ExtentX = 3043 + _ExtentY = 767 + Caption = "&NPC's (F8)" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + LockHover = 1 + cGradient = 8421631 + Mode = 1 + Value = 0 'False + CustomClick = 1 + ImgAlign = 5 + ImgSize = 24 + cBack = -2147483633 End Begin WorldEditor.lvButtons_H SelectPanel - Height = 1035 + Height = 435 Index = 2 - Left = 7440 - TabIndex = 42 - Top = 30 - Width = 2565 - _extentx = 4524 - _extenty = 1826 - caption = "&Bloqueos (F7)" - capalign = 2 - backstyle = 2 - shape = 3 - cgradient = 8421631 - mode = 1 - value = 0 'False - customclick = 1 - imgsize = 24 - imgalign = 5 - cback = -2147483633 - lockhover = 1 + Left = 8130 + TabIndex = 20 + Top = 60 + Width = 1725 + _ExtentX = 3043 + _ExtentY = 767 + Caption = "&Bloqueos (F7)" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + LockHover = 1 + cGradient = 8421631 + Mode = 1 + Value = 0 'False + CustomClick = 1 + ImgAlign = 5 + ImgSize = 24 + cBack = -2147483633 End Begin WorldEditor.lvButtons_H SelectPanel - Height = 1035 + Height = 435 Index = 1 - Left = 5925 - TabIndex = 41 - Top = 30 - Width = 2565 - _extentx = 4524 - _extenty = 1826 - caption = "&Translados (F6)" - capalign = 2 - backstyle = 2 - shape = 3 - cgradient = 8421631 - mode = 1 - value = 0 'False - imgsize = 24 - imgalign = 5 - cback = -2147483633 - lockhover = 1 + Left = 6330 + TabIndex = 19 + Top = 60 + Width = 1725 + _ExtentX = 3043 + _ExtentY = 767 + Caption = "&Translados (F6)" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + LockHover = 1 + cGradient = 8421631 + Mode = 1 + Value = 0 'False + ImgAlign = 5 + ImgSize = 24 + cBack = -2147483633 End Begin WorldEditor.lvButtons_H SelectPanel - Height = 1035 - Index = 0 - Left = 5160 - TabIndex = 40 - Top = 30 - Width = 1815 - _extentx = 3201 - _extenty = 1826 - caption = "&Superficie (F5)" - capalign = 2 - backstyle = 2 - shape = 2 - cgradient = 8421631 - cfore = 0 - mode = 1 - value = 0 'False - imgsize = 24 - imgalign = 5 - cfhover = 0 - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cmdQuitarFunciones Height = 435 - Left = 1800 - TabIndex = 39 - ToolTipText = "Quitar Todas las Funciones Activadas" - Top = 1320 - Width = 2655 - _extentx = 4683 - _extenty = 767 - caption = "&Quitar Funciones (F4)" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 0 - value = 0 'False - cback = 12632319 + Index = 0 + Left = 4530 + TabIndex = 18 + Top = 60 + Width = 1725 + _ExtentX = 3043 + _ExtentY = 767 + Caption = "&Superficie (F5)" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + cFore = 0 + cFHover = 0 + cGradient = 8421631 + Mode = 1 + Value = 0 'False + ImgAlign = 5 + ImgSize = 24 + cBack = -2147483633 End Begin VB.Timer TimAutoGuardarMapa Enabled = 0 'False Interval = 60000 - Left = 3960 - Top = 1920 + Left = 1920 + Top = 12120 End Begin VB.TextBox StatTxt Alignment = 2 'Center - Appearance = 0 'Flat BackColor = &H80000012& BorderStyle = 0 'None - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H00FFFFFF& Height = 4275 - Left = 120 + Left = 30 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical - TabIndex = 7 + TabIndex = 3 TabStop = 0 'False - Top = 6360 + Top = 6720 Width = 4320 End - Begin VB.PictureBox pPaneles - Appearance = 0 'Flat - AutoSize = -1 'True - BackColor = &H00000000& - ForeColor = &H80000008& - Height = 4395 - Left = 120 - ScaleHeight = 4365 - ScaleWidth = 4365 - TabIndex = 6 - Top = 1800 - Width = 4395 - Begin VB.Timer Timer_KeyPress - Interval = 1 - Left = 120 - Top = 120 - End - Begin VB.TextBox tTY - BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin MSComDlg.CommonDialog Dialog + Left = 2760 + Top = 12000 + _ExtentX = 847 + _ExtentY = 847 + _Version = 393216 + End + Begin VB.Frame frameInfo + BorderStyle = 0 'None + Caption = "Frame1" + Height = 1680 + Left = 1650 + TabIndex = 0 + Top = 30 + Width = 2535 + Begin WorldEditor.lvButtons_H cmdInformacionDelMapa + Height = 345 + Left = 45 + TabIndex = 27 + Top = 660 + Width = 2415 + _ExtentX = 4260 + _ExtentY = 609 + Caption = "&Información del Mapa" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 315 - Left = 1200 - TabIndex = 87 - Text = "1" - Top = 960 - Visible = 0 'False - Width = 2900 + cGradient = 0 + Mode = 0 + Value = 0 'False + cBack = -2147483633 End - Begin VB.TextBox tTX - BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cmdQuitarFunciones + Height = 315 + Left = 30 + TabIndex = 98 + ToolTipText = "Quitar Todas las Funciones Activadas" + Top = 1320 + Width = 2415 + _ExtentX = 4683 + _ExtentY = 767 + Caption = "&Quitar Funciones (F4)" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 315 - Left = 1200 - TabIndex = 86 - Text = "1" - Top = 600 - Visible = 0 'False - Width = 2900 + cGradient = 0 + Mode = 0 + Value = 0 'False + cBack = 12632319 End - Begin VB.TextBox tTMapa - BackColor = &H80000012& + Begin VB.Label lblMapVersion + AutoSize = -1 'True + BackColor = &H8000000D& + BackStyle = 0 'Transparent + Caption = "0" BeginProperty Font Name = "Arial" - Size = 8.25 + Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 315 - Left = 1200 - TabIndex = 85 - Text = "1" - Top = 240 - Visible = 0 'False - Width = 2900 - End - Begin WorldEditor.lvButtons_H cInsertarTrans - Height = 375 - Left = 240 - TabIndex = 88 - Top = 1320 - Visible = 0 'False - Width = 3855 - _extentx = 6800 - _extenty = 661 - caption = "&Insertar Translado" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cInsertarTransOBJ - Height = 375 - Left = 240 - TabIndex = 89 - Top = 1680 - Visible = 0 'False - Width = 3855 - _extentx = 6800 - _extenty = 661 - caption = "Colocar automaticamente &Objeto" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 + ForeColor = &H00000000& + Height = 240 + Left = 1440 + TabIndex = 6 + Top = 1065 + Width = 105 End - Begin WorldEditor.lvButtons_H cUnionManual - Height = 375 - Left = 240 - TabIndex = 90 - Top = 2160 - Visible = 0 'False - Width = 3855 - _extentx = 6800 - _extenty = 661 - caption = "&Union con Mapa Adyacente (manual)" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 + Begin VB.Label lblMapMusica + AutoSize = -1 'True + BackColor = &H8000000D& + BackStyle = 0 'Transparent + Caption = "0" + ForeColor = &H00000000& + Height = 210 + Left = 1440 + TabIndex = 5 + Top = 405 + Width = 90 End - Begin WorldEditor.lvButtons_H cUnionAuto - Height = 375 - Left = 240 - TabIndex = 91 - Top = 2520 - Visible = 0 'False - Width = 3855 - _extentx = 6800 - _extenty = 661 - caption = "Union con Mapas &Adyacentes (auto)" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 0 - value = 0 'False - cback = -2147483633 + Begin VB.Label lblMapNombre + BackStyle = 0 'Transparent + BorderStyle = 1 'Fixed Single + Caption = "Nuevo Mapa" + Height = 270 + Left = 60 + TabIndex = 4 + Top = 90 + Width = 2400 End - Begin WorldEditor.lvButtons_H cQuitarTrans - Height = 375 - Left = 240 - TabIndex = 92 - Top = 3000 - Visible = 0 'False - Width = 3855 - _extentx = 6800 - _extenty = 661 - caption = "&Quitar Translados" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 + Begin VB.Label lblFMusica + BackStyle = 0 'Transparent + BorderStyle = 1 'Fixed Single + Caption = "Musica:" + ForeColor = &H00004000& + Height = 270 + Left = 45 + TabIndex = 2 + Top = 375 + Width = 2415 End - Begin VB.ComboBox cCapas - Appearance = 0 'Flat + Begin VB.Label lblFVersion + BackStyle = 0 'Transparent + BorderStyle = 1 'Fixed Single + Caption = "Versión:" + ForeColor = &H00004000& + Height = 285 + Left = 45 + TabIndex = 1 + Top = 1035 + Width = 2415 + End + End + Begin VB.Frame frameTriggers + Caption = "Triggers" + Height = 4815 + Left = 30 + TabIndex = 75 + Top = 1800 + Width = 4335 + Begin VB.ListBox lListado BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 + ForeColor = &H80000014& + Height = 3180 + Index = 4 + ItemData = "frmMain.frx":62DA + Left = 120 + List = "frmMain.frx":62E1 + TabIndex = 76 + Tag = "-1" + Top = 240 + Width = 4095 + End + Begin WorldEditor.lvButtons_H cQuitarTrigger + Height = 375 + Left = 120 + TabIndex = 77 + Top = 3960 + Width = 2175 + _ExtentX = 3836 + _ExtentY = 661 + Caption = "&Quitar Trigger's" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 330 - ItemData = "frmMain.frx":628A - Left = 1080 - List = "frmMain.frx":628C - TabIndex = 74 - Text = "1" - Top = 3120 - Visible = 0 'False - Width = 855 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.ComboBox cGrh - Appearance = 0 'Flat - BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cVerTriggers + Height = 375 + Left = 120 + TabIndex = 78 + Top = 3600 + Width = 2175 + _ExtentX = 3836 + _ExtentY = 661 + Caption = "&Mostrar Trigger's" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 330 - Left = 2880 - TabIndex = 73 - Text = "1" - Top = 3120 - Visible = 0 'False - Width = 1335 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.ComboBox cFiltro - BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cInsertarTrigger + Height = 735 + Left = 2400 + TabIndex = 79 + Top = 3600 + Width = 1815 + _ExtentX = 3201 + _ExtentY = 1296 + Caption = "&Insertar Trigger" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 + End + End + Begin VB.Frame frameObject + Caption = "Objects" + Height = 4815 + Left = 30 + TabIndex = 71 + Top = 1800 + Width = 4335 + Begin VB.ComboBox cCantFunc + Appearance = 0 'Flat + BackColor = &H80000012& ForeColor = &H80000014& Height = 330 - Index = 0 + Index = 2 + ItemData = "frmMain.frx":62EF + Left = 840 + List = "frmMain.frx":62F1 + TabIndex = 97 + Text = "1" + Top = 3240 + Width = 1215 + End + Begin VB.ComboBox cNumFunc + Appearance = 0 'Flat + BackColor = &H80000012& + ForeColor = &H80000014& + Height = 330 + Index = 2 + ItemData = "frmMain.frx":62F3 + Left = 1320 + List = "frmMain.frx":62F5 + TabIndex = 74 + Text = "1" + Top = 3600 + Width = 855 + End + Begin VB.ComboBox cFiltro + BackColor = &H80000012& + ForeColor = &H80000014& + Height = 330 + Index = 3 Left = 600 - TabIndex = 72 - Top = 2760 - Visible = 0 'False + TabIndex = 73 + Top = 2880 Width = 3615 End Begin VB.ListBox lListado BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& - Height = 2580 - Index = 0 - ItemData = "frmMain.frx":628E + Height = 2400 + Index = 3 + ItemData = "frmMain.frx":62F7 Left = 120 - List = "frmMain.frx":6295 - Sorted = -1 'True - TabIndex = 71 + List = "frmMain.frx":62FE + TabIndex = 72 Tag = "-1" - Top = 120 - Visible = 0 'False + Top = 240 Width = 4095 End - Begin WorldEditor.lvButtons_H cQuitarEnTodasLasCapas + Begin WorldEditor.lvButtons_H cAgregarFuncalAzar Height = 375 + Index = 2 Left = 120 - TabIndex = 75 - Top = 3840 - Visible = 0 'False + TabIndex = 82 + Top = 3960 Width = 2175 - _extentx = 3836 - _extenty = 661 - caption = "Quitar en &Capas 2 y 3" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 + _ExtentX = 3836 + _ExtentY = 661 + Caption = "Insetar OBJ's al &Azar" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + cGradient = 0 + Mode = 0 + Value = 0 'False + cBack = -2147483633 End - Begin WorldEditor.lvButtons_H cQuitarEnEstaCapa + Begin WorldEditor.lvButtons_H cQuitarFunc Height = 375 + Index = 2 Left = 120 - TabIndex = 76 - Top = 3480 - Visible = 0 'False + TabIndex = 83 + Top = 4320 Width = 2175 - _extentx = 3836 - _extenty = 661 - caption = "&Quitar en esta Capa" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cSeleccionarSuperficie - Height = 735 - Left = 2400 - TabIndex = 77 - Top = 3480 - Visible = 0 'False - Width = 1815 - _extentx = 3201 - _extenty = 1296 - caption = "&Insertar Superficie" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin VB.ComboBox cNumFunc - Appearance = 0 'Flat - BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 + _ExtentX = 3836 + _ExtentY = 661 + Caption = "&Quitar OBJ's" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 330 - Index = 2 - ItemData = "frmMain.frx":62A3 - Left = 3360 - List = "frmMain.frx":62A5 - TabIndex = 67 - Text = "1" - Top = 3120 - Visible = 0 'False - Width = 855 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.ComboBox cCantFunc - Appearance = 0 'Flat - BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cInsertarFunc + Height = 735 + Index = 2 + Left = 2400 + TabIndex = 84 + Top = 3960 + Width = 1815 + _ExtentX = 3201 + _ExtentY = 1296 + Caption = "&Insertar Objetos" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 + End + Begin VB.Label lCantFunc + AutoSize = -1 'True + BackColor = &H80000012& + Caption = "Cantidad:" ForeColor = &H80000014& - Height = 330 + Height = 210 Index = 2 - ItemData = "frmMain.frx":62A7 - Left = 840 - List = "frmMain.frx":62A9 - TabIndex = 66 - Text = "1" - Top = 3120 - Visible = 0 'False - Width = 1215 + Left = 120 + TabIndex = 94 + Top = 3240 + Width = 675 End - Begin VB.ListBox lListado + Begin VB.Label lbFiltrar + AutoSize = -1 'True BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty + Caption = "Filtrar:" ForeColor = &H80000014& - Height = 2580 + Height = 210 Index = 3 - ItemData = "frmMain.frx":62AB Left = 120 - List = "frmMain.frx":62B2 - TabIndex = 65 - Tag = "-1" - Top = 120 - Visible = 0 'False - Width = 4095 + TabIndex = 90 + Top = 2880 + Width = 450 End - Begin VB.ComboBox cFiltro + Begin VB.Label lNumFunc + AutoSize = -1 'True BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty + Caption = "Numero de OBJ:" ForeColor = &H80000014& - Height = 330 - Index = 3 - Left = 600 - TabIndex = 64 - Top = 2760 - Visible = 0 'False - Width = 3615 + Height = 210 + Index = 2 + Left = 120 + TabIndex = 85 + Top = 3600 + Width = 1170 End + End + Begin VB.Frame frameNpc + Caption = "Npc" + Height = 4815 + Left = 30 + TabIndex = 59 + Top = 1800 + Width = 4335 Begin VB.ComboBox cCantFunc Appearance = 0 'Flat BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& Height = 330 Index = 0 - ItemData = "frmMain.frx":62C0 - Left = 840 - List = "frmMain.frx":62C2 - TabIndex = 57 + ItemData = "frmMain.frx":630C + Left = 1440 + List = "frmMain.frx":630E + TabIndex = 93 Text = "1" - Top = 3120 - Visible = 0 'False + Top = 3240 Width = 1215 End Begin VB.ComboBox cNumFunc Appearance = 0 'Flat BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& Height = 330 Index = 0 - ItemData = "frmMain.frx":62C4 - Left = 3360 - List = "frmMain.frx":62C6 - TabIndex = 56 + ItemData = "frmMain.frx":6310 + Left = 1800 + List = "frmMain.frx":6312 + TabIndex = 63 Text = "1" - Top = 3120 - Visible = 0 'False + Top = 2880 Width = 855 End Begin VB.ComboBox cFiltro BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& Height = 330 Index = 1 Left = 600 - TabIndex = 55 - Top = 2760 - Visible = 0 'False + TabIndex = 61 + Top = 3600 Width = 3615 End Begin VB.ListBox lListado BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& - Height = 2580 + Height = 2400 Index = 1 - ItemData = "frmMain.frx":62C8 + ItemData = "frmMain.frx":6314 Left = 120 - List = "frmMain.frx":62CF - TabIndex = 54 + List = "frmMain.frx":631B + TabIndex = 60 Tag = "-1" - Top = 120 - Visible = 0 'False + Top = 240 Width = 4095 End - Begin VB.ListBox lListado - BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cInsertarFunc + Height = 735 + Index = 0 + Left = 2400 + TabIndex = 64 + Top = 3960 + Width = 1815 + _ExtentX = 3201 + _ExtentY = 1296 + Caption = "&Insertar NPC's" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 3210 - Index = 4 - ItemData = "frmMain.frx":62DD - Left = 120 - List = "frmMain.frx":62E4 - TabIndex = 53 - Tag = "-1" - Top = 120 - Visible = 0 'False - Width = 4095 - End - Begin VB.PictureBox Picture5 - Height = 0 - Left = 0 - ScaleHeight = 0 - ScaleWidth = 0 - TabIndex = 8 - Top = 0 - Width = 0 - End - Begin VB.PictureBox Picture6 - Height = 0 - Left = 0 - ScaleHeight = 0 - ScaleWidth = 0 - TabIndex = 9 - Top = 0 - Width = 0 - End - Begin VB.PictureBox Picture7 - Height = 0 - Left = 0 - ScaleHeight = 0 - ScaleWidth = 0 - TabIndex = 10 - Top = 0 - Width = 0 - End - Begin VB.PictureBox Picture8 - Height = 0 - Left = 0 - ScaleHeight = 0 - ScaleWidth = 0 - TabIndex = 11 - Top = 0 - Width = 0 - End - Begin VB.PictureBox Picture9 - Height = 0 - Left = 0 - ScaleHeight = 0 - ScaleWidth = 0 - TabIndex = 12 - Top = 0 - Width = 0 - End - Begin VB.PictureBox Picture11 - Height = 0 - Left = 0 - ScaleHeight = 0 - ScaleWidth = 0 - TabIndex = 49 - Top = 0 - Width = 0 - End - Begin WorldEditor.lvButtons_H cQuitarTrigger - Height = 375 - Left = 120 - TabIndex = 50 - Top = 3840 - Visible = 0 'False - Width = 2175 - _extentx = 3836 - _extenty = 661 - caption = "&Quitar Trigger's" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cVerTriggers - Height = 375 - Left = 120 - TabIndex = 51 - Top = 3480 - Visible = 0 'False - Width = 2175 - _extentx = 3836 - _extenty = 661 - caption = "&Mostrar Trigger's" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cInsertarTrigger - Height = 735 - Left = 2400 - TabIndex = 52 - Top = 3480 - Visible = 0 'False - Width = 1815 - _extentx = 3201 - _extenty = 1296 - caption = "&Insertar Trigger" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End Begin WorldEditor.lvButtons_H cAgregarFuncalAzar Height = 375 Index = 0 Left = 120 - TabIndex = 58 - Top = 3480 - Visible = 0 'False + TabIndex = 80 + Top = 3960 Width = 2175 - _extentx = 3836 - _extenty = 661 - caption = "Insetar NPC's al &Azar" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 0 - value = 0 'False - cback = -2147483633 + _ExtentX = 3836 + _ExtentY = 661 + Caption = "Insetar NPC's al &Azar" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + cGradient = 0 + Mode = 0 + Value = 0 'False + cBack = -2147483633 End Begin WorldEditor.lvButtons_H cQuitarFunc Height = 375 Index = 0 Left = 120 - TabIndex = 59 - Top = 3840 - Visible = 0 'False + TabIndex = 81 + Top = 4320 Width = 2175 - _extentx = 3836 - _extenty = 661 - caption = "&Quitar NPC's" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 + _ExtentX = 3836 + _ExtentY = 661 + Caption = "&Quitar NPC's" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin WorldEditor.lvButtons_H cInsertarFunc - Height = 735 + Begin VB.Label lCantFunc + AutoSize = -1 'True + BackColor = &H80000012& + Caption = "Cantidad:" + ForeColor = &H80000014& + Height = 210 Index = 0 - Left = 2400 - TabIndex = 60 - Top = 3480 - Visible = 0 'False - Width = 1815 - _extentx = 3201 - _extenty = 1296 - caption = "&Insertar NPC's" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cVerBloqueos - Height = 495 - Left = 120 - TabIndex = 61 - Top = 120 - Visible = 0 'False - Width = 4095 - _extentx = 7223 - _extenty = 873 - caption = "&Mostrar Bloqueos" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cInsertarBloqueo - Height = 735 - Left = 120 - TabIndex = 62 - Top = 720 - Visible = 0 'False - Width = 4095 - _extentx = 7223 - _extenty = 1296 - caption = "&Insertar Bloqueos" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cQuitarBloqueo - Height = 735 - Left = 120 - TabIndex = 63 - Top = 1560 - Visible = 0 'False - Width = 4095 - _extentx = 7223 - _extenty = 1296 - caption = "&Quitar Bloqueos" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cAgregarFuncalAzar - Height = 375 - Index = 2 Left = 120 - TabIndex = 68 - Top = 3480 - Visible = 0 'False - Width = 2175 - _extentx = 3836 - _extenty = 661 - caption = "Insetar OBJ's al &Azar" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 0 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cQuitarFunc - Height = 375 - Index = 2 - Left = 120 - TabIndex = 69 - Top = 3840 - Visible = 0 'False - Width = 2175 - _extentx = 3836 - _extenty = 661 - caption = "&Quitar OBJ's" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cInsertarFunc - Height = 735 - Index = 2 - Left = 2400 - TabIndex = 70 - Top = 3480 - Visible = 0 'False - Width = 1815 - _extentx = 3201 - _extenty = 1296 - caption = "&Insertar Objetos" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 - End - Begin WorldEditor.lvButtons_H cInsertarFunc - Height = 735 - Index = 1 - Left = 2400 - TabIndex = 84 - Top = 3480 - Visible = 0 'False - Width = 1815 - _extentx = 3201 - _extenty = 1296 - caption = "&Insertar NPC's" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 + TabIndex = 95 + Top = 3240 + Width = 675 End - Begin WorldEditor.lvButtons_H cQuitarFunc - Height = 375 + Begin VB.Label lbFiltrar + AutoSize = -1 'True + BackColor = &H80000012& + Caption = "Filtrar:" + ForeColor = &H80000014& + Height = 210 Index = 1 Left = 120 - TabIndex = 83 - Top = 3840 - Visible = 0 'False - Width = 2175 - _extentx = 3836 - _extenty = 661 - caption = "&Quitar NPC's" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 1 - value = 0 'False - cback = -2147483633 + TabIndex = 92 + Top = 3600 + Width = 450 End - Begin WorldEditor.lvButtons_H cAgregarFuncalAzar - Height = 375 - Index = 1 + Begin VB.Label lNumFunc + AutoSize = -1 'True + BackColor = &H80000012& + Caption = "Numero de NPC:" + ForeColor = &H80000014& + Height = 210 + Index = 0 Left = 120 - TabIndex = 82 - Top = 3480 - Visible = 0 'False - Width = 2175 - _extentx = 3836 - _extenty = 661 - caption = "Insetar NPC's al &Azar" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 0 - value = 0 'False - cback = -2147483633 + TabIndex = 62 + Top = 2880 + Width = 1170 End + End + Begin VB.Frame frameNpcH + Caption = "NPC Hostile" + Height = 4815 + Left = 30 + TabIndex = 65 + Top = 1800 + Width = 4335 Begin VB.ComboBox cCantFunc Appearance = 0 'Flat BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& Height = 330 Index = 1 - ItemData = "frmMain.frx":62F2 - Left = 840 - List = "frmMain.frx":62F4 - TabIndex = 78 + ItemData = "frmMain.frx":6329 + Left = 1320 + List = "frmMain.frx":632B + TabIndex = 96 Text = "1" - Top = 3120 - Visible = 0 'False + Top = 3240 Width = 1215 End - Begin VB.ComboBox cFiltro - BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H80000014& - Height = 330 - Index = 2 - Left = 600 - TabIndex = 79 - Top = 2760 - Visible = 0 'False - Width = 3615 - End - Begin VB.ListBox lListado - BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H80000014& - Height = 2580 - Index = 2 - ItemData = "frmMain.frx":62F6 - Left = 120 - List = "frmMain.frx":62FD - TabIndex = 80 - Tag = "-1" - Top = 120 - Visible = 0 'False - Width = 4095 - End Begin VB.ComboBox cNumFunc Appearance = 0 'Flat BackColor = &H80000012& - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& Height = 330 Index = 1 - ItemData = "frmMain.frx":630B - Left = 3360 - List = "frmMain.frx":630D - TabIndex = 81 + ItemData = "frmMain.frx":632D + Left = 3000 + List = "frmMain.frx":632F + TabIndex = 69 Text = "500" - Top = 3120 - Visible = 0 'False + Top = 3600 Width = 855 End - Begin VB.Label lYver - AutoSize = -1 'True - BackColor = &H80000012& - Caption = "Y vertical:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H80000014& - Height = 210 - Left = 240 - TabIndex = 95 - Top = 1005 - Visible = 0 'False - Width = 735 - End - Begin VB.Label lXhor - AutoSize = -1 'True - BackColor = &H80000012& - Caption = "X horizontal:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H80000014& - Height = 210 - Left = 240 - TabIndex = 94 - Top = 645 - Visible = 0 'False - Width = 900 - End - Begin VB.Label lMapN - AutoSize = -1 'True + Begin VB.ComboBox cFiltro BackColor = &H80000012& - Caption = "Mapa:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& - Height = 210 - Left = 240 - TabIndex = 93 - Top = 285 - Visible = 0 'False - Width = 435 + Height = 330 + Index = 2 + Left = 600 + TabIndex = 68 + Top = 2880 + Width = 3615 End - Begin VB.Label lbFiltrar - AutoSize = -1 'True + Begin VB.ListBox lListado BackColor = &H80000012& - Caption = "Filtrar:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& - Height = 210 - Index = 0 + Height = 2400 + Index = 2 + ItemData = "frmMain.frx":6331 Left = 120 - TabIndex = 24 - Top = 2820 - Visible = 0 'False - Width = 450 + List = "frmMain.frx":6338 + TabIndex = 67 + Tag = "-1" + Top = 240 + Width = 4095 End - Begin VB.Label lbCapas - AutoSize = -1 'True - BackColor = &H80000012& - Caption = "Capa Actual:" - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cInsertarFunc + Height = 735 + Index = 1 + Left = 2400 + TabIndex = 86 + Top = 3960 + Width = 1815 + _ExtentX = 3201 + _ExtentY = 1296 + Caption = "&Insertar NPC's" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 210 - Left = 120 - TabIndex = 23 - Top = 3195 - Visible = 0 'False - Width = 930 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.Label lbGrh - AutoSize = -1 'True - BackColor = &H80000012& - Caption = "Sup Actual:" - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cQuitarFunc + Height = 375 + Index = 1 + Left = 0 + TabIndex = 87 + Top = 4320 + Width = 2175 + _ExtentX = 3836 + _ExtentY = 661 + Caption = "&Quitar NPC's" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 210 - Left = 2040 - TabIndex = 22 - Top = 3195 - Visible = 0 'False - Width = 840 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.Label lNumFunc - AutoSize = -1 'True - BackColor = &H80000012& - Caption = "Numero de NPC:" - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cAgregarFuncalAzar + Height = 375 + Index = 1 + Left = 0 + TabIndex = 88 + Top = 3960 + Width = 2175 + _ExtentX = 3836 + _ExtentY = 661 + Caption = "Insetar NPC's al &Azar" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 210 - Index = 1 - Left = 2160 - TabIndex = 21 - Top = 3195 - Visible = 0 'False - Width = 1170 + cGradient = 0 + Mode = 0 + Value = 0 'False + cBack = -2147483633 End Begin VB.Label lCantFunc AutoSize = -1 'True BackColor = &H80000012& Caption = "Cantidad:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& Height = 210 Index = 1 - Left = 120 - TabIndex = 20 - Top = 3195 - Visible = 0 'False + Left = 360 + TabIndex = 91 + Top = 3240 Width = 675 End Begin VB.Label lbFiltrar AutoSize = -1 'True BackColor = &H80000012& Caption = "Filtrar:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& Height = 210 Index = 2 Left = 120 - TabIndex = 19 - Top = 2820 - Visible = 0 'False + TabIndex = 89 + Top = 2880 Width = 450 End Begin VB.Label lNumFunc AutoSize = -1 'True BackColor = &H80000012& - Caption = "Numero de OBJ:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty + Caption = "Numero de NPC:" ForeColor = &H80000014& Height = 210 - Index = 2 - Left = 2160 - TabIndex = 18 - Top = 3195 - Visible = 0 'False + Index = 1 + Left = 240 + TabIndex = 70 + Top = 3600 Width = 1170 End - Begin VB.Label lCantFunc - AutoSize = -1 'True - BackColor = &H80000012& - Caption = "Cantidad:" - BeginProperty Font - Name = "Arial" - Size = 8.25 + End + Begin VB.Frame frameBlock + Caption = "Blocks" + Height = 4815 + Left = 30 + TabIndex = 56 + Top = 1800 + Width = 4335 + Begin WorldEditor.lvButtons_H cInsertarBloqueo + Height = 735 + Left = 120 + TabIndex = 57 + Top = 840 + Width = 4095 + _ExtentX = 7223 + _ExtentY = 1296 + Caption = "&Insertar Bloqueos" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 210 - Index = 2 - Left = 120 - TabIndex = 17 - Top = 3195 - Visible = 0 'False - Width = 675 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.Label lbFiltrar - AutoSize = -1 'True - BackColor = &H80000012& - Caption = "Filtrar:" - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cVerBloqueos + Height = 495 + Left = 120 + TabIndex = 58 + Top = 240 + Width = 4095 + _ExtentX = 7223 + _ExtentY = 873 + Caption = "&Mostrar Bloqueos" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 210 - Index = 3 - Left = 120 - TabIndex = 16 - Top = 2820 - Visible = 0 'False - Width = 450 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.Label lCantFunc - AutoSize = -1 'True - BackColor = &H80000012& - Caption = "Cantidad:" - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cQuitarBloqueo + Height = 735 + Left = 120 + TabIndex = 66 + Top = 1800 + Width = 4095 + _ExtentX = 7223 + _ExtentY = 1296 + Caption = "&Quitar Bloqueos" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H80000014& - Height = 210 - Index = 0 - Left = 120 - TabIndex = 15 - Top = 3195 - Visible = 0 'False - Width = 675 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.Label lNumFunc - AutoSize = -1 'True + End + Begin VB.Frame frameExit + Caption = "Exits" + Height = 4815 + Left = 30 + TabIndex = 44 + Top = 1800 + Width = 4335 + Begin VB.TextBox tTMapa BackColor = &H80000012& - Caption = "Numero de NPC:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& - Height = 210 - Index = 0 - Left = 2160 - TabIndex = 14 - Top = 3195 - Visible = 0 'False - Width = 1170 + Height = 315 + Left = 1200 + TabIndex = 48 + Text = "1" + Top = 120 + Width = 2535 End - Begin VB.Label lbFiltrar - AutoSize = -1 'True + Begin VB.TextBox tTX BackColor = &H80000012& - Caption = "Filtrar:" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty ForeColor = &H80000014& - Height = 210 - Index = 1 - Left = 120 - TabIndex = 13 - Top = 2820 - Visible = 0 'False - Width = 450 + Height = 315 + Left = 1200 + TabIndex = 47 + Text = "1" + Top = 480 + Width = 2535 End - End - Begin VB.PictureBox Picture2 - Appearance = 0 'Flat - AutoRedraw = -1 'True - AutoSize = -1 'True - BorderStyle = 0 'None - ForeColor = &H00FFFFFF& - Height = 5460 - Left = 60 - ScaleHeight = 364 - ScaleMode = 3 'Pixel - ScaleWidth = 297 - TabIndex = 2 - TabStop = 0 'False - Top = 6270 - Width = 4455 - Begin VB.PictureBox PreviewGrh - BackColor = &H00004000& - FillColor = &H00C0C0C0& - Height = 3780 - Left = 45 - ScaleHeight = 3720 - ScaleWidth = 4305 - TabIndex = 3 - Top = 0 - Visible = 0 'False - Width = 4365 + Begin VB.TextBox tTY + BackColor = &H80000012& + ForeColor = &H80000014& + Height = 315 + Left = 1200 + TabIndex = 46 + Text = "1" + Top = 840 + Width = 2535 End - End - Begin MSComDlg.CommonDialog Dialog - Left = 2565 - Top = 2025 - _ExtentX = 847 - _ExtentY = 847 - _Version = 393216 - End - Begin VB.Frame Frame1 - BorderStyle = 0 'None - Caption = "Frame1" - Height = 1290 - Left = 1680 - TabIndex = 0 - Top = 30 - Width = 3225 - Begin WorldEditor.lvButtons_H cmdInformacionDelMapa + Begin WorldEditor.lvButtons_H cInsertarTrans Height = 375 - Left = 100 - TabIndex = 96 - Top = 600 - Width = 3015 - _extentx = 5318 - _extenty = 661 - caption = "&Información del Mapa" - capalign = 2 - backstyle = 2 - cgradient = 0 - mode = 0 - value = 0 'False - cback = -2147483633 - End - Begin VB.Label lblMapVersion - AutoSize = -1 'True - BackColor = &H8000000D& - BackStyle = 0 'Transparent - Caption = "0" - BeginProperty Font - Name = "Arial" - Size = 9.75 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - ForeColor = &H00000000& - Height = 240 - Left = 1440 - TabIndex = 27 - Top = 1010 - Width = 105 - End - Begin VB.Label lblMapMusica - AutoSize = -1 'True - BackColor = &H8000000D& - BackStyle = 0 'Transparent - Caption = "0" - BeginProperty Font - Name = "Arial" - Size = 8.25 + Left = 120 + TabIndex = 45 + Top = 2400 + Width = 3735 + _ExtentX = 6588 + _ExtentY = 661 + Caption = "&Insertar Translado" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H00000000& - Height = 210 - Left = 1440 - TabIndex = 26 - Top = 352 - Width = 90 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.Label lblMapNombre - AutoSize = -1 'True - BackColor = &H8000000D& - BackStyle = 0 'Transparent - Caption = "Nuevo Mapa" - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cQuitarTrans + Height = 375 + Left = 120 + TabIndex = 49 + Top = 2880 + Width = 3735 + _ExtentX = 6588 + _ExtentY = 661 + Caption = "&Quitar Translados" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H00000000& - Height = 210 - Left = 1440 - TabIndex = 25 - Top = 90 - Width = 900 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.Label lblFMusica - BackStyle = 0 'Transparent - BorderStyle = 1 'Fixed Single - Caption = "Musica:" - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cUnionAuto + Height = 375 + Left = 120 + TabIndex = 50 + Top = 1920 + Width = 3735 + _ExtentX = 6588 + _ExtentY = 661 + Caption = "Union con Mapas &Adyacentes (auto)" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H00004000& - Height = 270 - Left = 105 - TabIndex = 5 - Top = 320 - Width = 3015 + cGradient = 0 + Mode = 0 + Value = 0 'False + cBack = -2147483633 End - Begin VB.Label lblFVersion - BackStyle = 0 'Transparent - BorderStyle = 1 'Fixed Single - Caption = "Versión:" - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cUnionManual + Height = 375 + Left = 120 + TabIndex = 51 + Top = 3360 + Width = 3735 + _ExtentX = 6588 + _ExtentY = 661 + Caption = "&Union con Mapa Adyacente (manual)" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H00004000& - Height = 285 - Left = 105 - TabIndex = 4 - Top = 970 - Width = 3015 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 End - Begin VB.Label lblFNombreMapa - BackColor = &H8000000D& - BackStyle = 0 'Transparent - BorderStyle = 1 'Fixed Single - Caption = "Nombre del Mapa:" - BeginProperty Font - Name = "Arial" - Size = 8.25 + Begin WorldEditor.lvButtons_H cInsertarTransOBJ + Height = 375 + Left = 120 + TabIndex = 52 + Top = 1560 + Width = 3735 + _ExtentX = 6588 + _ExtentY = 661 + Caption = "Colocar automaticamente &Objeto" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - ForeColor = &H00004000& - Height = 270 - Left = 105 - TabIndex = 1 - Top = 60 - Width = 3015 + cGradient = 0 + Mode = 1 + Value = 0 'False + cBack = -2147483633 + End + Begin VB.Label lYver + AutoSize = -1 'True + BackColor = &H80000012& + Caption = "Y vertical:" + ForeColor = &H80000014& + Height = 210 + Left = 120 + TabIndex = 55 + Top = 720 + Width = 735 + End + Begin VB.Label lXhor + AutoSize = -1 'True + BackColor = &H80000012& + Caption = "X horizontal:" + ForeColor = &H80000014& + Height = 210 + Left = 120 + TabIndex = 54 + Top = 480 + Width = 825 + End + Begin VB.Label lMapN + AutoSize = -1 'True + BackColor = &H80000012& + Caption = "Mapa:" + ForeColor = &H80000014& + Height = 210 + Left = 120 + TabIndex = 53 + Top = 240 + Width = 435 End - End - Begin VB.Line Separacion1 - BorderColor = &H00FFFFFF& - Index = 1 - X1 = 329 - X2 = 329 - Y1 = 8 - Y2 = 88 - End - Begin VB.Line Separacion2 - BorderColor = &H00FFFFFF& - Index = 1 - X1 = 337 - X2 = 337 - Y1 = 8 - Y2 = 88 - End - Begin VB.Line Separacion2 - BorderColor = &H00808080& - Index = 0 - X1 = 336 - X2 = 336 - Y1 = 8 - Y2 = 88 - End - Begin VB.Line Separacion1 - BorderColor = &H00808080& - Index = 0 - X1 = 328 - X2 = 328 - Y1 = 8 - Y2 = 88 End Begin VB.Label MapPest Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 12 - Left = 14340 - TabIndex = 48 - Top = 1080 + Left = 13830 + TabIndex = 26 + Top = 600 Visible = 0 'False Width = 750 End @@ -1770,20 +1550,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 11 - Left = 13575 - TabIndex = 47 - Top = 1080 + Left = 13065 + TabIndex = 25 + Top = 600 Visible = 0 'False Width = 750 End @@ -1791,20 +1562,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 1 - Left = 5925 - TabIndex = 38 - Top = 1080 + Left = 5415 + TabIndex = 17 + Top = 600 Visible = 0 'False Width = 750 End @@ -1812,20 +1574,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 2 - Left = 6690 - TabIndex = 37 - Top = 1080 + Left = 6180 + TabIndex = 16 + Top = 600 Visible = 0 'False Width = 750 End @@ -1833,20 +1586,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 3 - Left = 7455 - TabIndex = 36 - Top = 1080 + Left = 6945 + TabIndex = 15 + Top = 600 Visible = 0 'False Width = 750 End @@ -1855,20 +1599,11 @@ Begin VB.Form frmMain BackColor = &H00C0FFC0& BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 4 - Left = 8220 - TabIndex = 35 - Top = 1080 + Left = 7710 + TabIndex = 14 + Top = 600 Visible = 0 'False Width = 750 End @@ -1876,20 +1611,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 5 - Left = 8985 - TabIndex = 34 - Top = 1080 + Left = 8475 + TabIndex = 13 + Top = 600 Visible = 0 'False Width = 750 End @@ -1897,20 +1623,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 6 - Left = 9750 - TabIndex = 33 - Top = 1080 + Left = 9240 + TabIndex = 12 + Top = 600 Visible = 0 'False Width = 750 End @@ -1918,20 +1635,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 7 - Left = 10515 - TabIndex = 32 - Top = 1080 + Left = 10005 + TabIndex = 11 + Top = 600 Visible = 0 'False Width = 750 End @@ -1939,20 +1647,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 8 - Left = 11280 - TabIndex = 31 - Top = 1080 + Left = 10770 + TabIndex = 10 + Top = 600 Visible = 0 'False Width = 750 End @@ -1960,20 +1659,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 9 - Left = 12045 - TabIndex = 30 - Top = 1080 + Left = 11535 + TabIndex = 9 + Top = 600 Visible = 0 'False Width = 750 End @@ -1981,20 +1671,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 0 - Left = 5160 - TabIndex = 29 - Top = 1080 + Left = 4650 + TabIndex = 8 + Top = 600 Visible = 0 'False Width = 750 End @@ -2002,20 +1683,11 @@ Begin VB.Form frmMain Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mapa1" - BeginProperty Font - Name = "Arial" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty Height = 255 Index = 10 - Left = 12810 - TabIndex = 28 - Top = 1080 + Left = 12300 + TabIndex = 7 + Top = 600 Visible = 0 'False Width = 750 End @@ -2069,15 +1741,6 @@ Begin VB.Form frmMain End Begin VB.Menu mnuExportar Caption = "&Exportar" - Begin VB.Menu mnuBmp - Caption = "Bmp" - End - Begin VB.Menu mnuPng - Caption = "Png" - End - Begin VB.Menu mnuJpg - Caption = "Jpg" - End End Begin VB.Menu mnuOrgEdit Caption = "Editar Organizacion de Mapas" @@ -2321,6 +1984,7 @@ Begin VB.Form frmMain Caption = "&Opciones" Begin VB.Menu mnuInformes Caption = "&Informes" + Shortcut = ^I End Begin VB.Menu mnuActualizarIndices Caption = "&Actualizar Indices de..." @@ -2384,12 +2048,16 @@ Begin VB.Form frmMain Caption = "&Utilizar como Objeto de Translados" End End + Begin VB.Menu mnuPalett + Caption = "Paleta" + End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -2414,6 +2082,10 @@ Option Explicit Public MouseX As Long Public MouseY As Long + + + + Private Sub PonerAlAzar(ByVal N As Integer, ByVal T As Byte) '************************************************* 'Author: Unkwown @@ -2421,24 +2093,24 @@ Private Sub PonerAlAzar(ByVal N As Integer, ByVal T As Byte) '************************************************* Dim objindex As Long Dim NPCIndex As Long -Dim X As Long, Y As Long, I As Long +Dim X As Long, Y As Long, i As Long Dim Head As Integer Dim Body As Integer Dim Heading As Byte Dim Leer As New clsIniReader -I = N +i = N modEdicion.Deshacer_Add "Aplicar " & IIf(T = 0, "Objetos", "NPCs") & " al Azar" ' Hago deshacer -Do While I > 0 +Do While i > 0 X = CInt(RandomNumber(XMinMapSize, XMaxMapSize - 1)) Y = CInt(RandomNumber(YMinMapSize, YMaxMapSize - 1)) Select Case T Case 0 If MapData(X, Y).OBJInfo.objindex = 0 Then - I = I - 1 + i = i - 1 If cInsertarBloqueo.Value = True Then MapData(X, Y).Blocked = 1 @@ -2461,7 +2133,7 @@ Do While I > 0 Case 1, 2 If MapData(X, Y).Blocked = 0 Then - I = I - 1 + i = i - 1 If cNumFunc(T - 1).Text > 0 Then NPCIndex = cNumFunc(T - 1).Text @@ -2516,29 +2188,13 @@ Private Sub cCapas_Change() 'Author: ^[GS]^ 'Last modified: 31/05/06 '************************************************* - cCapas.Text = Val(cCapas.Text) - - If (Val(cCapas.Text) >= 1) And (Val(cCapas.Text) <= 4) Then - CurLayer = Val(frmMain.cCapas.Text) - Else - CurLayer = 1 - cCapas.Text = CurLayer - End If - - cCapas.Tag = vbNullString + CurLayer = GetLayerFromText(cCapas.Text) End Sub - +Private Function GetLayerFromText(Text As String) As Integer + GetLayerFromText = Val(mid$(Text, 1, 1)) +End Function Private Sub cCapas_Click() - cCapas.Text = Val(cCapas.Text) - - If (Val(cCapas.Text) >= 1) And (Val(cCapas.Text) <= 4) Then - CurLayer = Val(frmMain.cCapas.Text) - Else - CurLayer = 1 - cCapas.Text = CurLayer - End If - - cCapas.Tag = vbNullString + CurLayer = GetLayerFromText(cCapas.Text) End Sub Private Sub cCapas_KeyDown(KeyCode As Integer, Shift As Integer) @@ -2604,17 +2260,7 @@ Private Sub cInsertarFunc_Click(index As Integer) 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -If cInsertarFunc(index).Value Then - cQuitarFunc(index).Enabled = False - cAgregarFuncalAzar(index).Enabled = False - If index <> 2 Then cCantFunc(index).Enabled = False - Call modPaneles.EstSelectPanel((index) + 3, True) -Else - cQuitarFunc(index).Enabled = True - cAgregarFuncalAzar(index).Enabled = True - If index <> 2 Then cCantFunc(index).Enabled = True - Call modPaneles.EstSelectPanel((index) + 3, False) -End If + End Sub Private Sub cInsertarTrans_Click() @@ -2624,10 +2270,10 @@ Private Sub cInsertarTrans_Click() '************************************************* If cInsertarTrans.Value Then cQuitarTrans.Enabled = False - Call modPaneles.EstSelectPanel(1, True) + Else cQuitarTrans.Enabled = True - Call modPaneles.EstSelectPanel(1, False) + End If End Sub @@ -2638,10 +2284,8 @@ Private Sub cInsertarTrigger_Click() '************************************************* If cInsertarTrigger.Value Then cQuitarTrigger.Enabled = False - Call modPaneles.EstSelectPanel(6, True) Else cQuitarTrigger.Enabled = True - Call modPaneles.EstSelectPanel(6, False) End If End Sub @@ -2757,15 +2401,13 @@ Private Sub cInsertarBloqueo_Click() 'Author: ^[GS]^ 'Last modified: 29/05/06 '************************************************* -cInsertarBloqueo.Tag = vbNullString + cInsertarBloqueo.Tag = vbNullString -If cInsertarBloqueo.Value Then - cQuitarBloqueo.Enabled = False - Call modPaneles.EstSelectPanel(2, True) -Else - cQuitarBloqueo.Enabled = True - Call modPaneles.EstSelectPanel(2, False) -End If + If cInsertarBloqueo.Value Then + cQuitarBloqueo.Enabled = False + Else + cQuitarBloqueo.Enabled = True + End If End Sub Private Sub cQuitarBloqueo_Click() @@ -2777,10 +2419,8 @@ cInsertarBloqueo.Tag = vbNullString If cQuitarBloqueo.Value Then cInsertarBloqueo.Enabled = False - Call modPaneles.EstSelectPanel(2, True) Else cInsertarBloqueo.Enabled = True - Call modPaneles.EstSelectPanel(2, False) End If End Sub @@ -2795,14 +2435,14 @@ If cQuitarEnEstaCapa.Value Then cGrh.Enabled = False cSeleccionarSuperficie.Enabled = False cQuitarEnTodasLasCapas.Enabled = False - Call modPaneles.EstSelectPanel(0, True) + Else lListado(0).Enabled = True cFiltro(0).Enabled = True cGrh.Enabled = True cSeleccionarSuperficie.Enabled = True cQuitarEnTodasLasCapas.Enabled = True - Call modPaneles.EstSelectPanel(0, False) + End If End Sub @@ -2818,7 +2458,7 @@ If cQuitarEnTodasLasCapas.Value Then cGrh.Enabled = False cSeleccionarSuperficie.Enabled = False cQuitarEnEstaCapa.Enabled = False - Call modPaneles.EstSelectPanel(0, True) + Else cCapas.Enabled = True lListado(0).Enabled = True @@ -2826,7 +2466,7 @@ Else cGrh.Enabled = True cSeleccionarSuperficie.Enabled = True cQuitarEnEstaCapa.Enabled = True - Call modPaneles.EstSelectPanel(0, False) + End If End Sub @@ -2842,7 +2482,7 @@ If cQuitarFunc(index).Value Then cNumFunc(index).Enabled = False cFiltro((index) + 1).Enabled = False lListado((index) + 1).Enabled = False - Call modPaneles.EstSelectPanel((index) + 3, True) + Else cInsertarFunc(index).Enabled = True cAgregarFuncalAzar(index).Enabled = True @@ -2850,7 +2490,7 @@ Else cNumFunc(index).Enabled = True cFiltro((index) + 1).Enabled = True lListado((index) + 1).Enabled = True - Call modPaneles.EstSelectPanel((index) + 3, False) + End If End Sub @@ -2868,7 +2508,7 @@ If cQuitarTrans.Value = True Then tTX.Enabled = False tTY.Enabled = False mnuInsertarTransladosAdyasentes.Enabled = False - Call modPaneles.EstSelectPanel(1, True) + Else tTMapa.Enabled = True tTX.Enabled = True @@ -2878,7 +2518,7 @@ Else cInsertarTrans.Enabled = True cInsertarTransOBJ.Enabled = True mnuInsertarTransladosAdyasentes.Enabled = True - Call modPaneles.EstSelectPanel(1, False) + End If End Sub @@ -2890,11 +2530,11 @@ Private Sub cQuitarTrigger_Click() If cQuitarTrigger.Value Then lListado(4).Enabled = False cInsertarTrigger.Enabled = False - Call modPaneles.EstSelectPanel(6, True) + Else lListado(4).Enabled = True cInsertarTrigger.Enabled = True - Call modPaneles.EstSelectPanel(6, False) + End If End Sub @@ -2906,11 +2546,11 @@ Private Sub cSeleccionarSuperficie_Click() If cSeleccionarSuperficie.Value Then cQuitarEnTodasLasCapas.Enabled = False cQuitarEnEstaCapa.Enabled = False - Call modPaneles.EstSelectPanel(0, True) + bSelectSup = True Else cQuitarEnTodasLasCapas.Enabled = True cQuitarEnEstaCapa.Enabled = True - Call modPaneles.EstSelectPanel(0, False) + bSelectSup = False End If bSelectSup = cSeleccionarSuperficie.Value @@ -2929,16 +2569,28 @@ Private Sub Form_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Me.SetFocus +picMain.SetFocus +End Sub + +Private Sub Form_Load() + PreviewGrh.Visible = False +End Sub + + + +Private Sub mnuExportar_Click() + frmRender.Visible = True +End Sub + +Private Sub mnuPalett_Click() + frmPalett.Visible = True End Sub -Private Sub Form_DblClick() +Private Sub picMain_DblClick() '************************************************* 'Author: ^[GS]^ 'Last modified: 28/05/06 '************************************************* -Dim tx As Integer -Dim tY As Integer If Not MapaCargado Then Exit Sub @@ -2947,7 +2599,7 @@ If SobreX > 0 And SobreY > 0 Then End If End Sub -Private Sub Form_KeyPress(KeyAscii As Integer) +Private Sub picMain_KeyPress(KeyAscii As Integer) '************************************************* 'Author: ^[GS]^ 'Last modified: 20/05/06 @@ -2982,35 +2634,36 @@ Select Case UCase$(Chr$(KeyAscii)) End Select End Sub -Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) +Private Sub picMain_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim tx As Integer Dim tY As Integer -MouseX = X - MainViewShp.Left -MouseY = Y - MainViewShp.Top +MouseX = X +MouseY = Y -'Trim to fit screen -If MouseX < 0 Then - MouseX = 0 -ElseIf MouseX > MainViewShp.Width Then - MouseX = MainViewShp.Width -End If +ConvertCPtoTP MouseX, MouseY, tx, tY -'Trim to fit screen -If MouseY < 0 Then - MouseY = 0 -ElseIf MouseY > MainViewShp.Height Then - MouseY = MainViewShp.Height -End If +If Button = vbLeftButton Then Call SelectTiles(True, tx, tY) +End Sub + +Private Sub Form_Resize() + + Dim newW As Integer + Dim newH As Integer + If AutoPantalla Then + newW = Me.ScaleWidth - Me.picMain.Left + newH = Me.ScaleHeight - (Me.picMain.Top + 10) + PantallaX = CInt(newW / 32) + PantallaY = CInt(newH / 32) + End If + + If PantallaX > 1 Then + Me.picMain.Width = (PantallaX * 32) + Me.picMain.Height = (PantallaY * 32) + End If -'Make sure click is in view window -If X <= MainViewShp.Left Or X >= MainViewShp.Left + MainViewWidth Or Y <= MainViewShp.Top Or Y >= MainViewShp.Top + MainViewHeight Then - Exit Sub -End If -ConvertCPtoTP MouseX, MouseY, tx, tY -If Button = vbLeftButton Then Call SelectTiles(True, tx, tY) End Sub Private Sub lListado_Click(index As Integer) @@ -3067,9 +2720,14 @@ If HotKeysAllow = False Then Case 3 cNumFunc(2).Text = ReadField(2, lListado(index).Text, Asc("#")) 'Objetos End Select +Else +If lListado(index).ListCount < lListado(index).Tag Then + lListado(index).ListIndex = 0 + lListado(index).Tag = 1 Else lListado(index).ListIndex = lListado(index).Tag End If +End If End Sub @@ -3097,26 +2755,9 @@ Private Sub MapPest_Click(index As Integer) 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Dialog.CancelError = True -If (index + NumMap_Save - 4) <> NumMap_Save Then - On Error GoTo ErrHandler - - If MapInfo.Changed = 1 Then - If MsgBox(MSGMod, vbExclamation + vbYesNo) = vbYes Then - modMapIO.GuardarMapa PATH_Save & NameMap_Save & NumMap_Save & ".map" - End If - End If - - Call modMapIO.NuevoMapa - - Dialog.FileName = PATH_Save & NameMap_Save & (index + NumMap_Save - 4) & ".map" - modMapIO.AbrirMapa Dialog.FileName, MapData - Exit Sub - -ErrHandler: - MsgBox Err.Description -End If +Call TryChangeMap(index + NumMap_Save - 4) + End Sub Private Sub mnuActualizarCabezas_Click() @@ -3262,16 +2903,8 @@ Private Sub mnuBloquear_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Dim I As Byte - -For I = 0 To 6 - If I <> 2 Then - frmMain.SelectPanel(I).Value = False - Call VerFuncion(I, False) - End If -Next I -modPaneles.VerFuncion 2, True +Call modPaneles.SetPanel(Blocks) End Sub Private Sub mnuBloquearBordes_Click() @@ -3290,11 +2923,6 @@ Private Sub mnuBloquearMapa_Click() Call modEdicion.Bloqueo_Todo(1) End Sub -Private Sub mnuBmp_Click() -frmRender.formatPic = eFormatPic.bmp -Call frmRender.Show(vbModal) -End Sub - Private Sub mnuConfigAvanzada_Click() '************************************************* 'Author: ^[GS]^ @@ -3406,11 +3034,6 @@ Private Sub mnuInsertarTransladosAdyasentes_Click() frmUnionAdyacente.Show End Sub -Private Sub mnuJpg_Click() -frmRender.formatPic = eFormatPic.jpg -Call frmRender.Show(vbModal) -End Sub - Private Sub mnuModoCaminata_Click() '************************************************* 'Author: ^[GS]^ @@ -3424,16 +3047,7 @@ Private Sub mnuNPCs_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Dim I As Byte - -For I = 0 To 6 - If I <> 3 Then - frmMain.SelectPanel(I).Value = False - Call VerFuncion(I, False) - End If -Next I - -modPaneles.VerFuncion 3, True +Call modPaneles.SetPanel(NPC) End Sub Private Sub mnuNPCsHostiles_Click() @@ -3441,16 +3055,7 @@ Private Sub mnuNPCsHostiles_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Dim I As Byte - -For I = 0 To 6 - If I <> 4 Then - frmMain.SelectPanel(I).Value = False - Call VerFuncion(I, False) - End If -Next I - -modPaneles.VerFuncion 4, True +Call modPaneles.SetPanel(NPCHostile) End Sub Private Sub mnuNuevoMapa_Click() @@ -3482,16 +3087,7 @@ Private Sub mnuObjetos_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Dim I As Byte - -For I = 0 To 6 - If I <> 5 Then - frmMain.SelectPanel(I).Value = False - Call VerFuncion(I, False) - End If -Next I - -modPaneles.VerFuncion 5, True +Call modPaneles.SetPanel(objects) End Sub @@ -3507,17 +3103,12 @@ Private Sub mnuOrgEdit_Click() Call frmOrgEditor.Show(vbModal) End Sub -Private Sub mnuPng_Click() -frmRender.formatPic = eFormatPic.png -Call frmRender.Show(vbModal) -End Sub - Private Sub mnuQBloquear_Click() '************************************************* 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -modPaneles.VerFuncion 2, False +Call modPaneles.SetPanel(Blocks) End Sub Private Sub mnuQNPCs_Click() @@ -3525,7 +3116,7 @@ Private Sub mnuQNPCs_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -modPaneles.VerFuncion 3, False +Call modPaneles.SetPanel(NPC) End Sub Private Sub mnuQNPCsHostiles_Click() @@ -3533,7 +3124,7 @@ Private Sub mnuQNPCsHostiles_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -modPaneles.VerFuncion 4, False +Call modPaneles.SetPanel(NPCHostile) End Sub Private Sub mnuQObjetos_Click() @@ -3541,7 +3132,7 @@ Private Sub mnuQObjetos_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -modPaneles.VerFuncion 5, False +Call modPaneles.SetPanel(objects) End Sub Private Sub mnuQSuperficie_Click() @@ -3549,7 +3140,7 @@ Private Sub mnuQSuperficie_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -modPaneles.VerFuncion 0, False +Call modPaneles.SetPanel(Surfaces) End Sub Private Sub mnuQTranslados_Click() @@ -3557,7 +3148,7 @@ Private Sub mnuQTranslados_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -modPaneles.VerFuncion 1, False +Call modPaneles.SetPanel(Exits) End Sub Private Sub mnuQTriggers_Click() @@ -3565,7 +3156,7 @@ Private Sub mnuQTriggers_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -modPaneles.VerFuncion 6, False +Call modPaneles.SetPanel(Triggers) End Sub Private Sub mnuQuitarBloqueos_Click() @@ -3717,14 +3308,7 @@ Private Sub mnuSuperficie_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Dim I As Byte - -For I = 1 To 6 - frmMain.SelectPanel(I).Value = False - Call VerFuncion(I, False) -Next I - -modPaneles.VerFuncion 0, True +Call modPaneles.SetPanel(Surfaces) End Sub Private Sub mnuTranslados_Click() @@ -3732,16 +3316,7 @@ Private Sub mnuTranslados_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Dim I As Byte - -For I = 0 To 6 - If I <> 1 Then - frmMain.SelectPanel(I).Value = False - Call VerFuncion(I, False) - End If -Next I - -modPaneles.VerFuncion 1, True +Call modPaneles.SetPanel(Exits) End Sub Private Sub mnuTriggers_Click() @@ -3749,14 +3324,7 @@ Private Sub mnuTriggers_Click() 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Dim I As Byte - -For I = 0 To 5 - frmMain.SelectPanel(I).Value = False - Call VerFuncion(I, False) -Next I - -modPaneles.VerFuncion 6, True +Call modPaneles.SetPanel(Triggers) End Sub Private Sub mnuUtilizarDeshacer_Click() @@ -3864,7 +3432,7 @@ MiRadarX = X MiRadarY = Y End Sub -Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) +Private Sub picMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '************************************************* 'Author: Unkwown 'Last modified: 20/05/06 - GS @@ -3875,10 +3443,6 @@ Dim tY As Integer If Not MapaCargado Then Exit Sub -If X <= MainViewShp.Left Or X >= MainViewShp.Left + MainViewWidth Or Y <= MainViewShp.Top Or Y >= MainViewShp.Top + MainViewHeight Then - Exit Sub -End If - ConvertCPtoTP MouseX, MouseY, tx, tY ClickEdit Button, tx, tY @@ -3887,7 +3451,7 @@ MouseDownX = tx MouseDownY = tY End Sub -Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) +Private Sub picMain_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) '************************************************* 'Author: Unkwown 'Last modified: 20/05/06 - GS @@ -3900,27 +3464,8 @@ Dim tY As Integer If Not MapaCargado Then Exit Sub HotKeysAllow = True -MouseX = X - MainViewShp.Left -MouseY = Y - MainViewShp.Top - -'Trim to fit screen -If MouseX < 0 Then - MouseX = 0 -ElseIf MouseX > MainViewShp.Width Then - MouseX = MainViewShp.Width -End If - -'Trim to fit screen -If MouseY < 0 Then - MouseY = 0 -ElseIf MouseY > MainViewShp.Height Then - MouseY = MainViewShp.Height -End If - -'Make sure click is in view window -If X <= MainViewShp.Left Or X >= MainViewShp.Left + MainViewWidth Or Y <= MainViewShp.Top Or Y >= MainViewShp.Top + MainViewHeight Then - Exit Sub -End If +MouseX = X +MouseY = Y ConvertCPtoTP MouseX, MouseY, tx, tY @@ -3940,7 +3485,7 @@ Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) 'Author: ^[GS]^ 'Last modified: 16/10/06 '************************************************* -Dim I As Long +Dim i As Long ' Guardar configuración WriteVar IniPath & "WorldEditor.ini", "CONFIGURACION", "GuardarConfig", IIf(frmMain.mnuGuardarUltimaConfig.Checked = True, "1", "0") @@ -3954,9 +3499,9 @@ If frmMain.mnuGuardarUltimaConfig.Checked Then WriteVar IniPath & "WorldEditor.ini", "MOSTRAR", "ControlAutomatico", IIf(frmMain.mnuVerAutomatico.Checked = True, "1", "0") - For I = 2 To 4 - WriteVar IniPath & "WorldEditor.ini", "MOSTRAR", "Capa" & I, IIf(bVerCapa(I), "1", "0") - Next I + For i = 2 To 4 + WriteVar IniPath & "WorldEditor.ini", "MOSTRAR", "Capa" & i, IIf(bVerCapa(i), "1", "0") + Next i WriteVar IniPath & "WorldEditor.ini", "MOSTRAR", "Translados", IIf(bTranslados, "1", "0") WriteVar IniPath & "WorldEditor.ini", "MOSTRAR", "Objetos", IIf(bVerObjetos, "1", "0") @@ -3981,17 +3526,11 @@ Private Sub SelectPanel_Click(index As Integer) 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Dim I As Byte - -For I = 0 To 6 - If I <> index Then - SelectPanel(I).Value = False - Call VerFuncion(I, False) - End If -Next I - +Dim panel As PanelsTypes +panel = index +Call modPaneles.SetPanel(panel) If mnuAutoQuitarFunciones.Checked = True Then Call mnuQuitarFunciones_Click -Call VerFuncion(index, SelectPanel(index).Value) +'Call VerFuncion(index, SelectPanel(index).Value) End Sub Private Sub TimAutoGuardarMapa_Timer() diff --git a/Codigo/frmMain.frx b/Codigo/frmMain.frx index 68f7056..68f4246 100644 Binary files a/Codigo/frmMain.frx and b/Codigo/frmMain.frx differ diff --git a/Codigo/frmMapInfo.frm b/Codigo/frmMapInfo.frm index d7f6e4e..8ab3fde 100644 --- a/Codigo/frmMapInfo.frm +++ b/Codigo/frmMapInfo.frm @@ -561,6 +561,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by diff --git a/Codigo/frmMusica.frm b/Codigo/frmMusica.frm index 52f6058..f15976c 100644 --- a/Codigo/frmMusica.frm +++ b/Codigo/frmMusica.frm @@ -27,24 +27,15 @@ Begin VB.Form frmMusica TabIndex = 3 Top = 1320 Width = 2415 - _ExtentX = 4260 - _ExtentY = 873 - Caption = "&Cerrar" - CapAlign = 2 - BackStyle = 2 - BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - cGradient = 0 - Mode = 0 - Value = 0 'False - cBack = -2147483633 + _extentx = 4260 + _extenty = 873 + caption = "&Cerrar" + capalign = 2 + backstyle = 2 + cgradient = 0 + mode = 0 + value = 0 + cback = -2147483633 End Begin WorldEditor.lvButtons_H cmdAplicarYCerrar Height = 495 @@ -52,25 +43,16 @@ Begin VB.Form frmMusica TabIndex = 2 Top = 720 Width = 2415 - _ExtentX = 4260 - _ExtentY = 873 - Caption = "&Aplicar y Cerrar" - CapAlign = 2 - BackStyle = 2 - BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - cGradient = 0 - Mode = 0 - Value = 0 'False - Enabled = 0 'False - cBack = 12648447 + _extentx = 4260 + _extenty = 873 + caption = "&Aplicar y Cerrar" + capalign = 2 + backstyle = 2 + cgradient = 0 + mode = 0 + value = 0 + enabled = 0 + cback = 12648447 End Begin WorldEditor.lvButtons_H cmdDetener Height = 495 @@ -78,25 +60,16 @@ Begin VB.Form frmMusica TabIndex = 1 Top = 120 Width = 1215 - _ExtentX = 2143 - _ExtentY = 873 - Caption = "&Detener" - CapAlign = 2 - BackStyle = 2 - BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - cGradient = 0 - Mode = 0 - Value = 0 'False - Enabled = 0 'False - cBack = 12632319 + _extentx = 2143 + _extenty = 873 + caption = "&Detener" + capalign = 2 + backstyle = 2 + cgradient = 0 + mode = 0 + value = 0 + enabled = 0 + cback = 12632319 End Begin WorldEditor.lvButtons_H cmdEscuchar Height = 495 @@ -104,24 +77,15 @@ Begin VB.Form frmMusica TabIndex = 0 Top = 120 Width = 1215 - _ExtentX = 2143 - _ExtentY = 873 - Caption = "&Escuchar" - CapAlign = 2 - BackStyle = 2 - BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - cGradient = 0 - Mode = 0 - Value = 0 'False - cBack = 12648384 + _extentx = 2143 + _extenty = 873 + caption = "&Escuchar" + capalign = 2 + backstyle = 2 + cgradient = 0 + mode = 0 + value = 0 + cback = 12648384 End End Attribute VB_Name = "frmMusica" @@ -129,6 +93,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form.Tools") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by diff --git a/Codigo/frmOptimizar.frm b/Codigo/frmOptimizar.frm index 25aa8cf..8d77969 100644 --- a/Codigo/frmOptimizar.frm +++ b/Codigo/frmOptimizar.frm @@ -2,32 +2,38 @@ VERSION 5.00 Begin VB.Form frmOptimizar BorderStyle = 1 'Fixed Single Caption = "Optimizar Mapa" - ClientHeight = 3525 + ClientHeight = 4125 ClientLeft = 45 ClientTop = 435 ClientWidth = 3600 Icon = "frmOptimizar.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False - ScaleHeight = 3525 + ScaleHeight = 4125 ScaleWidth = 3600 StartUpPosition = 2 'CenterScreen + Begin VB.CheckBox chkRemoverRecursosCapa3 + Caption = "Eliminar Recursos (Arboles y Yacimientos) de capa 3" + Height = 375 + Left = 120 + TabIndex = 8 + Top = 2640 + Width = 3375 + End Begin VB.CheckBox chkBloquearArbolesEtc Caption = "Bloquear Arboles, Carteles, Foros y Yacimientos" Height = 375 Left = 120 TabIndex = 7 Top = 2160 - Value = 1 'Checked Width = 3375 End Begin VB.CheckBox chkMapearArbolesEtc - Caption = "Mapear Arboles, Carteles, Foros y Yacimientos que no esten en la 3ra Capa" + Caption = "Mapear Carteles y Foros que no esten en la 3ra Capa" Height = 375 Left = 120 TabIndex = 4 Top = 1680 - Value = 1 'Checked Width = 3375 End Begin VB.CheckBox chkQuitarTodoBordes @@ -44,7 +50,6 @@ Begin VB.Form frmOptimizar Left = 120 TabIndex = 2 Top = 840 - Value = 1 'Checked Width = 3375 End Begin VB.CheckBox chkQuitarTrigBloq @@ -53,7 +58,6 @@ Begin VB.Form frmOptimizar Left = 120 TabIndex = 1 Top = 480 - Value = 1 'Checked Width = 3375 End Begin VB.CheckBox chkQuitarTrans @@ -62,7 +66,6 @@ Begin VB.Form frmOptimizar Left = 120 TabIndex = 0 Top = 120 - Value = 1 'Checked Width = 3375 End Begin WorldEditor.lvButtons_H cOptimizar @@ -70,7 +73,7 @@ Begin VB.Form frmOptimizar Height = 735 Left = 120 TabIndex = 5 - Top = 2640 + Top = 3240 Width = 1815 _ExtentX = 3201 _ExtentY = 1296 @@ -78,10 +81,10 @@ Begin VB.Form frmOptimizar CapAlign = 2 BackStyle = 2 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "Arial" - Size = 8.25 + Name = "Times New Roman" + Size = 9 Charset = 0 - Weight = 700 + Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False @@ -95,7 +98,7 @@ Begin VB.Form frmOptimizar Height = 735 Left = 1920 TabIndex = 6 - Top = 2640 + Top = 3240 Width = 1575 _ExtentX = 2778 _ExtentY = 1296 @@ -103,8 +106,8 @@ Begin VB.Form frmOptimizar CapAlign = 2 BackStyle = 2 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "Arial" - Size = 8.25 + Name = "Times New Roman" + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False @@ -122,6 +125,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form.Tools") Option Explicit @@ -132,6 +136,7 @@ Private Sub Optimizar() '************************************************* Dim Y As Integer Dim X As Integer +Dim CleanedSomething As Boolean If Not MapaCargado Then Exit Sub @@ -149,7 +154,7 @@ For Y = YMinMapSize To YMaxMapSize For X = XMinMapSize To XMaxMapSize With MapData(X, Y) ' ** Quitar NPCs, Objetos y Translados en los Bordes Exteriores - If (X < MinXBorder Or X > MaxXBorder Or Y < MinYBorder Or Y > MaxYBorder) And (chkQuitarTodoBordes.value = 1) Then + If (X < MinXBorder Or X > MaxXBorder Or Y < MinYBorder Or Y > MaxYBorder) And (chkQuitarTodoBordes.Value = 1) Then 'Quitar NPCs If .NPCIndex > 0 Then EraseChar .CharIndex @@ -159,51 +164,88 @@ For Y = YMinMapSize To YMaxMapSize ' Quitar Objetos .OBJInfo.objindex = 0 .OBJInfo.Amount = 0 - .ObjGrh.GrhIndex = 0 + .ObjGrh.grhIndex = 0 ' Quitar Translados .TileExit.Map = 0 .TileExit.X = 0 .TileExit.Y = 0 ' Quitar Triggers .Trigger = 0 + End If ' ** Quitar Translados y Triggers en Bloqueo If (.Blocked = 1) Then - If (.TileExit.Map > 0) And (chkQuitarTrans.value = 1) Then ' Quita Translado Bloqueado + If (.TileExit.Map > 0) And (chkQuitarTrans.Value = 1) Then ' Quita Translado Bloqueado .TileExit.Map = 0 .TileExit.Y = 0 .TileExit.X = 0 - ElseIf (.Trigger > 0) And (chkQuitarTrigBloq.value = 1) Then ' Quita Trigger Bloqueado + ElseIf (.Trigger > 0) And (chkQuitarTrigBloq.Value = 1) Then ' Quita Trigger Bloqueado .Trigger = 0 End If End If ' ** Quitar Triggers en Translado - If (.TileExit.Map > 0) And (chkQuitarTrigTrans.value = 1) Then + If (.TileExit.Map > 0) And (chkQuitarTrigTrans.Value = 1) Then If (.Trigger > 0) Then ' Quita Trigger en Translado .Trigger = 0 End If End If ' ** Mapea Arboles, Carteles, Foros y Yacimientos que no esten en la 3ra Capa - If (.OBJInfo.objindex > 0) And ((chkMapearArbolesEtc.value = 1) Or (chkBloquearArbolesEtc.value = 1)) Then + If (.OBJInfo.objindex > 0) And ((chkMapearArbolesEtc.Value = 1) Or (chkBloquearArbolesEtc.Value = 1)) Then Select Case ObjData(.OBJInfo.objindex).ObjType - Case 4, 8, 10, 22 ' Arboles, Carteles, Foros, Yacimientos - If (.Graphic(3).GrhIndex <> .ObjGrh.GrhIndex) And (chkMapearArbolesEtc.value = 1) Then .Graphic(3) = .ObjGrh - If (chkBloquearArbolesEtc.value = 1) And (.Blocked = 0) Then .Blocked = 1 + Case 8, 10 ' Carteles, Foros + If (.Graphic(3).grhIndex <> .ObjGrh.grhIndex) And (chkMapearArbolesEtc.Value = 1) Then .Graphic(3) = .ObjGrh + If (chkBloquearArbolesEtc.Value = 1) And (.Blocked = 0) Then .Blocked = 1 + Case 45 + End Select End If + + ' ** Mapea Arboles, Carteles, Foros y Yacimientos que no esten en la 3ra Capa + If (.OBJInfo.objindex > 0) And ((chkMapearArbolesEtc.Value = 1) Or (chkBloquearArbolesEtc.Value = 1)) Then + Select Case ObjData(.OBJInfo.objindex).ObjType + Case 8, 10 ' Carteles, Foros + If (.Graphic(3).grhIndex <> .ObjGrh.grhIndex) And (chkMapearArbolesEtc.Value = 1) Then .Graphic(3) = .ObjGrh + If (chkBloquearArbolesEtc.Value = 1) And (.Blocked = 0) Then .Blocked = 1 + End Select + End If + + ' ** Borrar Recursos (Arboles y Yacimientos) de capa 3 + If .OBJInfo.objindex > 0 And chkRemoverRecursosCapa3.Value = 1 Then + If .OBJInfo.objindex > 0 Then + Dim GrhToClean As Integer + GrhToClean = ObjData(.OBJInfo.objindex).grhIndex + + If ObjData(MapData(X, Y).OBJInfo.objindex).ObjType = 45 And .Graphic(3).grhIndex = GrhToClean Then + CleanedSomething = True + Call QuitarGrhDeCapa(3, X, Y, True) + frmResultados.AgregarLinea ("Removiendo Grh de posicion X-Y(" & X & "-" & Y & ") porque era el mismo que el objeto " & .OBJInfo.objindex) + End If + End If + + End If + + + End With Next X Next Y +If CleanedSomething Then + frmResultados.Show +End If + 'Set changed flag MapInfo.Changed = 1 +Unload Me + End Sub + Private Sub cCancelar_Click() '************************************************* 'Author: ^[GS]^ diff --git a/Codigo/frmOrgEditor.frm b/Codigo/frmOrgEditor.frm index 9c2ba24..da3e0a7 100644 --- a/Codigo/frmOrgEditor.frm +++ b/Codigo/frmOrgEditor.frm @@ -136,6 +136,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form") '************************************************* 'Author: Anagrama 'Last modified: 13/08/2016 diff --git a/Codigo/frmPalett.frm b/Codigo/frmPalett.frm new file mode 100644 index 0000000..c0dbc3b --- /dev/null +++ b/Codigo/frmPalett.frm @@ -0,0 +1,195 @@ +VERSION 5.00 +Object = "{97FD4A65-A045-4F5C-8C6C-262505F7C013}#6.0#0"; "Argentum.ocx" +Begin VB.Form frmPalett + Caption = "Form1" + ClientHeight = 8625 + ClientLeft = 120 + ClientTop = 465 + ClientWidth = 15540 + LinkTopic = "Form1" + ScaleHeight = 575 + ScaleMode = 3 'Pixel + ScaleWidth = 1036 + StartUpPosition = 3 'Windows Default + Begin VB.VScrollBar VScroll + Height = 8235 + LargeChange = 32 + Left = 13020 + SmallChange = 16 + TabIndex = 1 + Top = 30 + Width = 405 + End + Begin ArgentumOCX.MyPicture pic + CausesValidation= 0 'False + Height = 8625 + Left = 0 + TabIndex = 0 + Top = 0 + Width = 12045 + _ExtentX = 21246 + _ExtentY = 15214 + End +End +Attribute VB_Name = "frmPalett" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +'@Folder("WorldEditor.Form.Tools") +Option Explicit +Private device As Integer +Private Type GrhMap + grhIndex As Integer + Name As String + RECT As RECT +End Type + +Private Map() As GrhMap +Private selected As Integer +Private OffsetY As Integer +Private totalHeigth As Integer + +Private Sub Form_Initialize() + ReDim Map(UBound(SupData)) + + Dim i As Integer + + For i = 0 To UBound(SupData) + Map(i).grhIndex = SupData(i).Grh + Map(i).Name = SupData(i).Name + Next i + + Call GenerateMap + + device = wGL_Graphic.Create_Device_From_Display(pic.hwnd, pic.ScaleWidth * 3, pic.ScaleHeight * 3) + Invalidate pic.hwnd +End Sub + +Private Sub GenerateMap() + Dim drawX As Integer + Dim drawY As Integer + Dim bestY As Integer + Dim i As Integer + + For i = 0 To UBound(Map) + With GrhData(Map(i).grhIndex) + + Map(i).RECT.Left = drawX + Map(i).RECT.Top = drawY + Map(i).RECT.Right = drawX + .pixelWidth + Map(i).RECT.Bottom = drawY + .pixelHeight + + + If .pixelHeight > bestY Then + bestY = .pixelHeight + End If + drawX = drawX + .pixelWidth + If drawX > pic.ScaleWidth Then + drawX = 0 + drawY = drawY + bestY + bestY = 0 + End If + End With + Next + + totalHeigth = drawY +End Sub +Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) + Cancel = 1 + Me.Hide +End Sub + +Private Sub Form_Resize() + pic.Width = Me.ScaleWidth - Me.VScroll.Width + pic.Height = Me.ScaleHeight + VScroll.Left = pic.Width + VScroll.Height = Me.ScaleHeight + + Call GenerateMap + VScroll.max = totalHeigth + VScroll.LargeChange = pic.Height - 32 + Pic_Paint + +End Sub + +Private Sub Form_Terminate() + Call wGL_Graphic.Destroy_Device(device) +End Sub + +Private Sub pic_DblClick() + ReDim Map(UBound(SupData)) + + Dim i As Integer + + Dim max As Integer + + For i = 0 To UBound(SupData) + With SupData(i) + If InStr(1, .Name, "piso", vbTextCompare) Then + Map(max).grhIndex = SupData(i).Grh + Map(max).Name = SupData(i).Name + max = max + 1 + End If + End With + Next i + + If max = 0 Then + max = 1 + End If + + ReDim Preserve Map(max - 1) + selected = 0 + Call GenerateMap + Pic_Paint + selected = 0 + VScroll.max = totalHeigth +End Sub + +Private Sub pic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) +VScroll.SetFocus + Dim i As Integer + Y = Y - OffsetY + For i = 0 To UBound(Map) + With Map(i) + If X > .RECT.Left And X < .RECT.Right And Y > .RECT.Top And Y < .RECT.Bottom Then + If selected <> i Then + selected = i + Me.Caption = .Name & "(" & .grhIndex & ")" + Pic_Paint + End If + Exit Sub + End If + + End With + Next +End Sub +Private Sub Pic_Paint() + Dim drawX As Integer + Dim drawY As Integer + Dim bestY As Integer + Dim i As Integer + + + Call wGL_Graphic.Use_Device(device) + Call wGL_Graphic.Clear(CLEAR_COLOR Or CLEAR_DEPTH Or CLEAR_STENCIL, &H0, 1#, 0) + Call wGL_Graphic_Renderer.Update_Projection(&H0, pic.ScaleWidth, pic.ScaleHeight) + + For i = 0 To UBound(Map) + With Map(i) + Call DrawGrhIndex(.grhIndex, .RECT.Left, .RECT.Top + OffsetY, -1#, 0) + End With + Next + + With Map(selected) + Call modPrimitives.DrawBox(.RECT.Left, .RECT.Top + OffsetY, .RECT.Right, .RECT.Bottom + OffsetY, &H60FFFFFF) + End With + + + Call wGL_Graphic_Renderer.Flush +End Sub + +Private Sub VScroll_Change() + OffsetY = -VScroll.Value + Pic_Paint +End Sub diff --git a/Codigo/frmRender.frm b/Codigo/frmRender.frm index 03a74a8..95752a6 100644 --- a/Codigo/frmRender.frm +++ b/Codigo/frmRender.frm @@ -1,110 +1,53 @@ VERSION 5.00 -Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.ocx" +Object = "{97FD4A65-A045-4F5C-8C6C-262505F7C013}#6.0#0"; "Argentum.ocx" Begin VB.Form frmRender BorderStyle = 1 'Fixed Single Caption = "Renderizado" - ClientHeight = 1545 + ClientHeight = 13515 ClientLeft = 45 ClientTop = 435 - ClientWidth = 7455 + ClientWidth = 25620 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False - ScaleHeight = 103 + ScaleHeight = 901 ScaleMode = 3 'Pixel - ScaleWidth = 497 + ScaleWidth = 1708 StartUpPosition = 3 'Windows Default - Begin VB.PictureBox tmpPic - AutoRedraw = -1 'True - Height = 855 - Left = 2280 - ScaleHeight = 53 - ScaleMode = 3 'Pixel - ScaleWidth = 117 - TabIndex = 9 - Top = 1800 - Width = 1815 - End - Begin VB.TextBox txtSizeY - Height = 285 - Left = 1920 - TabIndex = 7 - Text = "3200" - Top = 120 - Width = 495 - End - Begin VB.PictureBox picMap - AutoRedraw = -1 'True - Height = 855 + Begin WorldEditor.UcRenderOptions renderOption + Height = 3615 Left = 120 - ScaleHeight = 53 - ScaleMode = 3 'Pixel - ScaleWidth = 117 - TabIndex = 6 - Top = 1800 - Width = 1815 + TabIndex = 3 + Top = 60 + Width = 2835 + _extentx = 5001 + _extenty = 4948 + End + Begin ArgentumOCX.MyPicture slave + CausesValidation= 0 'False + Height = 2715 + Left = 2970 + TabIndex = 2 + Top = 60 + Width = 3885 + _ExtentX = 6853 + _ExtentY = 4789 End Begin VB.CommandButton cmdCancelar Caption = "Cancelar" Height = 375 - Left = 1800 - TabIndex = 5 - Top = 1080 - Width = 1695 + Left = 90 + TabIndex = 1 + Top = 3720 + Width = 1275 End Begin VB.CommandButton cmdAceptar Caption = "Aceptar" Height = 375 - Left = 3960 - TabIndex = 4 - Top = 1080 - Width = 1695 - End - Begin VB.TextBox txtSizeX - Height = 285 - Left = 720 - TabIndex = 3 - Text = "3200" - Top = 120 - Width = 495 - End - Begin MSComctlLib.ProgressBar pgbProgress - Height = 255 - Left = 120 + Left = 1680 TabIndex = 0 - Top = 720 - Width = 7215 - _ExtentX = 12726 - _ExtentY = 450 - _Version = 393216 - Appearance = 1 - End - Begin VB.Label Label2 - AutoSize = -1 'True - Caption = "Alto:" - Height = 195 - Left = 1440 - TabIndex = 8 - Top = 120 - Width = 315 - End - Begin VB.Label Label1 - AutoSize = -1 'True - Caption = "Ancho:" - Height = 195 - Left = 120 - TabIndex = 2 - Top = 120 - Width = 510 - End - Begin VB.Label lblEstado - Alignment = 2 'Center - Caption = "0%" - Height = 255 - Left = 120 - TabIndex = 1 - Top = 480 - Width = 7215 + Top = 3720 + Width = 1275 End End Attribute VB_Name = "frmRender" @@ -112,49 +55,30 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form") Option Explicit +Private WithEvents exporter As clsMapExport +Attribute exporter.VB_VarHelpID = -1 Public formatPic As eFormatPic Private Sub cmdAceptar_Click() -Dim SizeX As Long -Dim SizeY As Long - -If Not IsNumeric(txtSizeX.Text) Then - MsgBox "El ancho es inválido." - Exit Sub -End If -If Not IsNumeric(txtSizeY.Text) Then - MsgBox "El alto es inválido." - Exit Sub -End If - -SizeX = txtSizeX.Text -SizeY = txtSizeY.Text - - -Call MapCapture(formatPic, SizeX, SizeY) -Unload Me + Set exporter = New clsMapExport + Call Me.renderOption.ConfigureExporter(exporter) + Call exporter.SetPicture(slave) + + + Call exporter.Capture End Sub Private Sub cmdCancelar_Click() -Unload Me + Unload Me End Sub -Private Sub txtSizeX_KeyPress(KeyAscii As Integer) -If (Not IsNumeric(Chr$(KeyAscii))) And _ - (KeyAscii <> 8) And _ - (KeyAscii <> 44) And _ - (KeyAscii <> 46) Then KeyAscii = 0 +Private Sub Form_Unload(Cancel As Integer) + Set exporter = Nothing End Sub -Private Sub txtSizeY_KeyPress(KeyAscii As Integer) -If (Not IsNumeric(Chr$(KeyAscii))) And _ - (KeyAscii <> 8) And _ - (KeyAscii <> 44) And _ - (KeyAscii <> 46) Then KeyAscii = 0 +Private Sub exporter_OnCaptured() + Unload Me End Sub - - - - diff --git a/Codigo/frmRenderAll.frm b/Codigo/frmRenderAll.frm index 8d52636..58e056c 100644 --- a/Codigo/frmRenderAll.frm +++ b/Codigo/frmRenderAll.frm @@ -1,5 +1,5 @@ VERSION 5.00 -Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.ocx" +Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx" Begin VB.Form frmRenderAll BorderStyle = 1 'Fixed Single Caption = "Renderizar todos los mapas" @@ -134,6 +134,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form") '************************************************* 'Author: Anagrama 'Last modified: 13/08/2016 diff --git a/Codigo/frmResultados.frm b/Codigo/frmResultados.frm new file mode 100644 index 0000000..8e48e4e --- /dev/null +++ b/Codigo/frmResultados.frm @@ -0,0 +1,73 @@ +VERSION 5.00 +Begin VB.Form frmResultados + Caption = "Resultados de la última tarea" + ClientHeight = 9630 + ClientLeft = 120 + ClientTop = 465 + ClientWidth = 9585 + LinkTopic = "Form1" + ScaleHeight = 9630 + ScaleWidth = 9585 + StartUpPosition = 1 'CenterOwner + Begin VB.TextBox txtResultados + Height = 8535 + Left = 120 + Locked = -1 'True + MultiLine = -1 'True + ScrollBars = 2 'Vertical + TabIndex = 1 + Top = 120 + Width = 9375 + End + Begin WorldEditor.lvButtons_H cmdCerrar + Height = 495 + Left = 240 + TabIndex = 0 + Top = 9000 + Width = 9015 + _ExtentX = 15901 + _ExtentY = 873 + Caption = "Cerrar" + CapAlign = 2 + BackStyle = 2 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "Times New Roman" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + cGradient = 0 + Mode = 0 + Value = 0 'False + cBack = -2147483633 + End + Begin VB.Line Line1 + BorderColor = &H00808080& + X1 = 120 + X2 = 9480 + Y1 = 8880 + Y2 = 8880 + End +End +Attribute VB_Name = "frmResultados" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Private Sub cmdCerrar_Click() + txtResultados.Text = "" + Unload Me +End Sub + +Public Sub AgregarLinea(ByRef Texto As String) + txtResultados.Text = txtResultados.Text & vbCrLf & Texto +End Sub + +Private Sub Form_Load() + +End Sub diff --git a/Codigo/frmUnionAdyasente.frm b/Codigo/frmUnionAdyasente.frm index 749a219..f77c1a4 100644 --- a/Codigo/frmUnionAdyasente.frm +++ b/Codigo/frmUnionAdyasente.frm @@ -76,24 +76,15 @@ Begin VB.Form frmUnionAdyacente TabIndex = 29 Top = 4080 Width = 1335 - _ExtentX = 2355 - _ExtentY = 661 - Caption = "&Aplicar" - CapAlign = 2 - BackStyle = 2 - BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - cGradient = 0 - Mode = 0 - Value = 0 'False - cBack = -2147483633 + _extentx = 2355 + _extenty = 661 + caption = "&Aplicar" + capalign = 2 + backstyle = 2 + cgradient = 0 + mode = 0 + value = 0 + cback = -2147483633 End Begin VB.TextBox PosLim BackColor = &H008080FF& @@ -410,24 +401,15 @@ Begin VB.Form frmUnionAdyacente TabIndex = 30 Top = 4080 Width = 1335 - _ExtentX = 2355 - _ExtentY = 661 - Caption = "&Cancelar" - CapAlign = 2 - BackStyle = 2 - BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - cGradient = 0 - Mode = 0 - Value = 0 'False - cBack = -2147483633 + _extentx = 2355 + _extenty = 661 + caption = "&Cancelar" + capalign = 2 + backstyle = 2 + cgradient = 0 + mode = 0 + value = 0 + cback = -2147483633 End Begin WorldEditor.lvButtons_H cmdDefault Height = 375 @@ -435,24 +417,15 @@ Begin VB.Form frmUnionAdyacente TabIndex = 31 Top = 4080 Width = 1095 - _ExtentX = 1931 - _ExtentY = 661 - Caption = "&Default" - CapAlign = 2 - BackStyle = 2 - BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} - Name = "MS Sans Serif" - Size = 8.25 - Charset = 0 - Weight = 400 - Underline = 0 'False - Italic = 0 'False - Strikethrough = 0 'False - EndProperty - cGradient = 0 - Mode = 0 - Value = 0 'False - cBack = -2147483633 + _extentx = 1931 + _extenty = 661 + caption = "&Default" + capalign = 2 + backstyle = 2 + cgradient = 0 + mode = 0 + value = 0 + cback = -2147483633 End Begin VB.CheckBox AutoMapeo BackColor = &H00E0E0E0& @@ -975,6 +948,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +'@Folder("WorldEditor.Form.Tools") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -1001,13 +975,13 @@ Private Sub Aplicar_Click(index As Integer) 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* -Dim i As Byte +Dim I As Byte cmdAplicar.Enabled = False -For i = 0 To 3 - If Aplicar(i).value = 1 Then cmdAplicar.Enabled = True -Next i +For I = 0 To 3 + If Aplicar(I).Value = 1 Then cmdAplicar.Enabled = True +Next I End Sub Private Sub cmdAplicar_Click() @@ -1020,7 +994,7 @@ Dim X As Integer Dim Y As Integer Dim DestX As Integer Dim DestY As Integer -Dim i As Byte +Dim I As Byte Dim tempMap(XMinMapSize To XMaxMapSize, YMinMapSize To YMaxMapSize) As MapBlock If Not MapaCargado Then Exit Sub @@ -1028,7 +1002,7 @@ If Not MapaCargado Then Exit Sub modEdicion.Deshacer_Add "Insertar Translados a mapas Adyasentes" ' Hago deshacer ' ARRIBA -If Mapa(0).Text > -1 And Aplicar(0).value = 1 Then +If Mapa(0).Text > -1 And Aplicar(0).Value = 1 Then Y = PosLim(1).Text DestY = PosLim(4).Text @@ -1048,21 +1022,21 @@ If Mapa(0).Text > -1 And Aplicar(0).value = 1 Then End With Next X - If AutoMapeo(0).value = 1 Then + If AutoMapeo(0).Value = 1 Then Call AbrirMapa(PATH_Save & "Mapa" & Mapa(0).Text & ".map", tempMap(), True) For Y = YMinMapSize To PosLim(1).Text For X = XMinMapSize To XMaxMapSize - For i = 1 To 4 - MapData(X, Y).Graphic(i) = tempMap(X, Y - Val(PosLim(1).Text) + Val(PosLim(4).Text)).Graphic(i) - Next i + For I = 1 To 4 + MapData(X, Y).Graphic(I) = tempMap(X, Y - Val(PosLim(1).Text) + Val(PosLim(4).Text)).Graphic(I) + Next I Next X Next Y End If End If ' DERECHA -If Mapa(1).Text > -1 And Aplicar(1).value = 1 Then +If Mapa(1).Text > -1 And Aplicar(1).Value = 1 Then X = PosLim(2).Text DestX = PosLim(6).Text @@ -1082,21 +1056,21 @@ If Mapa(1).Text > -1 And Aplicar(1).value = 1 Then End With Next Y - If AutoMapeo(1).value = 1 Then + If AutoMapeo(1).Value = 1 Then Call AbrirMapa(PATH_Save & "Mapa" & Mapa(1).Text & ".map", tempMap(), True) For X = PosLim(2).Text To XMaxMapSize For Y = YMinMapSize To YMaxMapSize - For i = 1 To 4 - MapData(X, Y).Graphic(i) = tempMap(X - Val(PosLim(2).Text) + Val(PosLim(6).Text), Y).Graphic(i) - Next i + For I = 1 To 4 + MapData(X, Y).Graphic(I) = tempMap(X - Val(PosLim(2).Text) + Val(PosLim(6).Text), Y).Graphic(I) + Next I Next Y Next X End If End If ' ABAJO -If Mapa(2).Text > -1 And Aplicar(2).value = 1 Then +If Mapa(2).Text > -1 And Aplicar(2).Value = 1 Then Y = PosLim(0).Text DestY = PosLim(5).Text @@ -1116,21 +1090,21 @@ If Mapa(2).Text > -1 And Aplicar(2).value = 1 Then End With Next X - If AutoMapeo(2).value = 1 Then + If AutoMapeo(2).Value = 1 Then Call AbrirMapa(PATH_Save & "Mapa" & Mapa(2).Text & ".map", tempMap(), True) For Y = PosLim(0).Text To YMaxMapSize For X = XMinMapSize To XMaxMapSize - For i = 1 To 4 - MapData(X, Y).Graphic(i) = tempMap(X, Y - Val(PosLim(0).Text) + Val(PosLim(5).Text)).Graphic(i) - Next i + For I = 1 To 4 + MapData(X, Y).Graphic(I) = tempMap(X, Y - Val(PosLim(0).Text) + Val(PosLim(5).Text)).Graphic(I) + Next I Next X Next Y End If End If ' IZQUIERDA -If Mapa(3).Text > -1 And Aplicar(3).value = 1 Then +If Mapa(3).Text > -1 And Aplicar(3).Value = 1 Then X = PosLim(3).Text DestX = PosLim(7).Text @@ -1150,14 +1124,14 @@ If Mapa(3).Text > -1 And Aplicar(3).value = 1 Then End With Next Y - If AutoMapeo(3).value = 1 Then + If AutoMapeo(3).Value = 1 Then Call AbrirMapa(PATH_Save & "Mapa" & Mapa(3).Text & ".map", tempMap(), True) For X = XMinMapSize To PosLim(3).Text For Y = YMinMapSize To YMaxMapSize - For i = 1 To 4 - MapData(X, Y).Graphic(i) = tempMap(X - Val(PosLim(3).Text) + Val(PosLim(7).Text), Y).Graphic(i) - Next i + For I = 1 To 4 + MapData(X, Y).Graphic(I) = tempMap(X - Val(PosLim(3).Text) + Val(PosLim(7).Text), Y).Graphic(I) + Next I Next Y Next X End If @@ -1209,7 +1183,7 @@ For X = (PosLim(3).Text + 1) To (PosLim(2).Text - 1) End If Next X -Aplicar(0).value = 0 +Aplicar(0).Value = 0 ' DERECHA Mapa(1).Text = 0 @@ -1221,7 +1195,7 @@ For Y = (PosLim(1).Text + 1) To (PosLim(0).Text - 1) End If Next Y -Aplicar(1).value = 0 +Aplicar(1).Value = 0 ' ABAJO Mapa(2).Text = 0 @@ -1233,7 +1207,7 @@ For X = (PosLim(3).Text + 1) To (PosLim(2).Text - 1) End If Next X -Aplicar(2).value = 0 +Aplicar(2).Value = 0 ' IZQUIERDA Mapa(3).Text = 0 @@ -1245,7 +1219,7 @@ For Y = (PosLim(1).Text + 1) To (PosLim(0).Text - 1) End If Next Y -Aplicar(3).value = 0 +Aplicar(3).Value = 0 End Sub Private Sub Form_Load() @@ -1264,7 +1238,7 @@ Private Sub Mapa_Change(index As Integer) If LenB(Mapa(index).Text) = 0 Then Mapa(index).Text = 0 If Mapa(index).Text > NumMaps Then Mapa(index).Text = NumMaps -Aplicar(index).value = 1 +Aplicar(index).Value = 1 End Sub Private Sub Mapa_KeyPress(index As Integer, KeyAscii As Integer) @@ -1357,7 +1331,7 @@ Y = PosLim(1).Text For X = (PosLim(3).Text + 1) To (PosLim(2).Text - 1) If MapData(X, Y).TileExit.Map > 0 Then Mapa(0).Text = MapData(X, Y).TileExit.Map - Aplicar(0).value = 0 + Aplicar(0).Value = 0 Exit For End If Next X @@ -1367,7 +1341,7 @@ X = PosLim(2).Text For Y = (PosLim(1).Text + 1) To (PosLim(0).Text - 1) If MapData(X, Y).TileExit.Map > 0 Then Mapa(1).Text = MapData(X, Y).TileExit.Map - Aplicar(1).value = 0 + Aplicar(1).Value = 0 Exit For End If Next Y @@ -1377,7 +1351,7 @@ Y = PosLim(0).Text For X = (PosLim(3).Text + 1) To (PosLim(2).Text - 1) If MapData(X, Y).TileExit.Map > 0 Then Mapa(2).Text = MapData(X, Y).TileExit.Map - Aplicar(2).value = 0 + Aplicar(2).Value = 0 Exit For End If Next X @@ -1387,7 +1361,7 @@ X = PosLim(3).Text For Y = (PosLim(1).Text + 1) To (PosLim(0).Text - 1) If MapData(X, Y).TileExit.Map > 0 Then Mapa(3).Text = MapData(X, Y).TileExit.Map - Aplicar(3).value = 0 + Aplicar(3).Value = 0 Exit For End If Next Y diff --git a/Codigo/modCompression.bas b/Codigo/modCompression.bas index 19439a5..d2b1974 100644 --- a/Codigo/modCompression.bas +++ b/Codigo/modCompression.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modCompression" +'@Folder("WorldEditor.Modules") Option Explicit Public Const GRH_SOURCE_FILE_EXT As String = ".bmp" @@ -86,12 +87,12 @@ Private Function General_Drive_Get_Free_Bytes(ByVal DriveName As String) As Curr 'Last Modify Date: 6/07/2004 ' '************************************************************** - Dim retval As Long + Dim retVal As Long Dim FB As Currency Dim BT As Currency Dim FBT As Currency - retval = GetDiskFreeSpace(Left$(DriveName, 2), FB, BT, FBT) + retVal = GetDiskFreeSpace(Left$(DriveName, 2), FB, BT, FBT) General_Drive_Get_Free_Bytes = FB * 10000 'convert result to actual size in bytes End Function @@ -103,7 +104,7 @@ End Function ' @param first The first index in the list. ' @param last The last index in the list. -Private Sub Sort_Info_Headers(ByRef InfoHead() As INFOHEADER, ByVal first As Long, ByVal last As Long) +Public Sub Sort_Info_Headers(ByRef InfoHead() As INFOHEADER, ByVal first As Long, ByVal last As Long) '***************************************************************** 'Author: Nicolas Matias Gonzalez (NIGO) 'Last Modify Date: 08/20/2007 @@ -191,7 +192,7 @@ End Function ' ' @return True if found. -Private Function Get_InfoHeader(ByRef ResourcePath As String, ByRef FileName As String, ByRef InfoHead As INFOHEADER) As Boolean +Public Function Get_InfoHeader(ByRef ResourcePath As String, ByRef FileName As String, ByRef InfoHead As INFOHEADER) As Boolean '***************************************************************** 'Author: Nicolas Matias Gonzalez (NIGO) 'Last Modify Date: 08/21/2007 @@ -292,7 +293,7 @@ End Sub ' @param data() The data array. ' @param OrigSize The original data size. -Private Sub Decompress_Data(ByRef data() As Byte, ByVal OrigSize As Long) +Public Sub Decompress_Data(ByRef data() As Byte, ByVal OrigSize As Long) '***************************************************************** 'Author: Juan Martín Dotuyo Dodero 'Last Modify Date: 10/13/2004 @@ -325,7 +326,7 @@ End Sub ' ' @return True if no error occurred. -Public Function Compress_Files(ByRef SourcePath As String, ByRef OutputPath As String, ByVal version As Long, ByRef prgBar As ProgressBar) As Boolean +Public Function Compress_Files(ByRef SourcePath As String, ByRef OutputPath As String, ByVal Version As Long, ByRef prgBar As ProgressBar) As Boolean '***************************************************************** 'Author: Nicolas Matias Gonzalez (NIGO) 'Last Modify Date: 08/19/2007 @@ -376,7 +377,7 @@ On Local Error GoTo ErrHandler End If 'Finish setting the FileHeader data - FileHead.lngFileVersion = version + FileHead.lngFileVersion = Version FileHead.lngFileSize = Len(FileHead) + FileHead.lngNumFiles * Len(InfoHead(0)) 'Order the InfoHeads @@ -593,7 +594,7 @@ On Local Error GoTo ErrHandler RequiredSpace = RequiredSpace + InfoHead(loopc).lngFileSizeUncompressed Next loopc - If RequiredSpace >= General_Drive_Get_Free_Bytes(Left$(App.Path, 3)) Then + If RequiredSpace >= General_Drive_Get_Free_Bytes(Left$(App.path, 3)) Then Erase InfoHead Close ResourceFile Call MsgBox("No hay suficiente espacio en el disco para extraer los archivos.", , "Error") @@ -738,7 +739,7 @@ End Function ' ' @return True if are equals. -Private Function Compare_Datas(ByRef data1() As Byte, ByRef data2() As Byte) As Boolean +Private Function Compare_Datas(ByRef Data1() As Byte, ByRef Data2() As Byte) As Boolean '***************************************************************** 'Author: Nicolas Matias Gonzalez (NIGO) 'Last Modify Date: 02/11/2007 @@ -747,11 +748,11 @@ Private Function Compare_Datas(ByRef data1() As Byte, ByRef data2() As Byte) As Dim length As Long Dim act As Long - length = UBound(data1) + 1 + length = UBound(Data1) + 1 - If (UBound(data2) + 1) = length Then + If (UBound(Data2) + 1) = length Then While act < length - If data1(act) Xor data2(act) Then Exit Function + If Data1(act) Xor Data2(act) Then Exit Function act = act + 1 Wend diff --git a/Codigo/modDeclaraciones.bas b/Codigo/modDeclaraciones.bas index b24940e..66d634b 100644 --- a/Codigo/modDeclaraciones.bas +++ b/Codigo/modDeclaraciones.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modDeclaraciones" +'@Folder("WorldEditor.Modules") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -211,7 +212,7 @@ Public Type GrhData sX As Integer sY As Integer - FileNum As Long + fileNum As Long pixelWidth As Integer pixelHeight As Integer @@ -224,7 +225,10 @@ Public Type GrhData Speed As Single - tmpSngl As Single + S0 As Single + T0 As Single + S1 As Single + T1 As Single End Type ' Cuerpos body.dat @@ -428,6 +432,7 @@ Public GraphicsFile As String 'Que graficos.ind usamos Public bTriggers As Boolean Public bBloqs As Boolean Public bTranslados As Boolean +Public bCursor As Boolean Public bVerCapa(2 To 4) As Boolean Public bAutoCompletarSuperficies As Boolean Public bVerNpcs As Boolean @@ -449,7 +454,6 @@ Public PrimarySurface As DirectDrawSurface7 Public PrimaryClipper As DirectDrawClipper Public SecundaryClipper As DirectDrawClipper Public BackBufferSurface As DirectDrawSurface7 -Public SurfaceDB As clsSurfaceManager Public TextDrawer As clsTextDrawer '********** OUTSIDE FUNCTIONS *********** diff --git a/Codigo/modDirectDraw.bas b/Codigo/modDirectDraw.bas index 90b75f1..e038a27 100644 --- a/Codigo/modDirectDraw.bas +++ b/Codigo/modDirectDraw.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modDirectDraw" +'@Folder("WorldEditor.Modules") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -69,18 +70,6 @@ Function DeInitTileEngine() As Boolean Dim loopc As Integer '****** Clear DirectX objects ****** -Set PrimarySurface = Nothing -Set PrimaryClipper = Nothing -Set BackBufferSurface = Nothing - -Set SurfaceDB = Nothing - -Set DirectDraw = Nothing - -'Reset any channels that are done -For loopc = 1 To NumSoundBuffers - Set DSBuffers(loopc) = Nothing -Next loopc Set DirectSound = Nothing @@ -90,88 +79,25 @@ DeInitTileEngine = True End Function -Sub ShowNextFrame(ByVal DisplayFormTop As Integer, ByVal DisplayFormLeft As Integer, ByVal MouseViewX As Integer, ByVal MouseViewY As Integer) -'*************************************************** -'Author: Arron Perkins -'Last Modification: 08/14/07 -'Last modified by: Juan Martín Sotuyo Dodero (Maraxus) -'Updates the game's model and renders everything. -'*************************************************** - Static OffsetCounterX As Single - Static OffsetCounterY As Single - - '****** Set main view rectangle ****** - MainViewRect.Left = (DisplayFormLeft / Screen.TwipsPerPixelX) + MainViewLeft - MainViewRect.Top = (DisplayFormTop / Screen.TwipsPerPixelY) + MainViewTop - MainViewRect.Right = MainViewRect.Left + MainViewWidth - MainViewRect.Bottom = MainViewRect.Top + MainViewHeight - - If UserMoving Then - '****** Move screen Left and Right if needed ****** - If AddtoUserPos.X <> 0 Then - OffsetCounterX = OffsetCounterX - ScrollPixelsPerFrameX * AddtoUserPos.X * timerTicksPerFrame - If Abs(OffsetCounterX) >= Abs(TilePixelWidth * AddtoUserPos.X) Then - OffsetCounterX = 0 - AddtoUserPos.X = 0 - UserMoving = False - End If - End If - - '****** Move screen Up and Down if needed ****** - If AddtoUserPos.y <> 0 Then - OffsetCounterY = OffsetCounterY - ScrollPixelsPerFrameY * AddtoUserPos.y * timerTicksPerFrame - If Abs(OffsetCounterY) >= Abs(TilePixelHeight * AddtoUserPos.y) Then - OffsetCounterY = 0 - AddtoUserPos.y = 0 - UserMoving = False - End If - End If - End If - - '****** Update screen ****** - Call RenderScreen(UserPos.X - AddtoUserPos.X, UserPos.y - AddtoUserPos.y, OffsetCounterX, OffsetCounterY) - - 'Display front-buffer! - Call PrimarySurface.Blt(MainViewRect, BackBufferSurface, MainDestRect, DDBLT_WAIT) - - 'Limit FPS to 100 (an easy number higher than monitor's vertical refresh rates) - While (DirectX.TickCount - fpsLastCheck) \ 10 < FramesPerSecCounter - Sleep 5 - Wend - - 'FPS update - If fpsLastCheck + 1000 < DirectX.TickCount Then - FPS = FramesPerSecCounter - FramesPerSecCounter = 1 - fpsLastCheck = DirectX.TickCount - Else - FramesPerSecCounter = FramesPerSecCounter + 1 - End If - - 'Get timing info - timerElapsedTime = GetElapsedTime() - timerTicksPerFrame = timerElapsedTime * engineBaseSpeed -End Sub - Sub MoveScreen(ByVal nHeading As E_Heading) '****************************************** 'Starts the screen moving in a direction '****************************************** Dim X As Integer - Dim y As Integer + Dim Y As Integer Dim tx As Integer Dim tY As Integer 'Figure out which way to move Select Case nHeading Case E_Heading.NORTH - y = -1 + Y = -1 Case E_Heading.EAST X = 1 Case E_Heading.SOUTH - y = 1 + Y = 1 Case E_Heading.WEST X = -1 @@ -179,7 +105,7 @@ Sub MoveScreen(ByVal nHeading As E_Heading) 'Fill temp pos tx = UserPos.X + X - tY = UserPos.y + y + tY = UserPos.Y + Y 'Check to see if its out of bounds If tx < MinXBorder Or tx > MaxXBorder Or tY < MinYBorder Or tY > MaxYBorder Then @@ -188,13 +114,13 @@ Sub MoveScreen(ByVal nHeading As E_Heading) 'Start moving... MainLoop does the rest AddtoUserPos.X = X UserPos.X = tx - AddtoUserPos.y = y - UserPos.y = tY + AddtoUserPos.Y = Y + UserPos.Y = tY UserMoving = 1 - bTecho = IIf(MapData(UserPos.X, UserPos.y).Trigger = 1 Or _ - MapData(UserPos.X, UserPos.y).Trigger = 2 Or _ - MapData(UserPos.X, UserPos.y).Trigger = 4, True, False) + bTecho = IIf(MapData(UserPos.X, UserPos.Y).Trigger = 1 Or _ + MapData(UserPos.X, UserPos.Y).Trigger = 2 Or _ + MapData(UserPos.X, UserPos.Y).Trigger = 4, True, False) End If End Sub @@ -203,10 +129,10 @@ Sub ConvertCPtoTP(ByVal viewPortX As Integer, ByVal viewPortY As Integer, ByRef 'Converts where the mouse is in the main window to a tile position. MUST be called eveytime the mouse moves. '****************************************** tx = UserPos.X + viewPortX \ TilePixelWidth - WindowTileWidth \ 2 - tY = UserPos.y + viewPortY \ TilePixelHeight - WindowTileHeight \ 2 + tY = UserPos.Y + viewPortY \ TilePixelHeight - WindowTileHeight \ 2 End Sub -Sub MakeChar(ByVal CharIndex As Integer, ByVal Body As Integer, ByVal Head As Integer, ByVal Heading As Byte, ByVal X As Integer, ByVal y As Integer) +Sub MakeChar(ByVal CharIndex As Integer, ByVal Body As Integer, ByVal Head As Integer, ByVal Heading As Byte, ByVal X As Integer, ByVal Y As Integer) On Error Resume Next 'Apuntamos al ultimo Char If CharIndex > LastChar Then LastChar = CharIndex @@ -230,15 +156,17 @@ On Error Resume Next 'Update position .Pos.X = X - .Pos.y = y + .Pos.Y = Y 'Make active .Active = 1 End With 'Plot on map - MapData(X, y).CharIndex = CharIndex - + MapData(X, Y).CharIndex = CharIndex + Dim RangeX As Single, RangeY As Single + Call GetCharacterDimension(CharIndex, RangeX, RangeY) + Call g_Swarm.Insert(5, CharIndex, X, Y, RangeX, RangeY) bRefreshRadar = True ' GS End Sub @@ -248,7 +176,7 @@ Sub ResetCharInfo(ByVal CharIndex As Integer) .Moving = 0 .Pos.X = 0 - .Pos.y = 0 + .Pos.Y = 0 End With End Sub @@ -268,8 +196,8 @@ On Error Resume Next If LastChar = 0 Then Exit Do Loop End If - - MapData(CharList(CharIndex).Pos.X, CharList(CharIndex).Pos.y).CharIndex = 0 + Call g_Swarm.Remove(5, CharIndex, 0, 0, 0, 0) + MapData(CharList(CharIndex).Pos.X, CharList(CharIndex).Pos.Y).CharIndex = 0 Call ResetCharInfo(CharIndex) @@ -317,13 +245,13 @@ Sub MoveCharbyHead(ByVal CharIndex As Integer, ByVal nHeading As E_Heading) Dim addX As Integer Dim addY As Integer Dim X As Integer - Dim y As Integer + Dim Y As Integer Dim nX As Integer Dim nY As Integer With CharList(CharIndex) X = .Pos.X - y = .Pos.y + Y = .Pos.Y 'Figure out which way to move Select Case nHeading @@ -341,12 +269,12 @@ Sub MoveCharbyHead(ByVal CharIndex As Integer, ByVal nHeading As E_Heading) End Select nX = X + addX - nY = y + addY + nY = Y + addY MapData(nX, nY).CharIndex = CharIndex .Pos.X = nX - .Pos.y = nY - MapData(X, y).CharIndex = 0 + .Pos.Y = nY + MapData(X, Y).CharIndex = 0 .MoveOffsetX = -1 * (TilePixelWidth * addX) .MoveOffsetY = -1 * (TilePixelHeight * addY) @@ -356,6 +284,7 @@ Sub MoveCharbyHead(ByVal CharIndex As Integer, ByVal nHeading As E_Heading) .scrollDirectionX = addX .scrollDirectionY = addY + Call g_Swarm.Move(CharIndex, nX, nY) End With 'areas viejos @@ -369,19 +298,19 @@ End Sub Sub MoveCharbyPos(ByVal CharIndex As Integer, ByVal nX As Integer, ByVal nY As Integer) On Error Resume Next Dim X As Integer - Dim y As Integer + Dim Y As Integer Dim addX As Integer Dim addY As Integer Dim nHeading As E_Heading With CharList(CharIndex) X = .Pos.X - y = .Pos.y + Y = .Pos.Y - MapData(X, y).CharIndex = 0 + MapData(X, Y).CharIndex = 0 addX = nX - X - addY = nY - y + addY = nY - Y If Sgn(addX) = 1 Then nHeading = E_Heading.EAST @@ -396,7 +325,7 @@ On Error Resume Next MapData(nX, nY).CharIndex = CharIndex .Pos.X = nX - .Pos.y = nY + .Pos.Y = nY .MoveOffsetX = -1 * (TilePixelWidth * addX) .MoveOffsetY = -1 * (TilePixelHeight * addY) @@ -425,7 +354,7 @@ Function NextOpenChar() As Integer NextOpenChar = loopc End Function -Function LegalPos(ByVal X As Integer, ByVal y As Integer) As Boolean +Function LegalPos(ByVal X As Integer, ByVal Y As Integer) As Boolean '************************************************* 'Author: Unkwown 'Last modified: 28/05/06 - GS @@ -434,32 +363,32 @@ Function LegalPos(ByVal X As Integer, ByVal y As Integer) As Boolean LegalPos = True 'Check to see if its out of bounds -If Not InMapLegalBounds(X, y) Then +If Not InMapLegalBounds(X, Y) Then LegalPos = False Exit Function End If 'Check to see if its blocked -If MapData(X, y).Blocked = 1 Then +If MapData(X, Y).Blocked = 1 Then LegalPos = False Exit Function End If 'Check for character -If MapData(X, y).CharIndex > 0 Then +If MapData(X, Y).CharIndex > 0 Then LegalPos = False Exit Function End If End Function -Function InMapLegalBounds(ByVal X As Integer, ByVal y As Integer) As Boolean +Function InMapLegalBounds(ByVal X As Integer, ByVal Y As Integer) As Boolean '************************************************* 'Author: Unkwown 'Last modified: 20/05/06 '************************************************* -If (X < MinXBorder) Or (X > MaxXBorder) Or (y < MinYBorder) Or (y > MaxYBorder) Then +If (X < MinXBorder) Or (X > MaxXBorder) Or (Y < MinYBorder) Or (Y > MaxYBorder) Then InMapLegalBounds = False Exit Function End If @@ -468,159 +397,6 @@ InMapLegalBounds = True End Function -Public Sub DDrawGrhtoSurface(ByRef Surface As DirectDrawSurface7, ByRef Grh As Grh, ByVal X As Integer, ByVal y As Integer, ByVal Center As Byte, ByVal Animate As Byte) - Dim CurrentGrhIndex As Integer - Dim SourceRect As RECT -On Error GoTo error - - If Grh.grhIndex = 0 Then Exit Sub - - If Animate Then - If Grh.Started = 1 Then - Grh.FrameCounter = Grh.FrameCounter + (timerElapsedTime * GrhData(Grh.grhIndex).NumFrames / Grh.Speed) - If Grh.FrameCounter > GrhData(Grh.grhIndex).NumFrames Then - Grh.FrameCounter = (Grh.FrameCounter Mod GrhData(Grh.grhIndex).NumFrames) + 1 - - If Grh.Loops <> INFINITE_LOOPS Then - If Grh.Loops > 0 Then - Grh.Loops = Grh.Loops - 1 - Else - Grh.Started = 0 - End If - End If - End If - End If - End If - - 'Figure out what frame to draw (always 1 if not animated) - CurrentGrhIndex = GrhData(Grh.grhIndex).Frames(Grh.FrameCounter) - - With GrhData(CurrentGrhIndex) - 'Center Grh over X,Y pos - If Center Then - If .TileWidth <> 1 Then - X = X - Int(.TileWidth * TilePixelWidth / 2) + TilePixelWidth \ 2 - End If - - If .TileHeight <> 1 Then - y = y - Int(.TileHeight * TilePixelHeight) + TilePixelHeight - End If - End If - - SourceRect.Left = .sX - SourceRect.Top = .sY - SourceRect.Right = SourceRect.Left + .pixelWidth - SourceRect.Bottom = SourceRect.Top + .pixelHeight - - 'Draw - Call Surface.BltFast(X, y, SurfaceDB.Surface(.FileNum), SourceRect, DDBLTFAST_WAIT) - End With -Exit Sub - -error: - If Err.Number = 9 And Grh.FrameCounter < 1 Then - Grh.FrameCounter = 1 - Resume - Else - MsgBox "Ocurrió un error inesperado, por favor comuniquelo a los administradores del juego." & vbCrLf & "Descripción del error: " & _ - vbCrLf & Err.Description, vbExclamation, "[ " & Err.Number & " ] Error" - End - End If -End Sub - -Public Sub DDrawTransGrhIndextoSurface(ByRef Surface As DirectDrawSurface7, ByVal grhIndex As Integer, ByVal X As Integer, ByVal y As Integer, ByVal Center As Byte) - Dim SourceRect As RECT - - If grhIndex = 0 Then Exit Sub - - With GrhData(grhIndex) - 'Center Grh over X,Y pos - If Center Then - If .TileWidth <> 1 Then - X = X - Int(.TileWidth * TilePixelWidth / 2) + TilePixelWidth \ 2 - End If - - If .TileHeight <> 1 Then - y = y - Int(.TileHeight * TilePixelHeight) + TilePixelHeight - End If - End If - - SourceRect.Left = .sX - SourceRect.Top = .sY - SourceRect.Right = SourceRect.Left + .pixelWidth - SourceRect.Bottom = SourceRect.Top + .pixelHeight - - 'Draw - Call Surface.BltFast(X, y, SurfaceDB.Surface(.FileNum), SourceRect, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT) - End With -End Sub - -Public Sub DDrawTransGrhtoSurface(ByRef Surface As DirectDrawSurface7, ByRef Grh As Grh, ByVal X As Integer, ByVal y As Integer, ByVal Center As Byte, ByVal Animate As Byte) -'***************************************************************** -'Draws a GRH transparently to a X and Y position -'***************************************************************** - Dim CurrentGrhIndex As Integer - Dim SourceRect As RECT - Dim ddsdDest As DDSURFACEDESC2 - -On Error GoTo error - - If Grh.grhIndex = 0 Then Exit Sub - - If Animate Then - If Grh.Started = 1 Then - Grh.FrameCounter = Grh.FrameCounter + (timerElapsedTime * GrhData(Grh.grhIndex).NumFrames / Grh.Speed) - - If Grh.FrameCounter > GrhData(Grh.grhIndex).NumFrames Then - Grh.FrameCounter = (Grh.FrameCounter Mod GrhData(Grh.grhIndex).NumFrames) + 1 - - If Grh.Loops <> INFINITE_LOOPS Then - If Grh.Loops > 0 Then - Grh.Loops = Grh.Loops - 1 - Else - Grh.Started = 0 - End If - End If - End If - End If - End If - - 'Figure out what frame to draw (always 1 if not animated) - CurrentGrhIndex = GrhData(Grh.grhIndex).Frames(Grh.FrameCounter) - - With GrhData(CurrentGrhIndex) - 'Center Grh over X,Y pos - If Center Then - If .TileWidth <> 1 Then - X = X - Int(.TileWidth * TilePixelWidth / 2) + TilePixelWidth \ 2 - End If - - If .TileHeight <> 1 Then - y = y - Int(.TileHeight * TilePixelHeight) + TilePixelHeight - End If - End If - - SourceRect.Left = .sX - SourceRect.Top = .sY - SourceRect.Right = SourceRect.Left + .pixelWidth - SourceRect.Bottom = SourceRect.Top + .pixelHeight - - 'Draw - Call Surface.BltFast(X, y, SurfaceDB.Surface(.FileNum), SourceRect, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT) - End With -Exit Sub - -error: - If Err.Number = 9 And Grh.FrameCounter < 1 Then - Grh.FrameCounter = 1 - Resume - Else - MsgBox "Ocurrió un error inesperado, por favor comuniquelo a los administradores del juego." & vbCrLf & "Descripción del error: " & _ - vbCrLf & Err.Description, vbExclamation, "[ " & Err.Number & " ] Error" - End - End If -End Sub - Sub DrawBackBufferSurface() '************************************************* 'Author: Unkwown @@ -629,11 +405,11 @@ Sub DrawBackBufferSurface() PrimarySurface.Blt MainViewRect, BackBufferSurface, MainDestRect, DDBLT_WAIT End Sub -Sub DrawGrhtoHdc(ByVal hdc As Long, ByVal grhIndex As Integer, ByRef SourceRect As RECT, ByRef destRect As RECT) +Sub DrawGrhtoHdc(ByVal hDC As Long, ByVal grhIndex As Integer, ByRef SourceRect As RECT, ByRef destRect As RECT) '***************************************************************** 'Draws a Grh's portion to the given area of any Device Context '***************************************************************** - Call SurfaceDB.Surface(GrhData(grhIndex).FileNum).BltToDC(hdc, SourceRect, destRect) + 'Call SurfaceDB.Surface(GrhData(grhIndex).fileNum).BltToDC(hDC, SourceRect, destRect) End Sub Sub PlayWaveDS(ByRef file As String) @@ -654,393 +430,6 @@ Sub PlayWaveDS(ByRef file As String) End Sub -Sub RenderScreen(ByVal tilex As Integer, ByVal tiley As Integer, ByVal PixelOffsetX As Integer, ByVal PixelOffsetY As Integer) -'************************************************* -'Author: Unkwown -'Last modified: 31/05/06 by GS -'************************************************* -Dim y As Long 'Keeps track of where on map we are -Dim X As Long 'Keeps track of where on map we are -Dim screenminY As Integer 'Start Y pos on current screen -Dim screenmaxY As Integer 'End Y pos on current screen -Dim screenminX As Integer 'Start X pos on current screen -Dim screenmaxX As Integer 'End X pos on current screen -Dim MinY As Integer 'Start Y pos on current map -Dim MaxY As Integer 'End Y pos on current map -Dim MinX As Integer 'Start X pos on current map -Dim MaxX As Integer 'End X pos on current map -Dim ScreenX As Integer 'Keeps track of where to place tile on screen -Dim ScreenY As Integer 'Keeps track of where to place tile on screen -Dim ScreenXOffset As Integer -Dim ScreenYOffset As Integer -Dim minXOffset As Integer -Dim minYOffset As Integer -Dim PixelOffsetXTemp As Integer 'For centering grhs -Dim PixelOffsetYTemp As Integer 'For centering grhs -Dim Grh As Grh 'Temp Grh for show tile and blocked - - 'Figure out Ends and Starts of screen - screenminY = tiley - HalfWindowTileHeight - screenmaxY = tiley + HalfWindowTileHeight - screenminX = tilex - HalfWindowTileWidth - screenmaxX = tilex + HalfWindowTileWidth - - MinY = screenminY - TileBufferSize - MaxY = screenmaxY + TileBufferSize - MinX = screenminX - TileBufferSize - MaxX = screenmaxX + TileBufferSize - - 'Make sure mins and maxs are allways in map bounds - If MinY < YMinMapSize Then - minYOffset = YMinMapSize - MinY - MinY = YMinMapSize - End If - - If MaxY > YMaxMapSize Then MaxY = YMaxMapSize - - If MinX < XMinMapSize Then - minXOffset = XMinMapSize - MinX - MinX = XMinMapSize - End If - - If MaxX > XMaxMapSize Then MaxX = XMaxMapSize - - 'If we can, we render around the view area to make it smoother - If screenminY > YMinMapSize Then - screenminY = screenminY - 1 - Else - ScreenYOffset = (YMinMapSize - screenminY) + 1 - screenminY = YMinMapSize - End If - - If screenmaxY < YMaxMapSize Then - screenmaxY = screenmaxY + 1 - ElseIf screenmaxY > YMaxMapSize Then - screenmaxY = YMaxMapSize - End If - - If screenminX > XMinMapSize Then - screenminX = screenminX - 1 - Else - ScreenXOffset = (XMinMapSize - screenminX) + 1 - screenminX = XMinMapSize - End If - - If screenmaxX < XMaxMapSize Then - screenmaxX = screenmaxX + 1 - ElseIf screenmaxX > XMaxMapSize Then - screenmaxX = XMaxMapSize - End If - - Call CleanViewPort - - 'Draw floor layer - ScreenY = ScreenYOffset - For y = screenminY To screenmaxY - ScreenX = ScreenXOffset - For X = screenminX To screenmaxX - - 'Layer 1 ********************************** - If MapData(X, y).Graphic(1).grhIndex <> 0 Then - Call DDrawGrhtoSurface(BackBufferSurface, MapData(X, y).Graphic(1), _ - (ScreenX - 1) * TilePixelWidth + PixelOffsetX + TileBufferPixelOffsetX, _ - (ScreenY - 1) * TilePixelHeight + PixelOffsetY + TileBufferPixelOffsetY, _ - 0, 1) - End If - - If bSelectSup Then - If CurLayer = 1 Then - If X = SobreX And y = SobreY Then - If MosaicoChecked Then - Call DDrawGrhtoSurface(BackBufferSurface, CurrentGrh(((X + DespX) Mod mAncho) + 1, ((y + DespY) Mod MAlto) + 1), _ - (ScreenX - 1) * TilePixelWidth + PixelOffsetX + TileBufferPixelOffsetX, _ - (ScreenY - 1) * TilePixelHeight + PixelOffsetY + TileBufferPixelOffsetY, _ - 0, 1) - Else - Call DDrawGrhtoSurface(BackBufferSurface, CurrentGrh(0), _ - (ScreenX - 1) * TilePixelWidth + PixelOffsetX + TileBufferPixelOffsetX, _ - (ScreenY - 1) * TilePixelHeight + PixelOffsetY + TileBufferPixelOffsetY, _ - 0, 1) - End If - End If - End If - End If - '****************************************** - - ScreenX = ScreenX + 1 - Next X - - 'Increment ScreenY - ScreenY = ScreenY + 1 - Next y - - If bVerCapa(2) Then - 'Draw floor layer 2 - ScreenY = minYOffset - For y = MinY To MaxY - ScreenX = minXOffset - For X = MinX To MaxX - - 'Layer 2 ********************************** - If MapData(X, y).Graphic(2).grhIndex <> 0 Then - Call DDrawTransGrhtoSurface(BackBufferSurface, MapData(X, y).Graphic(2), _ - (ScreenX - 1) * TilePixelWidth + PixelOffsetX, _ - (ScreenY - 1) * TilePixelHeight + PixelOffsetY, _ - 1, 1) - End If - - If bSelectSup Then - If CurLayer = 2 Then - If (X = SobreX) And (y = SobreY) Then - If MosaicoChecked Then - Call DDrawTransGrhtoSurface(BackBufferSurface, CurrentGrh(((X + DespX) Mod mAncho) + 1, ((y + DespY) Mod MAlto) + 1), _ - (ScreenX - 1) * TilePixelWidth + PixelOffsetX, _ - (ScreenY - 1) * TilePixelHeight + PixelOffsetY, _ - 1, 1) - Else - Call DDrawTransGrhtoSurface(BackBufferSurface, CurrentGrh(0), _ - (ScreenX - 1) * TilePixelWidth + PixelOffsetX, _ - (ScreenY - 1) * TilePixelHeight + PixelOffsetY, _ - 1, 1) - End If - End If - End If - End If - '****************************************** - - ScreenX = ScreenX + 1 - Next X - ScreenY = ScreenY + 1 - Next y - Else - If bSelectSup Then - If CurLayer = 2 Then - X = SobreX - y = SobreY - ScreenX = (X - MinX) + minXOffset - ScreenY = (y - MinY) + minYOffset - - If MosaicoChecked Then - Call DDrawTransGrhtoSurface(BackBufferSurface, CurrentGrh(((X + DespX) Mod mAncho) + 1, ((y + DespY) Mod MAlto) + 1), _ - (ScreenX - 1) * TilePixelWidth + PixelOffsetX, _ - (ScreenY - 1) * TilePixelHeight + PixelOffsetY, _ - 1, 1) - Else - Call DDrawTransGrhtoSurface(BackBufferSurface, CurrentGrh(0), _ - (ScreenX - 1) * TilePixelWidth + PixelOffsetX, _ - (ScreenY - 1) * TilePixelHeight + PixelOffsetY, _ - 1, 1) - End If - End If - End If - End If - - 'Draw Transparent Layers - ScreenY = minYOffset - For y = MinY To MaxY - ScreenX = minXOffset - For X = MinX To MaxX - PixelOffsetXTemp = (ScreenX - 1) * TilePixelWidth + PixelOffsetX - PixelOffsetYTemp = (ScreenY - 1) * TilePixelHeight + PixelOffsetY - - With MapData(X, y) - 'Object Layer ********************************** - If (.ObjGrh.grhIndex <> 0) And bVerObjetos Then - Call DDrawTransGrhtoSurface(BackBufferSurface, .ObjGrh, _ - PixelOffsetXTemp, PixelOffsetYTemp, 1, 1) - End If - '*********************************************** - - - 'Char layer ************************************ - If (.CharIndex <> 0) And bVerNpcs Then - Call CharRender(.CharIndex, PixelOffsetXTemp, PixelOffsetYTemp) - End If - '************************************************* - - - 'Layer 3 ***************************************** - If (.Graphic(3).grhIndex <> 0) And bVerCapa(3) Then - 'Draw - Call DDrawTransGrhtoSurface(BackBufferSurface, .Graphic(3), _ - PixelOffsetXTemp, PixelOffsetYTemp, 1, 1) - End If - '************************************************ - End With - - ScreenX = ScreenX + 1 - Next X - ScreenY = ScreenY + 1 - Next y - - Grh.FrameCounter = 1 - Grh.Started = 0 - - If bVerCapa(4) Then - 'Draw layer 4 - ScreenY = minYOffset - For y = MinY To MaxY - ScreenX = minXOffset - For X = MinX To MaxX - With MapData(X, y) - 'Layer 4 ********************************** - If .Graphic(4).grhIndex <> 0 Then - 'Draw - Call DDrawTransGrhtoSurface(BackBufferSurface, .Graphic(4), _ - (ScreenX - 1) * TilePixelWidth + PixelOffsetX, _ - (ScreenY - 1) * TilePixelHeight + PixelOffsetY, _ - 1, 1) - End If - '********************************** - End With - - ScreenX = ScreenX + 1 - Next X - ScreenY = ScreenY + 1 - Next y - End If - - 'Draw trans, bloqs, triggers and select tiles - ScreenY = ScreenYOffset - For y = screenminY To screenmaxY - ScreenX = ScreenXOffset - For X = screenminX To screenmaxX - With MapData(X, y) - PixelOffsetXTemp = (ScreenX - 1) * TilePixelWidth + PixelOffsetX + TileBufferPixelOffsetX - PixelOffsetYTemp = (ScreenY - 1) * TilePixelHeight + PixelOffsetY + TileBufferPixelOffsetY - - '********************************** - If (.TileExit.Map <> 0) And bTranslados Then - Grh.grhIndex = 3 - - Call DDrawTransGrhtoSurface(BackBufferSurface, Grh, _ - PixelOffsetXTemp, _ - PixelOffsetYTemp, _ - 1, 0) - End If - - 'Show blocked tiles - If (.Blocked = 1) And bBloqs Then - Grh.grhIndex = 4 - - Call DDrawTransGrhtoSurface(BackBufferSurface, Grh, _ - PixelOffsetXTemp, _ - PixelOffsetYTemp, _ - 1, 0) - - 'BackBufferSurface.SetFillColor vbRed - - 'Call BackBufferSurface.DrawBox( _ - PixelOffsetXTemp + TilePixelWidth \ 2, _ - PixelOffsetYTemp + TilePixelHeight \ 2, _ - (PixelOffsetXTemp + 5) + TilePixelWidth \ 2, _ - (PixelOffsetYTemp + 5) + TilePixelHeight \ 2) - End If - - If bTriggers Then - Call TextDrawer.AddText(PixelOffsetXTemp + TilePixelWidth \ 2, PixelOffsetYTemp + TilePixelHeight \ 2, vbRed, str(.Trigger), True) - End If - - If .Select Then - BackBufferSurface.SetForeColor vbGreen - BackBufferSurface.SetFillStyle 1 - BackBufferSurface.DrawBox PixelOffsetXTemp, PixelOffsetYTemp, PixelOffsetXTemp + TilePixelWidth, PixelOffsetYTemp + TilePixelHeight - End If - '****************************************** - - ScreenX = ScreenX + 1 - End With - Next X - - 'Increment ScreenY - ScreenY = ScreenY + 1 - Next y - - Dim DC As Long - - DC = BackBufferSurface.GetDC - - Call TextDrawer.DrawTextToDC(DC) - Call BackBufferSurface.ReleaseDC(DC) -End Sub - -Private Sub CharRender(ByVal CharIndex As Long, ByVal PixelOffsetX As Integer, ByVal PixelOffsetY As Integer) -'*************************************************** -'Author: Juan Martín Sotuyo Dodero (Maraxus) -'Last Modify Date: 16/09/2010 (Zama) -'Draw char's to screen without offcentering them -'16/09/2010: ZaMa - Ya no se dibujan los bodies cuando estan invisibles. -'*************************************************** - Dim moved As Boolean - Dim Pos As Integer - Dim line As String - Dim color As Long - - With CharList(CharIndex) - If .Moving Then - 'If needed, move left and right - If .scrollDirectionX <> 0 Then - .MoveOffsetX = .MoveOffsetX + ScrollPixelsPerFrameX * Sgn(.scrollDirectionX) * timerTicksPerFrame - - 'Start animations -'TODO : Este parche es para evita los uncornos exploten al moverse!! REVER!!! - If .Body.Walk(.Heading).Speed > 0 Then _ - .Body.Walk(.Heading).Started = 1 - - 'Char moved - moved = True - - 'Check if we already got there - If (Sgn(.scrollDirectionX) = 1 And .MoveOffsetX >= 0) Or _ - (Sgn(.scrollDirectionX) = -1 And .MoveOffsetX <= 0) Then - .MoveOffsetX = 0 - .scrollDirectionX = 0 - End If - End If - - 'If needed, move up and down - If .scrollDirectionY <> 0 Then - .MoveOffsetY = .MoveOffsetY + ScrollPixelsPerFrameY * Sgn(.scrollDirectionY) * timerTicksPerFrame - - 'Start animations -'TODO : Este parche es para evita los uncornos exploten al moverse!! REVER!!! - If .Body.Walk(.Heading).Speed > 0 Then _ - .Body.Walk(.Heading).Started = 1 - - 'Char moved - moved = True - - 'Check if we already got there - If (Sgn(.scrollDirectionY) = 1 And .MoveOffsetY >= 0) Or _ - (Sgn(.scrollDirectionY) = -1 And .MoveOffsetY <= 0) Then - .MoveOffsetY = 0 - .scrollDirectionY = 0 - End If - End If - End If - - 'If done moving stop animation - If Not moved Then - 'Stop animations - .Body.Walk(.Heading).Started = 0 - .Body.Walk(.Heading).FrameCounter = 1 - - .Moving = False - End If - - PixelOffsetX = PixelOffsetX + .MoveOffsetX - PixelOffsetY = PixelOffsetY + .MoveOffsetY - - 'Draw Body - If .Body.Walk(.Heading).grhIndex Then _ - Call DDrawTransGrhtoSurface(BackBufferSurface, .Body.Walk(.Heading), PixelOffsetX, PixelOffsetY, 1, 1) - - 'Draw Head - If .Head.Head(.Heading).grhIndex Then _ - Call DDrawTransGrhtoSurface(BackBufferSurface, .Head.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X, PixelOffsetY + .Body.HeadOffset.y, 1, 0) - End With -End Sub - Public Sub RenderText(ByVal lngXPos As Integer, ByVal lngYPos As Integer, ByRef strText As String, ByVal lngColor As Long) If LenB(strText) > 0 Then 'TextDrawer.DrawText lngXPos - 2, lngYPos - 1, strText, vbBlack, BackBufferSurface @@ -1048,153 +437,7 @@ Public Sub RenderText(ByVal lngXPos As Integer, ByVal lngYPos As Integer, ByRef End If End Sub -Public Function InitTileEngine(ByVal setDisplayFormhWnd As Long, ByVal setMainViewTop As Integer, ByVal setMainViewLeft As Integer, ByVal setTilePixelHeight As Integer, ByVal setTilePixelWidth As Integer, ByVal setWindowTileHeight As Integer, ByVal setWindowTileWidth As Integer, ByVal setTileBufferSize As Integer, ByVal pixelsToScrollPerFrameX As Integer, pixelsToScrollPerFrameY As Integer, ByVal engineSpeed As Single) As Boolean -'*************************************************** -'Author: Aaron Perkins -'Last Modification: 08/14/07 -'Last modified by: Juan Martín Sotuyo Dodero (Maraxus) -'Creates all DX objects and configures the engine to start running. -'*************************************************** - Dim surfaceDesc As DDSURFACEDESC2 - Dim ddck As DDCOLORKEY - - 'Fill startup variables - MainViewTop = setMainViewTop - MainViewLeft = setMainViewLeft - TilePixelWidth = setTilePixelWidth - TilePixelHeight = setTilePixelHeight - WindowTileHeight = setWindowTileHeight - WindowTileWidth = setWindowTileWidth - TileBufferSize = setTileBufferSize - - HalfWindowTileHeight = setWindowTileHeight \ 2 - HalfWindowTileWidth = setWindowTileWidth \ 2 - - 'Compute offset in pixels when rendering tile buffer. - 'We diminish by one to get the top-left corner of the tile for rendering. - TileBufferPixelOffsetX = ((TileBufferSize - 1) * TilePixelWidth) - TileBufferPixelOffsetY = ((TileBufferSize - 1) * TilePixelHeight) - - engineBaseSpeed = engineSpeed - - 'Set FPS value to 60 for startup - FPS = 60 - FramesPerSecCounter = 60 - - MinXBorder = XMinMapSize + (ClienteWidth \ 2) - MaxXBorder = XMaxMapSize - (ClienteWidth \ 2) - MinYBorder = YMinMapSize + (ClienteHeight \ 2) - MaxYBorder = YMaxMapSize - (ClienteHeight \ 2) - - MainViewWidth = TilePixelWidth * WindowTileWidth - MainViewHeight = TilePixelHeight * WindowTileHeight - - 'Resize mapdata array - ReDim MapData(XMinMapSize To XMaxMapSize, YMinMapSize To YMaxMapSize) As MapBlock - - 'Set intial user position - UserPos.X = MinXBorder - UserPos.y = MinYBorder - - 'Set scroll pixels per frame - ScrollPixelsPerFrameX = pixelsToScrollPerFrameX - ScrollPixelsPerFrameY = pixelsToScrollPerFrameY - - 'Set the view rect - With MainViewRect - .Left = MainViewLeft - .Top = MainViewTop - .Right = .Left + MainViewWidth - .Bottom = .Top + MainViewHeight - End With - - 'Set the dest rect - With MainDestRect - .Left = TilePixelWidth * TileBufferSize - TilePixelWidth - .Top = TilePixelHeight * TileBufferSize - TilePixelHeight - .Right = .Left + MainViewWidth - .Bottom = .Top + MainViewHeight - End With - -On Error Resume Next - Set DirectX = New DirectX7 - - If Err Then - MsgBox "No se puede iniciar DirectX. Por favor asegurese de tener la ultima version correctamente instalada." - Exit Function - End If - - - '****** INIT DirectDraw ****** - ' Create the root DirectDraw object - Set DirectDraw = DirectX.DirectDrawCreate("") - - If Err Then - MsgBox "No se puede iniciar DirectDraw. Por favor asegurese de tener la ultima version correctamente instalada." - Exit Function - End If - -On Error GoTo 0 - Call DirectDraw.SetCooperativeLevel(setDisplayFormhWnd, DDSCL_NORMAL) - - 'Primary Surface - ' Fill the surface description structure - With surfaceDesc - .lFlags = DDSD_CAPS - .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE - End With - ' Create the surface - Set PrimarySurface = DirectDraw.CreateSurface(surfaceDesc) - - 'Create Primary Clipper - Set PrimaryClipper = DirectDraw.CreateClipper(0) - Call PrimaryClipper.SetHWnd(frmMain.hwnd) - Call PrimarySurface.SetClipper(PrimaryClipper) - - With BackBufferRect - .Left = 0 - .Top = 0 - .Right = TilePixelWidth * (WindowTileWidth + 2 * TileBufferSize) - .Bottom = TilePixelHeight * (WindowTileHeight + 2 * TileBufferSize) - End With - - With surfaceDesc - .lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH - If ClientSetup.bUseVideo Then - .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY - Else - .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY - End If - .lHeight = BackBufferRect.Bottom - .lWidth = BackBufferRect.Right - End With - - ' Create surface - Set BackBufferSurface = DirectDraw.CreateSurface(surfaceDesc) - - 'Set color key - ddck.low = 0 - ddck.high = 0 - Call BackBufferSurface.SetColorKey(DDCKEY_SRCBLT, ddck) - - 'Set font transparency - Call BackBufferSurface.SetFontTransparency(D_TRUE) - - 'Load graphic data into memory - modIndices.CargarIndicesDeGraficos - - frmCargando.X.Caption = "Iniciando Control de Superficies..." - Call SurfaceDB.Initialize(DirectDraw, ClientSetup.bUseVideo, DirGraficos, ClientSetup.byMemory) - - 'Wave Sound - Set DirectSound = DirectX.DirectSoundCreate("") - DirectSound.SetCooperativeLevel setDisplayFormhWnd, DSSCL_PRIORITY - LastSoundBufferUsed = 1 - - InitTileEngine = True -End Function - -Private Function GetElapsedTime() As Single +Public Function GetElapsedTime() As Single '************************************************************** 'Author: Aaron Perkins 'Last Modify Date: 10/07/2002 @@ -1218,13 +461,3 @@ Private Function GetElapsedTime() As Single 'Get next end time Call QueryPerformanceCounter(end_time) End Function - -Private Sub CleanViewPort() -'*************************************************** -'Author: Juan Martín Sotuyo Dodero (Maraxus) -'Last Modify Date: 12/03/04 -'Fills the viewport with black. -'*************************************************** - Dim r As RECT - Call BackBufferSurface.BltColorFill(r, vbBlack) -End Sub diff --git a/Codigo/modDirectSound.bas b/Codigo/modDirectSound.bas index 92941aa..0576d6d 100644 --- a/Codigo/modDirectSound.bas +++ b/Codigo/modDirectSound.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modDirectSound" +'@Folder("WorldEditor.Modules") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by diff --git a/Codigo/modEdicion.bas b/Codigo/modEdicion.bas index 58abcb0..97a918a 100644 --- a/Codigo/modEdicion.bas +++ b/Codigo/modEdicion.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modEdicion" +'@Folder("WorldEditor.Modules.Editor") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -34,6 +35,16 @@ Public MinCopyX As Byte Public MaxCopyX As Byte Public MinCopyY As Byte Public MaxCopyY As Byte +Public Const EXIT_LAYER As Integer = 6 +Public ExitGrhIndex As Integer +Public Const BLOCK_LAYER As Integer = 7 +Public BlockGrhIndex As Integer +Public Const TRIGGER_LAYER As Integer = 8 + +Public Sub InitEditionModule() + ExitGrhIndex = 3 + BlockGrhIndex = 4 +End Sub '' ' Vacia el Deshacer @@ -226,7 +237,7 @@ If Cuantos > 0 Then tx = RandomNumber(MinXBorder, MaxXBorder) tY = RandomNumber(MinYBorder, MaxYBorder) - Call InsertarGrh(tx, tY, MosaicoChecked, bAutoCompletarSuperficies, frmMain.cInsertarBloqueo.value, False) + Call InsertarGrh(tx, tY, MosaicoChecked, bAutoCompletarSuperficies, frmMain.cInsertarBloqueo.Value, False) Next k End If @@ -255,7 +266,7 @@ modEdicion.Deshacer_Add "Insertar Superficie en todos los bordes" ' Hago deshace For X = XMinMapSize To XMaxMapSize For Y = YMinMapSize To YMaxMapSize If X < MinXBorder Or X > MaxXBorder Or Y < MinYBorder Or Y > MaxYBorder Then - Call InsertarGrh(X, Y, MosaicoChecked, False, frmMain.cInsertarBloqueo.value, False) + Call InsertarGrh(X, Y, MosaicoChecked, False, frmMain.cInsertarBloqueo.Value, False) 'Erase NPCs Call QuitarNpc(X, Y, False) @@ -608,23 +619,19 @@ Dim tTrans As WorldPos tTrans = MapData(tx, tY).TileExit If tTrans.Map > 0 Then - If LenB(frmMain.Dialog.FileName) <> 0 Then - If FileExist(PATH_Save & NameMap_Save & tTrans.Map & ".map", vbArchive) = True Then - Call modMapIO.NuevoMapa - frmMain.Dialog.FileName = PATH_Save & NameMap_Save & tTrans.Map & ".map" - modMapIO.AbrirMapa frmMain.Dialog.FileName, MapData - UserPos.X = tTrans.X - UserPos.Y = tTrans.Y - - If WalkMode Then - With CharList(UserCharIndex) - MakeChar UserCharIndex, .iBody, .iHead, E_Heading.SOUTH, UserPos.X, UserPos.Y - End With - End If - - frmMain.mnuReAbrirMapa.Enabled = True + If TryChangeMap(tTrans.Map) Then + UserPos.X = tTrans.X + UserPos.Y = tTrans.Y + + If WalkMode Then + With CharList(UserCharIndex) + MakeChar UserCharIndex, .iBody, .iHead, E_Heading.SOUTH, UserPos.X, UserPos.Y + End With End If + + frmMain.mnuReAbrirMapa.Enabled = True End If + End If End Sub @@ -661,21 +668,21 @@ Sub ClickEdit(ByVal Button As Integer, ByVal tx As Integer, ByVal tY As Integer) 'Left click ElseIf Button = vbLeftButton Then 'Erase 2-3 - If frmMain.cQuitarEnTodasLasCapas.value Then + If frmMain.cQuitarEnTodasLasCapas.Value Then Call QuitarCapasMedias(tx, tY) 'Borrar "esta" Capa - ElseIf frmMain.cQuitarEnEstaCapa.value Then + ElseIf frmMain.cQuitarEnEstaCapa.Value Then Call QuitarEstaCapa(tx, tY) '************** Place grh ElseIf bSelectSup Then Call InsertarGrh(tx, tY, MosaicoChecked, bAutoCompletarSuperficies, MapData(tx, tY).Blocked) '************** Place blocked tile - ElseIf frmMain.cInsertarBloqueo.value Then + ElseIf frmMain.cInsertarBloqueo.Value Then Call InsertarBloq(tx, tY) - ElseIf frmMain.cQuitarBloqueo.value Then + ElseIf frmMain.cQuitarBloqueo.Value Then Call QuitarBloq(tx, tY) '************** Place exit - ElseIf frmMain.cInsertarTrans.value Then + ElseIf frmMain.cInsertarTrans.Value Then Map = Val(frmMain.tTMapa.Text) X = Val(frmMain.tTX.Text) Y = Val(frmMain.tTY.Text) @@ -691,39 +698,39 @@ Sub ClickEdit(ByVal Button As Integer, ByVal tx As Integer, ByVal tY As Integer) Exit Sub End If - If frmMain.cInsertarTransOBJ.value Then _ + If frmMain.cInsertarTransOBJ.Value Then _ Call InsertarObjTranslado(tx, tY) - If frmMain.cUnionManual.value Then + If frmMain.cUnionManual.Value Then Call InsertarUnionManual(tx, tY, Map) Else Call InsertarTileExit(tx, tY, X, Y, Map) End If - ElseIf frmMain.cQuitarTrans.value Then + ElseIf frmMain.cQuitarTrans.Value Then Call QuitarTileExit(tx, tY) '************** Place NPC - ElseIf frmMain.cInsertarFunc(0).value Then + ElseIf frmMain.cInsertarFunc(0).Value Then NPCIndex = Val(frmMain.cNumFunc(0).Text) Call InsertarNpc(tx, tY, NPCIndex) - ElseIf frmMain.cInsertarFunc(1).value Then + ElseIf frmMain.cInsertarFunc(1).Value Then NPCIndex = Val(frmMain.cNumFunc(1).Text) Call InsertarNpc(tx, tY, NPCIndex) - ElseIf frmMain.cQuitarFunc(0).value Or frmMain.cQuitarFunc(1).value Then + ElseIf frmMain.cQuitarFunc(0).Value Or frmMain.cQuitarFunc(1).Value Then Call QuitarNpc(tx, tY) ' ***************** Control de Funcion de Objetos ***************** - ElseIf frmMain.cInsertarFunc(2).value = True Then ' Insertar Objeto + ElseIf frmMain.cInsertarFunc(2).Value = True Then ' Insertar Objeto objindex = frmMain.cNumFunc(2).Text Amount = Val(frmMain.cCantFunc(2).Text) Call InsertarObjeto(tx, tY, objindex, Amount) - ElseIf frmMain.cQuitarFunc(2).value Then ' Quitar Objeto + ElseIf frmMain.cQuitarFunc(2).Value Then ' Quitar Objeto Call QuitarObjeto(tx, tY) ' ***************** Control de Funcion de Triggers ***************** - ElseIf frmMain.cInsertarTrigger.value Then ' Insertar Trigger + ElseIf frmMain.cInsertarTrigger.Value Then ' Insertar Trigger Call InsertarTrigger(tx, tY, frmMain.lListado(4).ListIndex) - ElseIf frmMain.cQuitarTrigger.value Then ' Quitar Trigger + ElseIf frmMain.cQuitarTrigger.Value Then ' Quitar Trigger Call InsertarTrigger(tx, tY, 0) End If End If @@ -751,15 +758,15 @@ With MapData(X, Y) ' NPCs If .NPCIndex > 0 Then If NpcData(.NPCIndex).Hostile Then - frmMain.StatTxt.Text = frmMain.StatTxt.Text & " (NPC-Hostil: " & .NPCIndex & " - " & NpcData(.NPCIndex).name & ")" + frmMain.StatTxt.Text = frmMain.StatTxt.Text & " (NPC-Hostil: " & .NPCIndex & " - " & NpcData(.NPCIndex).Name & ")" Else - frmMain.StatTxt.Text = frmMain.StatTxt.Text & " (NPC: " & .NPCIndex & " - " & NpcData(.NPCIndex).name & ")" + frmMain.StatTxt.Text = frmMain.StatTxt.Text & " (NPC: " & .NPCIndex & " - " & NpcData(.NPCIndex).Name & ")" End If End If ' OBJs If .OBJInfo.objindex > 0 Then - frmMain.StatTxt.Text = frmMain.StatTxt.Text & " (Obj: " & .OBJInfo.objindex & " - " & ObjData(.OBJInfo.objindex).name & " - Cant.:" & .OBJInfo.Amount & ")" + frmMain.StatTxt.Text = frmMain.StatTxt.Text & " (Obj: " & .OBJInfo.objindex & " - " & ObjData(.OBJInfo.objindex).Name & " - Cant.:" & .OBJInfo.Amount & ")" End If ' Capas @@ -958,7 +965,7 @@ Dim tY As Integer Dim Map As Integer If MaxSelectX Then 'Si tenemos un max, tenemos el otro, y también tenemos los min - If frmMain.cInsertarTrans.value Then + If frmMain.cInsertarTrans.Value Then Map = Val(frmMain.tTMapa.Text) tx = Val(frmMain.tTX.Text) tY = Val(frmMain.tTY.Text) @@ -977,47 +984,47 @@ If MaxSelectX Then 'Si tenemos un max, tenemos el otro, y tambi For Y = MinSelectY To MaxSelectY For X = MinSelectX To MaxSelectX - If frmMain.cQuitarEnTodasLasCapas.value Then + If frmMain.cQuitarEnTodasLasCapas.Value Then Call QuitarCapasMedias(X, Y, False) - ElseIf frmMain.cQuitarEnEstaCapa.value Then + ElseIf frmMain.cQuitarEnEstaCapa.Value Then Call QuitarEstaCapa(X, Y, False) ElseIf bSelectSup Then Call InsertarGrh(X, Y, MosaicoChecked, bAutoCompletarSuperficies, MapData(X, Y).Blocked, False) - ElseIf frmMain.cInsertarBloqueo.value Then + ElseIf frmMain.cInsertarBloqueo.Value Then Call InsertarBloq(X, Y, False) - ElseIf frmMain.cQuitarBloqueo.value Then + ElseIf frmMain.cQuitarBloqueo.Value Then Call QuitarBloq(X, Y, False) - ElseIf frmMain.cInsertarTrans.value Then - If frmMain.cInsertarTransOBJ.value Then _ + ElseIf frmMain.cInsertarTrans.Value Then + If frmMain.cInsertarTransOBJ.Value Then _ Call InsertarObjTranslado(X, Y, False) - If frmMain.cUnionManual.value Then + If frmMain.cUnionManual.Value Then Call InsertarUnionManual(X, Y, Map, False) Else Call InsertarTileExit(X, Y, tx, tY, Map, False) End If - ElseIf frmMain.cQuitarTrans.value Then + ElseIf frmMain.cQuitarTrans.Value Then Call QuitarTileExit(X, Y, False) - ElseIf frmMain.cInsertarFunc(0).value Then + ElseIf frmMain.cInsertarFunc(0).Value Then NPCIndex = Val(frmMain.cNumFunc(0).Text) Call InsertarNpc(X, Y, NPCIndex, False) - ElseIf frmMain.cInsertarFunc(1).value Then + ElseIf frmMain.cInsertarFunc(1).Value Then NPCIndex = Val(frmMain.cNumFunc(1).Text) Call InsertarNpc(X, Y, NPCIndex, False) - ElseIf frmMain.cQuitarFunc(0).value Or frmMain.cQuitarFunc(1).value Then + ElseIf frmMain.cQuitarFunc(0).Value Or frmMain.cQuitarFunc(1).Value Then Call QuitarNpc(X, Y, False) - ElseIf frmMain.cInsertarFunc(2).value = True Then + ElseIf frmMain.cInsertarFunc(2).Value = True Then objindex = frmMain.cNumFunc(2).Text Amount = Val(frmMain.cCantFunc(2).Text) Call InsertarObjeto(X, Y, objindex, Amount, False) - ElseIf frmMain.cQuitarFunc(2).value Then + ElseIf frmMain.cQuitarFunc(2).Value Then Call QuitarObjeto(X, Y, False) - ElseIf frmMain.cInsertarTrigger.value Then + ElseIf frmMain.cInsertarTrigger.Value Then Call InsertarTrigger(X, Y, frmMain.lListado(4).ListIndex, False) - ElseIf frmMain.cQuitarTrigger.value Then + ElseIf frmMain.cQuitarTrigger.Value Then Call InsertarTrigger(X, Y, 0, False) End If Next X @@ -1032,6 +1039,14 @@ If ConDeshacer Then _ Call modEdicion.Deshacer_Add("Quitar capas medias") For i = 2 To 3 + + If MapData(X, Y).Graphic(i).grhIndex <> 0 Then + With GrhData(MapData(X, Y).Graphic(i).grhIndex) + Call g_Swarm.Remove(i - 1, -1, X, Y, .TileWidth, .TileHeight) + End With + End If + + MapData(X, Y).Graphic(i).grhIndex = 0 Next i @@ -1039,17 +1054,31 @@ MapInfo.Changed = 1 End Sub Public Function QuitarEstaCapa(ByVal X As Byte, ByVal Y As Byte, Optional ByVal ConDeshacer As Boolean = True) As Boolean -If MapData(X, Y).Graphic(CurLayer).grhIndex <> 0 Then + QuitarEstaCapa = QuitarGrhDeCapa(CurLayer, X, Y, ConDeshacer) +End Function + + +Public Function QuitarGrhDeCapa(ByVal Capa As Byte, ByVal X As Byte, ByVal Y As Byte, Optional ByVal ConDeshacer As Boolean = True) As Boolean +If MapData(X, Y).Graphic(Capa).grhIndex <> 0 Then If ConDeshacer Then _ - Call modEdicion.Deshacer_Add("Quitar capa " & CurLayer) + Call modEdicion.Deshacer_Add("Quitar capa " & Capa) + + If Capa <> 1 Then + With GrhData(MapData(X, Y).Graphic(Capa).grhIndex) + Call g_Swarm.Remove(Capa - 1, -1, X, Y, .TileWidth, .TileHeight) + End With + MapData(X, Y).Graphic(Capa).grhIndex = 0 + Else + MapData(X, Y).Graphic(Capa).grhIndex = 1 + End If - MapData(X, Y).Graphic(CurLayer).grhIndex = 0 MapInfo.Changed = 1 End If End Function Public Sub InsertarGrh(ByVal X As Byte, ByVal Y As Byte, ByVal MOSAICO As Boolean, ByVal AutoCompletar As Boolean, ByVal Bloq As Boolean, Optional ByVal ConDeshacer As Boolean = True) Dim grhIndex As Integer +Dim oldGrhIndex As Integer Dim OffsetX As Long Dim OffsetY As Long @@ -1060,14 +1089,25 @@ If MOSAICO And AutoCompletar Then For OffsetX = 0 To mAncho - 1 For OffsetY = 0 To MAlto - 1 grhIndex = CurrentGrh(((X + OffsetX + DespX) Mod mAncho) + 1, ((Y + OffsetY + DespY) Mod MAlto) + 1).grhIndex - + oldGrhIndex = MapData(X + OffsetX, Y + OffsetY).Graphic(CurLayer).grhIndex If Bloq Then - MapData(X + OffsetX, Y + OffsetY).Blocked = 1 + Call InsertarBloq(X + OffsetX, Y + OffsetY, ConDeshacer) Else - MapData(X + OffsetX, Y + OffsetY).Blocked = 0 + Call QuitarBloq(X + OffsetX, Y + OffsetY, ConDeshacer) End If InitGrh MapData(X + OffsetX, Y + OffsetY).Graphic(CurLayer), grhIndex + + If CurLayer > 1 Then + If oldGrhIndex > 0 Then + With GrhData(oldGrhIndex) + Call g_Swarm.Remove(CurLayer - 1, -1, X + OffsetX, Y + OffsetY, .TileWidth, .TileHeight) + End With + End If + With GrhData(grhIndex) + Call g_Swarm.Insert(CurLayer - 1, -1, X + OffsetX, Y + OffsetY, .TileWidth, .TileHeight) + End With + End If Next OffsetY Next OffsetX @@ -1080,29 +1120,44 @@ Else End If With MapData(X, Y) - If .Graphic(CurLayer).grhIndex <> grhIndex Then + oldGrhIndex = .Graphic(CurLayer).grhIndex + If oldGrhIndex <> grhIndex Then If ConDeshacer Then _ Call modEdicion.Deshacer_Add("Insertar superficie. Capa " & CurLayer) If Bloq Then - .Blocked = 1 + Call InsertarBloq(X, Y, ConDeshacer) Else - .Blocked = 0 + Call QuitarBloq(X, Y, ConDeshacer) End If InitGrh .Graphic(CurLayer), grhIndex + If CurLayer > 1 Then + If oldGrhIndex > 0 Then + With GrhData(oldGrhIndex) + Call g_Swarm.Remove(CurLayer - 1, -1, X, Y, .TileWidth, .TileHeight) + End With + End If + With GrhData(grhIndex) + Call g_Swarm.Insert(CurLayer - 1, -1, X, Y, .TileWidth, .TileHeight) + End With + End If + MapInfo.Changed = 1 End If End With End If End Sub - Public Sub InsertarBloq(ByVal X As Byte, ByVal Y As Byte, Optional ByVal ConDeshacer As Boolean = True) If MapData(X, Y).Blocked <> 1 Then If ConDeshacer Then _ Call modEdicion.Deshacer_Add("Insertar bloqueo") + With GrhData(BlockGrhIndex) + Call g_Swarm.Insert(BLOCK_LAYER, -1, X, Y, .TileWidth, .TileHeight) + End With + MapData(X, Y).Blocked = 1 MapInfo.Changed = 1 'Set changed flag End If @@ -1113,6 +1168,10 @@ If MapData(X, Y).Blocked <> 0 Then If ConDeshacer Then _ Call modEdicion.Deshacer_Add("Quitar bloqueo") + With GrhData(BlockGrhIndex) + Call g_Swarm.Remove(BLOCK_LAYER, -1, X, Y, .TileWidth, .TileHeight) + End With + MapData(X, Y).Blocked = 0 MapInfo.Changed = 1 'Set changed flag End If @@ -1172,6 +1231,10 @@ With MapData(X, Y).TileExit .X = TargetX .Y = TargetY .Map = TargetMap + + With GrhData(ExitGrhIndex) + Call g_Swarm.Insert(EXIT_LAYER, -1, X, Y, .TileWidth, .TileHeight) + End With MapInfo.Changed = 1 'Set changed flag End With @@ -1186,6 +1249,10 @@ With MapData(X, Y).TileExit .X = 0 .Y = 0 + With GrhData(ExitGrhIndex) + Call g_Swarm.Remove(EXIT_LAYER, -1, X, Y, .TileWidth, .TileHeight) + End With + MapInfo.Changed = 1 'Set changed flag End With End Sub @@ -1238,13 +1305,13 @@ With MapData(X, Y) .OBJInfo.objindex = objindex .OBJInfo.Amount = Amount - - InitGrh .ObjGrh, ObjData(objindex).grhIndex - - Select Case ObjData(objindex).ObjType - Case 4, 8, 10, 22 ' Arboles, Carteles, Foros, Yacimientos - .Graphic(3) = .ObjGrh - End Select + If ObjData(objindex).grhIndex <> 0 Then + InitGrh .ObjGrh, ObjData(objindex).grhIndex + + With GrhData(ObjData(objindex).grhIndex) + Call g_Swarm.Insert(4, -1, X, Y, .TileWidth, .TileHeight) + End With + End If MapInfo.Changed = 1 'Set changed flag End If @@ -1253,12 +1320,17 @@ End With End Sub Public Sub QuitarObjeto(ByVal X As Byte, ByVal Y As Byte, Optional ByVal ConDeshacer As Boolean) +Dim grhIndex As Integer With MapData(X, Y) If .OBJInfo.objindex <> 0 Then If ConDeshacer Then _ Call modEdicion.Deshacer_Add("Quitar objeto") - - If .Graphic(3).grhIndex = .ObjGrh.grhIndex Then .Graphic(3).grhIndex = 0 + If .ObjGrh.grhIndex <> 0 Then + + With GrhData(.ObjGrh.grhIndex) + Call g_Swarm.Remove(4, -1, X, Y, .TileWidth, .TileHeight) + End With + End If .ObjGrh.grhIndex = 0 .OBJInfo.objindex = 0 @@ -1274,8 +1346,14 @@ With MapData(X, Y) If .Trigger <> Trigger Then If ConDeshacer Then _ Call modEdicion.Deshacer_Add("Insertar Trigger " & Trigger) - + .Trigger = Trigger + + If Trigger <> 0 Then + Call g_Swarm.Insert(TRIGGER_LAYER, -1, X, Y, 32, 32) + Else + Call g_Swarm.Remove(TRIGGER_LAYER, -1, X, Y, 32, 32) + End If MapInfo.Changed = 1 'Set changed flag End If End With diff --git a/Codigo/modGameIni.bas b/Codigo/modGameIni.bas index 427ffc9..9f2a0a6 100644 --- a/Codigo/modGameIni.bas +++ b/Codigo/modGameIni.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modGameIni" +'@Folder("WorldEditor.Modules") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -68,15 +69,15 @@ Public Function LeerGameIni() As tGameIni 'Author: Unkwown 'Last modified: 20/05/06 '************************************************* -Dim n As Integer +Dim N As Integer Dim GameIni As tGameIni -n = FreeFile -Open DirIndex & "Inicio.con" For Binary As #n -Get #n, , MiCabecera +N = FreeFile +Open DirIndex & "Inicio.con" For Binary As #N +Get #N, , MiCabecera -Get #n, , GameIni +Get #N, , GameIni -Close #n +Close #N LeerGameIni = GameIni End Function @@ -85,12 +86,12 @@ Public Sub EscribirGameIni(ByRef GameIniConfiguration As tGameIni) 'Author: Unkwown 'Last modified: 20/05/06 '************************************************* -Dim n As Integer -n = FreeFile -Open DirIndex & "Inicio.con" For Binary As #n -Put #n, , MiCabecera +Dim N As Integer +N = FreeFile +Open DirIndex & "Inicio.con" For Binary As #N +Put #N, , MiCabecera GameIniConfiguration.Password = "DAMMLAMERS!" -Put #n, , GameIniConfiguration -Close #n +Put #N, , GameIniConfiguration +Close #N End Sub diff --git a/Codigo/modGdiPlusResizer.bas b/Codigo/modGdiPlusResizer.bas index 208ed82..ee572ef 100644 --- a/Codigo/modGdiPlusResizer.bas +++ b/Codigo/modGdiPlusResizer.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modGdiPlusResizer" +'@Folder("WorldEditor.Modules") Option Explicit Private Type GUID diff --git a/Codigo/modGeneral.bas b/Codigo/modGeneral.bas index cdb43fd..87e5127 100644 --- a/Codigo/modGeneral.bas +++ b/Codigo/modGeneral.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modGeneral" +'@Folder("WorldEditor.Modules") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -31,6 +32,15 @@ Option Explicit Private lFrameTimer As Long +Private intervalChecker As clsInterval +Private Const KEY_CHECK_INTEVAL As Long = 80 +Public AutoPantalla As Boolean +Private Sub InitGeneral() + Set intervalChecker = New clsInterval + Call intervalChecker.Init(KEY_CHECK_INTEVAL) + bCursor = False +End Sub + '' ' Realiza acciones de desplasamiento segun las teclas que hallamos precionado ' @@ -53,13 +63,14 @@ Static LastMovement As Long Exit Sub End If End If + If Not intervalChecker.ICan Then Exit Sub If GetAsyncKeyState(vbKeyUp) < 0 Then - If UserPos.y > YMinMapSize Then + If UserPos.Y > YMinMapSize Then If WalkMode And (UserMoving = 0) Then MoveTo E_Heading.NORTH ElseIf WalkMode = False Then - UserPos.y = UserPos.y - 1 + UserPos.Y = UserPos.Y - 1 End If bRefreshRadar = True ' Radar @@ -79,11 +90,11 @@ Static LastMovement As Long End If If GetAsyncKeyState(vbKeyDown) < 0 Then - If UserPos.y < YMaxMapSize Then + If UserPos.Y < YMaxMapSize Then If WalkMode And (UserMoving = 0) Then MoveTo E_Heading.SOUTH ElseIf WalkMode = False Then - UserPos.y = UserPos.y + 1 + UserPos.Y = UserPos.Y + 1 End If bRefreshRadar = True ' Radar @@ -108,7 +119,7 @@ Public Function ReadField(ByVal Pos As Integer, ByRef Text As String, ByVal SepA 'Author: Unkwown 'Last modified: 20/05/06 '************************************************* -Dim i As Integer +Dim I As Integer Dim LastPos As Integer Dim CurChar As String * 1 Dim FieldNum As Integer @@ -118,8 +129,8 @@ Seperator = Chr$(SepASCII) LastPos = 0 FieldNum = 0 -For i = 1 To Len(Text) - CurChar = mid$(Text, i, 1) +For I = 1 To Len(Text) + CurChar = mid$(Text, I, 1) If CurChar = Seperator Then FieldNum = FieldNum + 1 @@ -127,9 +138,9 @@ For i = 1 To Len(Text) ReadField = mid$(Text, LastPos + 1, (InStr(LastPos + 1, Text, Seperator, vbTextCompare) - 1) - (LastPos)) Exit Function End If - LastPos = i + LastPos = I End If -Next i +Next I FieldNum = FieldNum + 1 If FieldNum = Pos Then @@ -176,7 +187,7 @@ Private Sub CargarMapIni() On Error GoTo Fallo Dim tStr As String Dim Leer As New clsIniReader -Dim i As Long +Dim I As Long IniPath = App.path & "\" @@ -188,7 +199,7 @@ If Not FileExist(IniPath & "WorldEditor.ini", vbArchive) Then DirMp3 = IniPath & "MP3\" DirDats = IniPath & "DATS\" UserPos.X = 50 - UserPos.y = 50 + UserPos.Y = 50 PantallaX = 21 PantallaY = 19 @@ -261,23 +272,23 @@ End If tStr = Leer.GetValue("MOSTRAR", "LastPos") ' x-y UserPos.X = Val(ReadField(1, tStr, Asc("-"))) -UserPos.y = Val(ReadField(2, tStr, Asc("-"))) +UserPos.Y = Val(ReadField(2, tStr, Asc("-"))) If UserPos.X < XMinMapSize Or UserPos.X > XMaxMapSize Then UserPos.X = 50 End If -If UserPos.y < YMinMapSize Or UserPos.y > YMaxMapSize Then - UserPos.y = 50 +If UserPos.Y < YMinMapSize Or UserPos.Y > YMaxMapSize Then + UserPos.Y = 50 End If ' Menu Mostrar frmMain.mnuVerAutomatico.Checked = Val(Leer.GetValue("MOSTRAR", "ControlAutomatico")) -For i = 2 To 4 - bVerCapa(i) = Val(Leer.GetValue("MOSTRAR", "Capa" & i)) - frmMain.mnuVerCapa(i).Checked = bVerCapa(i) -Next i +For I = 2 To 4 + bVerCapa(I) = Val(Leer.GetValue("MOSTRAR", "Capa" & I)) + frmMain.mnuVerCapa(I).Checked = bVerCapa(I) +Next I bTranslados = Val(Leer.GetValue("MOSTRAR", "Translados")) bTriggers = Val(Leer.GetValue("MOSTRAR", "Triggers")) @@ -291,15 +302,16 @@ frmMain.mnuVerNPCs.Checked = bVerNpcs frmMain.mnuVerTriggers.Checked = bTriggers frmMain.mnuVerBloqueos.Checked = bBloqs -frmMain.cVerTriggers.value = bTriggers -frmMain.cVerBloqueos.value = bBloqs +frmMain.cVerTriggers.Value = bTriggers +frmMain.cVerBloqueos.Value = bBloqs ' Tamaño de visualizacion PantallaX = Val(Leer.GetValue("MOSTRAR", "PantallaX")) PantallaY = Val(Leer.GetValue("MOSTRAR", "PantallaY")) +AutoPantalla = Val(Leer.GetValue("MOSTRAR", "AutoPantalla")) -If PantallaX > 27 Or PantallaX <= 3 Then PantallaX = 21 -If PantallaY > 25 Or PantallaY <= 3 Then PantallaY = 19 +If PantallaX > 35 Or PantallaX <= 3 Then PantallaX = 21 +If PantallaY > 33 Or PantallaY <= 3 Then PantallaY = 19 ClienteHeight = Val(Leer.GetValue("MOSTRAR", "ClienteHeight")) ClienteWidth = Val(Leer.GetValue("MOSTRAR", "ClienteWidth")) @@ -311,7 +323,7 @@ Fallo: Resume Next End Sub -Function MoveToLegalPos(ByVal X As Integer, ByVal y As Integer) As Boolean +Function MoveToLegalPos(ByVal X As Integer, ByVal Y As Integer) As Boolean '***************************************************************** 'Author: ZaMa 'Last Modify Date: 01/08/2009 @@ -322,16 +334,16 @@ Function MoveToLegalPos(ByVal X As Integer, ByVal y As Integer) As Boolean Dim CharIndex As Integer 'Limites del mapa - If X < MinXBorder Or X > MaxXBorder Or y < MinYBorder Or y > MaxYBorder Then + If X < MinXBorder Or X > MaxXBorder Or Y < MinYBorder Or Y > MaxYBorder Then Exit Function End If 'Tile Bloqueado? - If MapData(X, y).Blocked = 1 Then + If MapData(X, Y).Blocked = 1 Then Exit Function End If - CharIndex = MapData(X, y).CharIndex + CharIndex = MapData(X, Y).CharIndex '¿Hay un personaje? If CharIndex > 0 Then Exit Function @@ -353,13 +365,13 @@ Sub MoveTo(ByVal Direccion As E_Heading) Select Case Direccion Case E_Heading.NORTH - LegalOk = MoveToLegalPos(UserPos.X, UserPos.y - 1) + LegalOk = MoveToLegalPos(UserPos.X, UserPos.Y - 1) Case E_Heading.EAST - LegalOk = MoveToLegalPos(UserPos.X + 1, UserPos.y) + LegalOk = MoveToLegalPos(UserPos.X + 1, UserPos.Y) Case E_Heading.SOUTH - LegalOk = MoveToLegalPos(UserPos.X, UserPos.y + 1) + LegalOk = MoveToLegalPos(UserPos.X, UserPos.Y + 1) Case E_Heading.WEST - LegalOk = MoveToLegalPos(UserPos.X - 1, UserPos.y) + LegalOk = MoveToLegalPos(UserPos.X - 1, UserPos.Y) End Select If LegalOk Then @@ -382,20 +394,14 @@ Dim OffsetCounterY As Integer Dim Chkflag As Integer If App.PrevInstance Then End - + 'Load ao.dat config file Call LoadClientSetup - - If ClientSetup.bDinamic Then - Set SurfaceDB = New clsSurfaceManDyn - Else - Set SurfaceDB = New clsSurfaceManStatic - End If - + Call CargarMapIni Call IniciarCabecera(MiCabecera) DoEvents - + frmCargando.Show If FileExist(IniPath & "WorldEditor.jpg", vbArchive) Then frmCargando.Picture1.Picture = LoadPicture(IniPath & "WorldEditor.jpg") frmCargando.verX = "v" & App.Major & "." & App.Minor & "." & App.Revision @@ -408,9 +414,13 @@ Dim Chkflag As Integer frmCargando.X.Caption = "Cargando Indice de Superficies..." modIndices.CargarIndicesSuperficie frmCargando.X.Caption = "Indexando Cargado de Imagenes..." + frmMain.Show + frmMain.Hide DoEvents - If InitTileEngine(frmMain.hwnd, frmMain.MainViewShp.Top + 50, frmMain.MainViewShp.Left + 4, 32, 32, PantallaY, PantallaX, 9, 8, 8, 0.018) Then ' 30/05/2006 + + + If InitTileEngine(frmMain.hwnd, 0, 0, 32, 32, PantallaY, PantallaX, 9, 8, 8, 0.018) Then ' 30/05/2006 'Display form handle, View window offset from 0,0 of display form, Tile Size, Display size in tiles, Screen buffer frmCargando.P1.Visible = True frmCargando.L(0).Visible = True @@ -446,6 +456,11 @@ Dim Chkflag As Integer frmCargando.L(5).Visible = True End If + Call InitGeneral + Call modEdicion.InitEditionModule + + Call modPaneles.InitPanelModule(frmMain.PreviewGrh) + Set TextDrawer = New clsTextDrawer Call TextDrawer.InitText(DirectDraw, ClientSetup.bUseVideo) @@ -454,7 +469,7 @@ Dim Chkflag As Integer frmCargando.Hide frmMain.Show - modMapIO.NuevoMapa + 'modMapIO.NuevoMapa Call ActualizarMosaico @@ -463,7 +478,9 @@ Dim Chkflag As Integer Chkflag = 0 dTiempoGT = GetTickCount CurLayer = 1 - + MapaCargado = False + 'clean the time(avoid the timeEngine overflow) + Call GetElapsedTime Do While prgRun 'Sólo dibujamos si la ventana no está minimizada If frmMain.WindowState <> 1 And frmMain.Visible Then @@ -479,13 +496,15 @@ Dim Chkflag As Integer If GetTickCount - lFrameTimer >= 1000 Then CaptionWorldEditor frmMain.Dialog.FileName, (MapInfo.Changed = 1) frmMain.FPS.Caption = "FPS: " & FPS - lFrameTimer = GetTickCount + FPS = 0 + Else + FPS = FPS + 1 End If If bRefreshRadar Then Call RefreshAllChars - 'If frmMain.PreviewGrh.Visible Then Call modPaneles.VistaPreviaDeSup + 'If frmMain.PreviewGrh.Visible Then Call modPaneles.Render DoEvents Loop @@ -525,12 +544,12 @@ GetVar = RTrim$(sSpaces) GetVar = Left$(GetVar, Len(GetVar) - 1) End Function -Public Sub WriteVar(ByRef file As String, ByRef Main As String, ByRef Var As String, ByRef value As String) +Public Sub WriteVar(ByRef file As String, ByRef Main As String, ByRef Var As String, ByRef Value As String) '************************************************* 'Author: Unkwown 'Last modified: 20/05/06 '************************************************* -writeprivateprofilestring Main, Var, value, file +writeprivateprofilestring Main, Var, Value, file End Sub Public Sub ToggleWalkMode() @@ -547,12 +566,12 @@ If Not WalkMode Then 'Erase character Call EraseChar(UserCharIndex) - MapData(UserPos.X, UserPos.y).CharIndex = 0 + MapData(UserPos.X, UserPos.Y).CharIndex = 0 Else 'MakeCharacter - If LegalPos(UserPos.X, UserPos.y) Then - Call MakeChar(NextOpenChar(), 1, 1, SOUTH, UserPos.X, UserPos.y) - UserCharIndex = MapData(UserPos.X, UserPos.y).CharIndex + If LegalPos(UserPos.X, UserPos.Y) Then + Call MakeChar(NextOpenChar(), 1, 1, SOUTH, UserPos.X, UserPos.Y) + UserCharIndex = MapData(UserPos.X, UserPos.Y).CharIndex frmMain.mnuModoCaminata.Checked = True Else MsgBox "ERROR: Ubicacion ilegal." @@ -562,7 +581,7 @@ End If fin: End Sub -Public Sub FixCoasts(ByVal grhIndex As Integer, ByVal X As Integer, ByVal y As Integer) +Public Sub FixCoasts(ByVal grhIndex As Integer, ByVal X As Integer, ByVal Y As Integer) '************************************************* 'Author: Unkwown 'Last modified: 20/05/06 @@ -580,7 +599,7 @@ If grhIndex = 7284 Or grhIndex = 7290 Or grhIndex = 7291 Or grhIndex = 7297 Or _ grhIndex = 7354 Or grhIndex = 7357 Or grhIndex = 7358 Or grhIndex = 7360 Or _ grhIndex = 7362 Or grhIndex = 7363 Or grhIndex = 7365 Or grhIndex = 7366 Or _ grhIndex = 7367 Or grhIndex = 7368 Or grhIndex = 7369 Or grhIndex = 7371 Or _ - grhIndex = 7373 Or grhIndex = 7375 Or grhIndex = 7376 Then MapData(X, y).Graphic(2).grhIndex = 0 + grhIndex = 7373 Or grhIndex = 7375 Or grhIndex = 7376 Then MapData(X, Y).Graphic(2).grhIndex = 0 End Sub @@ -606,16 +625,16 @@ Public Sub RefreshAllChars() On Error Resume Next Dim loopc As Integer -frmMain.ApuntadorRadar.Move UserPos.X - 12, UserPos.y - 10 +frmMain.ApuntadorRadar.Move UserPos.X - 12, UserPos.Y - 10 frmMain.picRadar.Cls For loopc = 1 To LastChar If CharList(loopc).Active = 1 Then - MapData(CharList(loopc).Pos.X, CharList(loopc).Pos.y).CharIndex = loopc + MapData(CharList(loopc).Pos.X, CharList(loopc).Pos.Y).CharIndex = loopc If CharList(loopc).Heading <> 0 Then frmMain.picRadar.ForeColor = vbGreen - frmMain.picRadar.Line (0 + CharList(loopc).Pos.X, 0 + CharList(loopc).Pos.y)-(2 + CharList(loopc).Pos.X, 0 + CharList(loopc).Pos.y) - frmMain.picRadar.Line (0 + CharList(loopc).Pos.X, 1 + CharList(loopc).Pos.y)-(2 + CharList(loopc).Pos.X, 1 + CharList(loopc).Pos.y) + frmMain.picRadar.Line (0 + CharList(loopc).Pos.X, 0 + CharList(loopc).Pos.Y)-(2 + CharList(loopc).Pos.X, 0 + CharList(loopc).Pos.Y) + frmMain.picRadar.Line (0 + CharList(loopc).Pos.X, 1 + CharList(loopc).Pos.Y)-(2 + CharList(loopc).Pos.X, 1 + CharList(loopc).Pos.Y) End If End If Next loopc @@ -676,31 +695,45 @@ Public Function fullyBlack(ByVal grhIndex As Long) As Boolean 'Last Modify Date: 10/27/2011 'Return true if the grh is fully black '************************************************************* - Dim color As Long - Dim X As Long - Dim y As Long - Dim srchdc As Long - Dim Surface As DirectDrawSurface7 - - With GrhData(GrhData(grhIndex).Frames(1)) - Set Surface = SurfaceDB.Surface(.FileNum) - - srchdc = Surface.GetDC + fullyBlack = False +End Function +Public Function TryChangeMap(mapNum As Integer) As Boolean + frmMain.Dialog.CancelError = True + If mapNum <> NumMap_Save Then + On Error GoTo ErrHandler - For y = .sY To .sY + .pixelHeight - 1 - For X = .sX To .sX + .pixelWidth - 1 - color = GetPixel(srchdc, X, y) - - If color <> 0 Then - Call Surface.ReleaseDC(srchdc) - - fullyBlack = False + If MapInfo.Changed = 1 Then + If MsgBox(MSGMod, vbExclamation + vbYesNo) = vbYes Then + modMapIO.GuardarMapa PATH_Save & NameMap_Save & NumMap_Save & ".map" + Else + TryChangeMap = False Exit Function End If - Next X - Next y - End With + End If + + Call modMapIO.NuevoMapa + + frmMain.Dialog.FileName = PATH_Save & NameMap_Save & mapNum & ".map" + modMapIO.AbrirMapa frmMain.Dialog.FileName, MapData + + TryChangeMap = True + Exit Function + +ErrHandler: + MsgBox Err.Description + Else + TryChangeMap = True + End If + +End Function + +Public Function ReadAllBytes(FileName As String) As Byte() + Dim fileNum As Integer + fileNum = FreeFile() + + Open FileName For Binary Access Read As fileNum + ReDim ReadAllBytes(LOF(fileNum) - 1) + Get fileNum, 1, ReadAllBytes + Close fileNum - Call Surface.ReleaseDC(srchdc) - fullyBlack = True End Function diff --git a/Codigo/modIndices.bas b/Codigo/modIndices.bas index ef638a2..dee8d22 100644 --- a/Codigo/modIndices.bas +++ b/Codigo/modIndices.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modIndices" +'@Folder("WorldEditor.Modules") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -107,8 +108,8 @@ On Error GoTo ErrorHandler If .TileHeight <= 0 Then GoTo ErrorHandler Else 'Read in normal GRH data - Get Handle, , .FileNum - If .FileNum <= 0 Then GoTo ErrorHandler + Get Handle, , .fileNum + If .fileNum <= 0 Then GoTo ErrorHandler Get Handle, , GrhData(Grh).sX If .sX < 0 Then GoTo ErrorHandler @@ -123,11 +124,13 @@ On Error GoTo ErrorHandler If .pixelHeight <= 0 Then GoTo ErrorHandler ' Loading the normalized values used by wGL. Not used by the WE at this moment. - Get Handle, , tmpSngl - Get Handle, , tmpSngl - Get Handle, , tmpSngl - Get Handle, , tmpSngl + Get Handle, , .S0 + Get Handle, , .T0 + Get Handle, , .S1 + Get Handle, , .T1 + .S1 = .S0 + .S1 + .T1 = .T0 + .T1 'Compute width and height .TileWidth = .pixelWidth / TilePixelHeight diff --git a/Codigo/modMapIO.bas b/Codigo/modMapIO.bas index 0fb5bed..358697f 100644 --- a/Codigo/modMapIO.bas +++ b/Codigo/modMapIO.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modMapIO" +'@Folder("WorldEditor.Modules") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -65,13 +66,13 @@ End Function ' @param FileType Especifica el tipo de archivo/directorio ' @return Nos devuelve verdadero o falso -Public Function FileExist(ByRef File As String, ByVal FileType As VbFileAttribute) As Boolean +Public Function FileExist(ByRef file As String, ByVal FileType As VbFileAttribute) As Boolean '************************************************* 'Author: Unkwown 'Last modified: 26/05/06 '************************************************* -FileExist = (LenB(Dir$(File, FileType)) > 0) +FileExist = (LenB(Dir$(file, FileType)) > 0) End Function '' @@ -84,7 +85,7 @@ Public Sub AbrirMapa(ByRef path As String, ByRef buffer() As MapBlock, Optional 'Author: ^[GS]^ 'Last modified: 20/05/06 '************************************************* - +g_Swarm.Clear If FileSize(path) = 130273 Then Call MapaV1_Cargar(path, buffer, SoloMap) frmMain.mnuUtirialNuevoFormato.Checked = False @@ -154,7 +155,7 @@ Public Sub NuevoMapa() On Error Resume Next Dim loopc As Integer -Dim y As Integer +Dim Y As Integer Dim X As Integer bAutoGuardarMapaCount = 0 @@ -179,7 +180,7 @@ For loopc = 1 To LastChar Next loopc MapInfo.MapVersion = 0 -MapInfo.name = "Nuevo Mapa" +MapInfo.Name = "Nuevo Mapa" MapInfo.Music = 0 MapInfo.PK = True MapInfo.MagiaSinEfecto = 0 @@ -221,7 +222,7 @@ Dim FreeFileMap As Long Dim FreeFileInf As Long Dim loopc As Long Dim TempInt As Integer -Dim y As Long +Dim Y As Long Dim X As Long Dim ByFlags As Byte @@ -275,57 +276,57 @@ Seek FreeFileInf, 1 Put FreeFileInf, , TempInt 'Write .map file - For y = YMinMapSize To YMaxMapSize + For Y = YMinMapSize To YMaxMapSize For X = XMinMapSize To XMaxMapSize ByFlags = 0 - If MapData(X, y).Blocked = 1 Then ByFlags = ByFlags Or 1 - If MapData(X, y).Graphic(2).grhIndex Then ByFlags = ByFlags Or 2 - If MapData(X, y).Graphic(3).grhIndex Then ByFlags = ByFlags Or 4 - If MapData(X, y).Graphic(4).grhIndex Then ByFlags = ByFlags Or 8 - If MapData(X, y).Trigger Then ByFlags = ByFlags Or 16 + If MapData(X, Y).Blocked = 1 Then ByFlags = ByFlags Or 1 + If MapData(X, Y).Graphic(2).grhIndex Then ByFlags = ByFlags Or 2 + If MapData(X, Y).Graphic(3).grhIndex Then ByFlags = ByFlags Or 4 + If MapData(X, Y).Graphic(4).grhIndex Then ByFlags = ByFlags Or 8 + If MapData(X, Y).Trigger Then ByFlags = ByFlags Or 16 Put FreeFileMap, , ByFlags - Put FreeFileMap, , MapData(X, y).Graphic(1).grhIndex + Put FreeFileMap, , MapData(X, Y).Graphic(1).grhIndex For loopc = 2 To 4 - If MapData(X, y).Graphic(loopc).grhIndex Then _ - Put FreeFileMap, , MapData(X, y).Graphic(loopc).grhIndex + If MapData(X, Y).Graphic(loopc).grhIndex Then _ + Put FreeFileMap, , MapData(X, Y).Graphic(loopc).grhIndex Next loopc - If MapData(X, y).Trigger Then _ - Put FreeFileMap, , MapData(X, y).Trigger + If MapData(X, Y).Trigger Then _ + Put FreeFileMap, , MapData(X, Y).Trigger '.inf file ByFlags = 0 - If MapData(X, y).TileExit.Map Then ByFlags = ByFlags Or 1 - If MapData(X, y).NPCIndex Then ByFlags = ByFlags Or 2 - If MapData(X, y).OBJInfo.objindex Then ByFlags = ByFlags Or 4 + If MapData(X, Y).TileExit.Map Then ByFlags = ByFlags Or 1 + If MapData(X, Y).NPCIndex Then ByFlags = ByFlags Or 2 + If MapData(X, Y).OBJInfo.objindex Then ByFlags = ByFlags Or 4 Put FreeFileInf, , ByFlags - If MapData(X, y).TileExit.Map Then - Put FreeFileInf, , MapData(X, y).TileExit.Map - Put FreeFileInf, , MapData(X, y).TileExit.X - Put FreeFileInf, , MapData(X, y).TileExit.y + If MapData(X, Y).TileExit.Map Then + Put FreeFileInf, , MapData(X, Y).TileExit.Map + Put FreeFileInf, , MapData(X, Y).TileExit.X + Put FreeFileInf, , MapData(X, Y).TileExit.Y End If - If MapData(X, y).NPCIndex Then + If MapData(X, Y).NPCIndex Then - Put FreeFileInf, , CInt(MapData(X, y).NPCIndex) + Put FreeFileInf, , CInt(MapData(X, Y).NPCIndex) End If - If MapData(X, y).OBJInfo.objindex Then - Put FreeFileInf, , MapData(X, y).OBJInfo.objindex - Put FreeFileInf, , MapData(X, y).OBJInfo.Amount + If MapData(X, Y).OBJInfo.objindex Then + Put FreeFileInf, , MapData(X, Y).OBJInfo.objindex + Put FreeFileInf, , MapData(X, Y).OBJInfo.Amount End If Next X - Next y + Next Y 'Close .map file Close FreeFileMap @@ -366,7 +367,7 @@ On Error GoTo ErrorSave Dim FreeFileInf As Long Dim loopc As Long Dim TempInt As Integer - Dim y As Long + Dim Y As Long Dim X As Long If FileExist(SaveAs, vbNormal) = True Then @@ -417,43 +418,43 @@ On Error GoTo ErrorSave Put FreeFileInf, , TempInt 'Write .map file - For y = YMinMapSize To YMaxMapSize + For Y = YMinMapSize To YMaxMapSize For X = XMinMapSize To XMaxMapSize '.map file ' Bloqueos - Put FreeFileMap, , MapData(X, y).Blocked + Put FreeFileMap, , MapData(X, Y).Blocked ' Capas For loopc = 1 To 4 - If loopc = 2 Then Call FixCoasts(MapData(X, y).Graphic(loopc).grhIndex, X, y) - Put FreeFileMap, , MapData(X, y).Graphic(loopc).grhIndex + If loopc = 2 Then Call FixCoasts(MapData(X, Y).Graphic(loopc).grhIndex, X, Y) + Put FreeFileMap, , MapData(X, Y).Graphic(loopc).grhIndex Next loopc ' Triggers - Put FreeFileMap, , MapData(X, y).Trigger + Put FreeFileMap, , MapData(X, Y).Trigger Put FreeFileMap, , TempInt '.inf file 'Tile exit - Put FreeFileInf, , MapData(X, y).TileExit.Map - Put FreeFileInf, , MapData(X, y).TileExit.X - Put FreeFileInf, , MapData(X, y).TileExit.y + Put FreeFileInf, , MapData(X, Y).TileExit.Map + Put FreeFileInf, , MapData(X, Y).TileExit.X + Put FreeFileInf, , MapData(X, Y).TileExit.Y 'NPC - Put FreeFileInf, , MapData(X, y).NPCIndex + Put FreeFileInf, , MapData(X, Y).NPCIndex 'Object - Put FreeFileInf, , MapData(X, y).OBJInfo.objindex - Put FreeFileInf, , MapData(X, y).OBJInfo.Amount + Put FreeFileInf, , MapData(X, Y).OBJInfo.objindex + Put FreeFileInf, , MapData(X, Y).OBJInfo.Amount 'Empty place holders for future expansion Put FreeFileInf, , TempInt Put FreeFileInf, , TempInt Next X - Next y + Next Y 'Close .map file Close FreeFileMap @@ -492,15 +493,15 @@ On Error Resume Next Dim Body As Integer Dim Head As Integer Dim Heading As Byte - Dim y As Integer + Dim Y As Integer Dim X As Integer Dim ByFlags As Byte Dim FreeFileMap As Long Dim FreeFileInf As Long - + Call frmErrors.ClearErrors 'Change mouse icon frmMain.MousePointer = 11 - + g_Swarm.Clear 'Open files FreeFileMap = FreeFile Open Map For Binary As FreeFileMap @@ -533,46 +534,61 @@ On Error Resume Next End If 'Load arrays - For y = YMinMapSize To YMaxMapSize + For Y = YMinMapSize To YMaxMapSize For X = XMinMapSize To XMaxMapSize Get FreeFileMap, , ByFlags + If (ByFlags And 1) Then + Call InsertarBloq(X, Y, False) + End If - buffer(X, y).Blocked = (ByFlags And 1) - - Get FreeFileMap, , buffer(X, y).Graphic(1).grhIndex - InitGrh buffer(X, y).Graphic(1), buffer(X, y).Graphic(1).grhIndex + Get FreeFileMap, , buffer(X, Y).Graphic(1).grhIndex + If buffer(X, Y).Graphic(1).grhIndex = 0 Then + Call frmErrors.AddError("Grhindex 0 en capa de pisos en X:" & X & " Y:" & Y & " Se remplazara por 1(vacio).") + buffer(X, Y).Graphic(1).grhIndex = 1 + End If + InitGrh buffer(X, Y).Graphic(1), buffer(X, Y).Graphic(1).grhIndex 'Layer 2 used? If ByFlags And 2 Then - Get FreeFileMap, , buffer(X, y).Graphic(2).grhIndex - InitGrh buffer(X, y).Graphic(2), buffer(X, y).Graphic(2).grhIndex + Get FreeFileMap, , buffer(X, Y).Graphic(2).grhIndex + InitGrh buffer(X, Y).Graphic(2), buffer(X, Y).Graphic(2).grhIndex + With GrhData(MapData(X, Y).Graphic(2).grhIndex) + Call g_Swarm.Insert(1, -1, X, Y, .TileWidth, .TileHeight) + End With Else - buffer(X, y).Graphic(2).grhIndex = 0 + buffer(X, Y).Graphic(2).grhIndex = 0 End If 'Layer 3 used? If ByFlags And 4 Then - Get FreeFileMap, , buffer(X, y).Graphic(3).grhIndex - InitGrh buffer(X, y).Graphic(3), buffer(X, y).Graphic(3).grhIndex + Get FreeFileMap, , buffer(X, Y).Graphic(3).grhIndex + InitGrh buffer(X, Y).Graphic(3), buffer(X, Y).Graphic(3).grhIndex + With GrhData(MapData(X, Y).Graphic(3).grhIndex) + Call g_Swarm.Insert(2, -1, X, Y, .TileWidth, .TileHeight) + End With Else - buffer(X, y).Graphic(3).grhIndex = 0 + buffer(X, Y).Graphic(3).grhIndex = 0 End If 'Layer 4 used? If ByFlags And 8 Then - Get FreeFileMap, , buffer(X, y).Graphic(4).grhIndex - InitGrh buffer(X, y).Graphic(4), buffer(X, y).Graphic(4).grhIndex + Get FreeFileMap, , buffer(X, Y).Graphic(4).grhIndex + InitGrh buffer(X, Y).Graphic(4), buffer(X, Y).Graphic(4).grhIndex + With GrhData(MapData(X, Y).Graphic(4).grhIndex) + Call g_Swarm.Insert(3, -1, X, Y, .TileWidth, .TileHeight) + End With Else - buffer(X, y).Graphic(4).grhIndex = 0 + buffer(X, Y).Graphic(4).grhIndex = 0 End If 'Trigger used? If ByFlags And 16 Then - Get FreeFileMap, , buffer(X, y).Trigger + Get FreeFileMap, , TempInt + Call modEdicion.InsertarTrigger(X, Y, TempInt, False) Else - buffer(X, y).Trigger = 0 + buffer(X, Y).Trigger = 0 End If If Not SoloMap Then @@ -580,36 +596,45 @@ On Error Resume Next Get FreeFileInf, , ByFlags If ByFlags And 1 Then - Get FreeFileInf, , buffer(X, y).TileExit.Map - Get FreeFileInf, , buffer(X, y).TileExit.X - Get FreeFileInf, , buffer(X, y).TileExit.y + Get FreeFileInf, , buffer(X, Y).TileExit.Map + Get FreeFileInf, , buffer(X, Y).TileExit.X + Get FreeFileInf, , buffer(X, Y).TileExit.Y + With buffer(X, Y).TileExit + Call modEdicion.InsertarTileExit(X, Y, .X, .Y, .Map, False) + End With + End If If ByFlags And 2 Then 'Get and make NPC - Get FreeFileInf, , buffer(X, y).NPCIndex + Get FreeFileInf, , buffer(X, Y).NPCIndex - If buffer(X, y).NPCIndex < 0 Then - buffer(X, y).NPCIndex = 0 + If buffer(X, Y).NPCIndex < 0 Then + buffer(X, Y).NPCIndex = 0 Else - Body = NpcData(buffer(X, y).NPCIndex).Body - Head = NpcData(buffer(X, y).NPCIndex).Head - Heading = NpcData(buffer(X, y).NPCIndex).Heading - Call MakeChar(NextOpenChar(), Body, Head, Heading, X, y) + Body = NpcData(buffer(X, Y).NPCIndex).Body + Head = NpcData(buffer(X, Y).NPCIndex).Head + Heading = NpcData(buffer(X, Y).NPCIndex).Heading + Call MakeChar(NextOpenChar(), Body, Head, Heading, X, Y) End If End If If ByFlags And 4 Then 'Get and make Object - Get FreeFileInf, , buffer(X, y).OBJInfo.objindex - Get FreeFileInf, , buffer(X, y).OBJInfo.Amount - If buffer(X, y).OBJInfo.objindex > 0 Then - InitGrh buffer(X, y).ObjGrh, ObjData(buffer(X, y).OBJInfo.objindex).grhIndex + Get FreeFileInf, , buffer(X, Y).OBJInfo.objindex + Get FreeFileInf, , buffer(X, Y).OBJInfo.Amount + If buffer(X, Y).OBJInfo.objindex > 0 Then + If ObjData(buffer(X, Y).OBJInfo.objindex).grhIndex <> 0 Then + InitGrh buffer(X, Y).ObjGrh, ObjData(buffer(X, Y).OBJInfo.objindex).grhIndex + With GrhData(ObjData(buffer(X, Y).OBJInfo.objindex).grhIndex) + Call g_Swarm.Insert(4, -1, X, Y, .TileWidth, .TileHeight) + End With + End If End If End If End If Next X - Next y + Next Y 'Close files Close FreeFileMap @@ -636,6 +661,10 @@ On Error Resume Next 'Change mouse icon frmMain.MousePointer = 0 MapaCargado = True + + If frmErrors.HasErrors() Then + frmErrors.Show , frmMain + End If End Sub '' @@ -656,7 +685,7 @@ Public Sub MapaV1_Cargar(ByVal Map As String, ByRef buffer() As MapBlock, ByVal Dim Body As Integer Dim Head As Integer Dim Heading As Byte - Dim y As Integer + Dim Y As Integer Dim X As Integer Dim FreeFileMap As Long Dim FreeFileInf As Long @@ -697,21 +726,21 @@ Public Sub MapaV1_Cargar(ByVal Map As String, ByRef buffer() As MapBlock, ByVal End If 'Load arrays - For y = YMinMapSize To YMaxMapSize + For Y = YMinMapSize To YMaxMapSize For X = XMinMapSize To XMaxMapSize '.map file - Get FreeFileMap, , buffer(X, y).Blocked + Get FreeFileMap, , buffer(X, Y).Blocked For loopc = 1 To 4 - Get FreeFileMap, , buffer(X, y).Graphic(loopc).grhIndex + Get FreeFileMap, , buffer(X, Y).Graphic(loopc).grhIndex 'Set up GRH - If buffer(X, y).Graphic(loopc).grhIndex > 0 Then - InitGrh buffer(X, y).Graphic(loopc), buffer(X, y).Graphic(loopc).grhIndex + If buffer(X, Y).Graphic(loopc).grhIndex > 0 Then + InitGrh buffer(X, Y).Graphic(loopc), buffer(X, Y).Graphic(loopc).grhIndex End If Next loopc 'Trigger - Get FreeFileMap, , buffer(X, y).Trigger + Get FreeFileMap, , buffer(X, Y).Trigger Get FreeFileMap, , TempInt @@ -719,24 +748,24 @@ Public Sub MapaV1_Cargar(ByVal Map As String, ByRef buffer() As MapBlock, ByVal '.inf file 'Tile exit - Get FreeFileInf, , buffer(X, y).TileExit.Map - Get FreeFileInf, , buffer(X, y).TileExit.X - Get FreeFileInf, , buffer(X, y).TileExit.y + Get FreeFileInf, , buffer(X, Y).TileExit.Map + Get FreeFileInf, , buffer(X, Y).TileExit.X + Get FreeFileInf, , buffer(X, Y).TileExit.Y 'make NPC - Get FreeFileInf, , buffer(X, y).NPCIndex - If buffer(X, y).NPCIndex > 0 Then - Body = NpcData(buffer(X, y).NPCIndex).Body - Head = NpcData(buffer(X, y).NPCIndex).Head - Heading = NpcData(buffer(X, y).NPCIndex).Heading - Call MakeChar(NextOpenChar(), Body, Head, Heading, X, y) + Get FreeFileInf, , buffer(X, Y).NPCIndex + If buffer(X, Y).NPCIndex > 0 Then + Body = NpcData(buffer(X, Y).NPCIndex).Body + Head = NpcData(buffer(X, Y).NPCIndex).Head + Heading = NpcData(buffer(X, Y).NPCIndex).Heading + Call MakeChar(NextOpenChar(), Body, Head, Heading, X, Y) End If 'Make obj - Get FreeFileInf, , buffer(X, y).OBJInfo.objindex - Get FreeFileInf, , buffer(X, y).OBJInfo.Amount - If buffer(X, y).OBJInfo.objindex > 0 Then - InitGrh buffer(X, y).ObjGrh, ObjData(buffer(X, y).OBJInfo.objindex).grhIndex + Get FreeFileInf, , buffer(X, Y).OBJInfo.objindex + Get FreeFileInf, , buffer(X, Y).OBJInfo.Amount + If buffer(X, Y).OBJInfo.objindex > 0 Then + InitGrh buffer(X, Y).ObjGrh, ObjData(buffer(X, Y).OBJInfo.objindex).grhIndex End If 'Empty place holders for future expansion @@ -744,7 +773,7 @@ Public Sub MapaV1_Cargar(ByVal Map As String, ByRef buffer() As MapBlock, ByVal Get FreeFileInf, , TempInt End If Next X - Next y + Next Y 'Close files Close FreeFileMap @@ -794,7 +823,7 @@ Public Sub MapInfo_Guardar(ByVal Archivo As String) MapTitulo = NameMap_Save End If - Call WriteVar(Archivo, MapTitulo, "Name", MapInfo.name) + Call WriteVar(Archivo, MapTitulo, "Name", MapInfo.Name) Call WriteVar(Archivo, MapTitulo, "MusicNum", MapInfo.Music) Call WriteVar(Archivo, MapTitulo, "MagiaSinefecto", Val(MapInfo.MagiaSinEfecto)) Call WriteVar(Archivo, MapTitulo, "NoEncriptarMP", Val(MapInfo.NoEncriptarMP)) @@ -850,7 +879,7 @@ On Error Resume Next Archivo = Right$(Archivo, Len(Archivo) - (Len(path))) MapTitulo = UCase$(Left$(Archivo, Len(Archivo) - 4)) - MapInfo.name = Leer.GetValue(MapTitulo, "Name") + MapInfo.Name = Leer.GetValue(MapTitulo, "Name") MapInfo.Music = Leer.GetValue(MapTitulo, "MusicNum") MapInfo.MagiaSinEfecto = Val(Leer.GetValue(MapTitulo, "MagiaSinEfecto")) MapInfo.NoEncriptarMP = Val(Leer.GetValue(MapTitulo, "NoEncriptarMP")) @@ -892,7 +921,7 @@ Public Sub MapInfo_Actualizar() On Error Resume Next ' Mostrar en Formularios - frmMapInfo.txtMapNombre.Text = MapInfo.name + frmMapInfo.txtMapNombre.Text = MapInfo.Name frmMapInfo.txtMapMusica.Text = MapInfo.Music frmMapInfo.txtMapTerreno.Text = MapInfo.Terreno frmMapInfo.txtMapZona.Text = MapInfo.Zona @@ -902,7 +931,7 @@ On Error Resume Next frmMapInfo.chkMapNoEncriptarMP.Value = MapInfo.NoEncriptarMP frmMapInfo.chkMapPK.Value = IIf(MapInfo.PK = True, 1, 0) frmMapInfo.txtMapVersion = MapInfo.MapVersion - frmMain.lblMapNombre = MapInfo.name + frmMain.lblMapNombre = MapInfo.Name frmMain.lblMapMusica = MapInfo.Music frmMapInfo.chkTierra.Value = MapInfo.MapaTierra frmMapInfo.chkMismoBando.Value = MapInfo.MismoBando diff --git a/Codigo/modMusic.bas b/Codigo/modMusic.bas index 630e8e4..c138605 100644 --- a/Codigo/modMusic.bas +++ b/Codigo/modMusic.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modMusic" +'@Folder("WorldEditor.Modules") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by diff --git a/Codigo/modPaneles.bas b/Codigo/modPaneles.bas index 9ac3ed4..a28ec85 100644 --- a/Codigo/modPaneles.bas +++ b/Codigo/modPaneles.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modPaneles" +'@Folder("WorldEditor.Modules") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -28,170 +29,116 @@ Attribute VB_Name = "modPaneles" ' @date 20060530 Option Explicit +Public Enum PanelsTypes + Surfaces + Exits + Blocks + NPC + NPCHostile + Objects + Triggers + Count +End Enum -'' -' Activa/Desactiva el Estado de la Funcion en el Panel Superior -' -' @param Numero Especifica en numero de funcion -' @param Activado Especifica si esta o no activado -Public Sub EstSelectPanel(ByVal Numero As Byte, ByVal Activado As Boolean) -'************************************************* -'Author: ^[GS]^ -'Last modified: 30/05/06 -'************************************************* +Private Type PanelType + panelFrame As Frame + btn As lvButtons_H + usePreview As Boolean +End Type - If Activado Then - frmMain.SelectPanel(Numero).GradientMode = lv_Bottom2Top - frmMain.SelectPanel(Numero).HoverBackColor = frmMain.SelectPanel(Numero).GradientColor - If frmMain.mnuVerAutomatico.Checked = True Then - Select Case Numero - Case 0 - If CurLayer <> 1 Then - frmMain.mnuVerCapa(CurLayer).Tag = CInt(frmMain.mnuVerCapa(CurLayer).Checked) - frmMain.mnuVerCapa(CurLayer).Checked = True - - bVerCapa(CurLayer) = True - End If - Case 2 - frmMain.cVerBloqueos.Tag = CInt(frmMain.cVerBloqueos.value) - frmMain.cVerBloqueos.value = True - frmMain.mnuVerBloqueos.Checked = frmMain.cVerBloqueos.value - Case 6 - frmMain.cVerTriggers.Tag = CInt(frmMain.cVerTriggers.value) - frmMain.cVerTriggers.value = True - frmMain.mnuVerTriggers.Checked = frmMain.cVerTriggers.value - End Select - End If - Else - frmMain.SelectPanel(Numero).HoverBackColor = frmMain.SelectPanel(Numero).BackColor - frmMain.SelectPanel(Numero).GradientMode = lv_NoGradient +Private device As Integer +Private Pic As MyPicture +Private currentPanel As PanelsTypes +Private panels(PanelsTypes.Count) As PanelType + +Private Sub SetFrameAs(ByRef f As Frame, pType As PanelsTypes, btn As lvButtons_H, usePreview As Boolean) + With panels(pType) + Set .panelFrame = f + Set .btn = btn + .usePreview = usePreview + End With +End Sub + +Public Sub InitPanelModule(holder As MyPicture) + Dim i As Integer + + Set Pic = holder + device = wGL_Graphic.Create_Device_From_Display(Pic.hwnd, Pic.ScaleWidth, Pic.ScaleHeight) - If frmMain.mnuVerAutomatico.Checked Then - Select Case Numero - Case 0 - If CurLayer <> 1 Then - If LenB(frmMain.mnuVerCapa(CurLayer).Tag) <> 0 Then - frmMain.mnuVerCapa(CurLayer).Checked = CBool(frmMain.mnuVerCapa(CurLayer).Tag) - bVerCapa(CurLayer) = frmMain.mnuVerCapa(CurLayer).Checked - End If - End If - Case 2 - If LenB(frmMain.cVerBloqueos.Tag) = 0 Then frmMain.cVerBloqueos.Tag = 0 - frmMain.cVerBloqueos.value = CBool(frmMain.cVerBloqueos.Tag) - frmMain.mnuVerBloqueos.Checked = frmMain.cVerBloqueos.value - Case 6 - If LenB(frmMain.cVerTriggers.Tag) = 0 Then frmMain.cVerTriggers.Tag = 0 - frmMain.cVerTriggers.value = CBool(frmMain.cVerTriggers.Tag) - frmMain.mnuVerTriggers.Checked = frmMain.cVerTriggers.value - End Select - End If - End If + Call Invalidate(Pic.hwnd) + + Call SetFrameAs(frmMain.frameSurface, Surfaces, frmMain.SelectPanel(Surfaces), True) + Call SetFrameAs(frmMain.frameBlock, Blocks, frmMain.SelectPanel(Blocks), False) + Call SetFrameAs(frmMain.frameExit, Exits, frmMain.SelectPanel(Exits), False) + Call SetFrameAs(frmMain.frameNpc, NPC, frmMain.SelectPanel(NPC), True) + Call SetFrameAs(frmMain.frameNpcH, NPCHostile, frmMain.SelectPanel(NPCHostile), True) + Call SetFrameAs(frmMain.frameObject, Objects, frmMain.SelectPanel(Objects), True) + Call SetFrameAs(frmMain.frameTriggers, Triggers, frmMain.SelectPanel(Triggers), True) + + For i = 0 To PanelsTypes.Count - 1 + panels(i).panelFrame.Visible = False + Next +End Sub +Public Sub SetPanel(selectedPanel As PanelsTypes) + With panels(currentPanel) + .panelFrame.Visible = False + .btn.Value = False + End With + With panels(selectedPanel) + .panelFrame.Visible = True + .btn.Value = True + frmMain.PreviewGrh.Visible = .usePreview + If .usePreview Then + frmMain.StatTxt.Top = (frmMain.PreviewGrh.Top + frmMain.PreviewGrh.Height) + 2 + frmMain.StatTxt.Height = (frmMain.ScaleHeight - frmMain.StatTxt.Top) - 2 + Else + frmMain.StatTxt.Top = frmMain.PreviewGrh.Top + 2 + frmMain.StatTxt.Height = (frmMain.ScaleHeight - frmMain.StatTxt.Top) - 2 + End If + End With + currentPanel = selectedPanel End Sub -'' -' Muestra los controles que componen a la funcion seleccionada del Panel -' -' @param Numero Especifica el numero de Funcion -' @param Ver Especifica si se va a ver o no -' @param Normal Inidica que ahi que volver todo No visible +Public Sub DestroyPanelModule() + wGL_Graphic.Destroy_Device (device) +End Sub -Public Sub VerFuncion(ByVal Numero As Byte, ByVal Ver As Boolean, Optional Normal As Boolean) -'************************************************* -'Author: ^[GS]^ -'Last modified: 20/05/06 -'************************************************* - If Normal Then Call VerFuncion(vMostrando, False, False) +Public Sub Render() + Call wGL_Graphic.Use_Device(device) + Call wGL_Graphic.Clear(CLEAR_COLOR Or CLEAR_DEPTH Or CLEAR_STENCIL, &H0, 1#, 0) + Call wGL_Graphic_Renderer.Update_Projection(&H0, Pic.ScaleWidth, Pic.ScaleHeight) - Select Case Numero - Case 0 ' Superficies - frmMain.lListado(0).Visible = Ver - frmMain.cFiltro(0).Visible = Ver - frmMain.cCapas.Visible = Ver - frmMain.cGrh.Visible = Ver - frmMain.cQuitarEnEstaCapa.Visible = Ver - frmMain.cQuitarEnTodasLasCapas.Visible = Ver - frmMain.cSeleccionarSuperficie.Visible = Ver - frmMain.lbFiltrar(0).Visible = Ver - frmMain.lbCapas.Visible = Ver - frmMain.lbGrh.Visible = Ver - frmMain.PreviewGrh.Visible = Ver - If Ver = True Then - frmMain.StatTxt.Top = 672 - frmMain.StatTxt.Height = 37 - Else - frmMain.StatTxt.Top = 416 - frmMain.StatTxt.Height = 293 - End If - Case 1 ' Translados - frmMain.lMapN.Visible = Ver - frmMain.lXhor.Visible = Ver - frmMain.lYver.Visible = Ver - frmMain.tTMapa.Visible = Ver - frmMain.tTX.Visible = Ver - frmMain.tTY.Visible = Ver - frmMain.cInsertarTrans.Visible = Ver - frmMain.cInsertarTransOBJ.Visible = Ver - frmMain.cUnionManual.Visible = Ver - frmMain.cUnionAuto.Visible = Ver - frmMain.cQuitarTrans.Visible = Ver - Case 2 ' Bloqueos - frmMain.cQuitarBloqueo.Visible = Ver - frmMain.cInsertarBloqueo.Visible = Ver - frmMain.cVerBloqueos.Visible = Ver - Case 3 ' NPCs - frmMain.lListado(1).Visible = Ver - frmMain.cFiltro(1).Visible = Ver - frmMain.lbFiltrar(1).Visible = Ver - frmMain.lNumFunc(Numero - 3).Visible = Ver - frmMain.cNumFunc(Numero - 3).Visible = Ver - frmMain.cInsertarFunc(Numero - 3).Visible = Ver - frmMain.cQuitarFunc(Numero - 3).Visible = Ver - frmMain.cAgregarFuncalAzar(Numero - 3).Visible = Ver - frmMain.lCantFunc(Numero - 3).Visible = Ver - frmMain.cCantFunc(Numero - 3).Visible = Ver - Case 4 ' NPCs Hostiles - frmMain.lListado(2).Visible = Ver - frmMain.cFiltro(2).Visible = Ver - frmMain.lbFiltrar(2).Visible = Ver - frmMain.lNumFunc(Numero - 3).Visible = Ver - frmMain.cNumFunc(Numero - 3).Visible = Ver - frmMain.cInsertarFunc(Numero - 3).Visible = Ver - frmMain.cQuitarFunc(Numero - 3).Visible = Ver - frmMain.cAgregarFuncalAzar(Numero - 3).Visible = Ver - frmMain.lCantFunc(Numero - 3).Visible = Ver - frmMain.cCantFunc(Numero - 3).Visible = Ver - Case 5 ' OBJs - frmMain.lListado(3).Visible = Ver - frmMain.cFiltro(3).Visible = Ver - frmMain.lbFiltrar(3).Visible = Ver - frmMain.lNumFunc(Numero - 3).Visible = Ver - frmMain.cNumFunc(Numero - 3).Visible = Ver - frmMain.cInsertarFunc(Numero - 3).Visible = Ver - frmMain.cQuitarFunc(Numero - 3).Visible = Ver - frmMain.cAgregarFuncalAzar(Numero - 3).Visible = Ver - frmMain.lCantFunc(Numero - 3).Visible = Ver - frmMain.cCantFunc(Numero - 3).Visible = Ver - Case 6 ' Triggers - frmMain.cQuitarTrigger.Visible = Ver - frmMain.cInsertarTrigger.Visible = Ver - frmMain.cVerTriggers.Visible = Ver - frmMain.lListado(4).Visible = Ver - End Select - If Ver Then - vMostrando = Numero - If Numero < 0 Or Numero > 6 Then Exit Sub - If frmMain.SelectPanel(Numero).value = False Then - frmMain.SelectPanel(Numero).value = True - End If + If MosaicoChecked Then + Dim X As Integer, Y As Integer + For X = 1 To mAncho + For Y = 1 To MAlto + If CurrentGrh(X, Y).grhIndex Then + With GrhData(CurrentGrh(X, Y).grhIndex) + 'TODO fix for grh size + Call DrawGrhIndex(.Frames(1), (X * 32) - 32, (Y * 32) - 32, -1#, 0) + End With + End If + Next Y + Next X Else - If Numero < 0 Or Numero > 6 Then Exit Sub - If frmMain.SelectPanel(Numero).value = True Then - frmMain.SelectPanel(Numero).value = False + If CurrentGrh(0).grhIndex > 0 Then + With GrhData(CurrentGrh(0).grhIndex) + 'Call DrawGrhIndex(.Frames(1), 0, 0, -1#, 0) + Call DrawGrhIndexWithLimit(.Frames(1), 0, 0, -1#, Pic.ScaleWidth, Pic.ScaleHeight) + End With End If End If + + Call wGL_Graphic_Renderer.Flush End Sub +'' +' Muestra los controles que componen a la funcion seleccionada del Panel +' +' @param Numero Especifica el numero de Funcion +' @param Ver Especifica si se va a ver o no +' @param Normal Inidica que ahi que volver todo No visible '' ' Filtra del Listado de Elementos de una Funcion @@ -279,7 +226,7 @@ Else End If Call fPreviewGrh(frmMain.cGrh.Text) -Call VistaPreviaDeSup +Call Render End Sub Public Sub fPreviewGrh(ByVal GrhIn As Integer) @@ -288,7 +235,7 @@ Public Sub fPreviewGrh(ByVal GrhIn As Integer) 'Last modified: 22/05/06 '************************************************* Dim X As Byte -Dim y As Byte +Dim Y As Byte If Val(GrhIn) < 1 Then frmMain.cGrh.Text = UBound(GrhData) @@ -301,18 +248,18 @@ If Val(GrhIn) > UBound(GrhData) Then End If If MosaicoChecked Then - For y = 1 To MAlto + For Y = 1 To MAlto For X = 1 To mAncho 'Change CurrentGrh If Not fullyBlack(GrhIn) Then - InitGrh CurrentGrh(X, y), GrhIn + InitGrh CurrentGrh(X, Y), GrhIn Else - InitGrh CurrentGrh(X, y), 0 + InitGrh CurrentGrh(X, Y), 0 End If GrhIn = GrhIn + 1 Next X - Next y + Next Y Else If Not fullyBlack(GrhIn) Then InitGrh CurrentGrh(0), GrhIn @@ -321,60 +268,3 @@ Else End If End If End Sub - -'' -' Indica la accion de mostrar Vista Previa de la Superficie seleccionada -' - -Public Sub VistaPreviaDeSup() -'************************************************* -'Author: ^[GS]^ -'Last modified: 26/05/06 -'************************************************* -Dim SR As RECT, DR As RECT - - frmGrafico.ShowPic = frmGrafico.Picture1 - - If MosaicoChecked Then - Dim X As Integer, y As Integer - - For X = 1 To mAncho - For y = 1 To MAlto - If CurrentGrh(X, y).grhIndex Then - With GrhData(CurrentGrh(X, y).grhIndex) - DR.Left = (X - 1) * .pixelWidth - DR.Top = (y - 1) * .pixelHeight - DR.Right = X * .pixelWidth - DR.Bottom = y * .pixelHeight - - SR.Left = .sX - SR.Top = .sY - SR.Right = SR.Left + .pixelWidth - SR.Bottom = SR.Top + .pixelHeight - - Call DrawGrhtoHdc(frmGrafico.ShowPic.hdc, .Frames(1), SR, DR) - End With - End If - Next y - Next X - Else - If CurrentGrh(0).grhIndex Then - With GrhData(CurrentGrh(0).grhIndex) - DR.Left = 0 - DR.Top = 0 - DR.Bottom = .pixelHeight - DR.Right = .pixelWidth - - SR.Left = .sX - SR.Top = .sY - SR.Right = SR.Left + .pixelWidth - SR.Bottom = SR.Top + .pixelHeight - - Call DrawGrhtoHdc(frmGrafico.ShowPic.hdc, .Frames(1), SR, DR) - End With - End If - End If - - frmGrafico.ShowPic.Picture = frmGrafico.ShowPic.Image - frmMain.PreviewGrh = frmGrafico.ShowPic -End Sub diff --git a/Codigo/modPicAdvanced.bas b/Codigo/modPicAdvanced.bas index f396b85..39ba33f 100644 --- a/Codigo/modPicAdvanced.bas +++ b/Codigo/modPicAdvanced.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modPicAdvanced" +'@Folder("WorldEditor.Modules") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -29,7 +30,7 @@ Attribute VB_Name = "modPicAdvanced" Option Explicit ' ----==== GDIPlus Const ====---- -Public Const GdiPlusVersion As Long = 1 +Public Const GdiplusVersion As Long = 1 Private Const mimeJPG As String = "image/jpeg" Private Const mimePNG As String = "image/png" Private Const mimeTIFF As String = "image/tiff" @@ -40,7 +41,7 @@ Private Const EncoderCompression As String = "{E09D739D-CCD4-44EE-8EBA-3FBF8BE4F ' ----==== Sonstige Types ====---- Private Type PICTDESC cbSizeOfStruct As Long - picType As Long + PicType As Long hgdiObj As Long hPalOrXYExt As Long End Type @@ -60,8 +61,8 @@ Private Type GUID End Type ' ----==== GDIPlus Types ====---- -Private Type GDIPlusStartupInput - GdiPlusVersion As Long +Private Type GdiplusStartupInput + GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long @@ -75,7 +76,7 @@ End Type Private Type EncoderParameter GUID As GUID NumberOfValues As Long - type As Long + Type As Long Value As Long End Type @@ -247,7 +248,7 @@ Private Enum PaletteType End Enum ' ----==== GDI+ 5.xx und 6.xx API Deklarationen ====---- Private Declare Function GdipCloneBitmapArea Lib "gdiplus" _ - (ByVal X As Single, ByVal y As Single, ByVal Width As Single, _ + (ByVal X As Single, ByVal Y As Single, ByVal Width As Single, _ ByVal Height As Single, ByVal format As PixelFormats, _ ByVal srcBitmap As Long, ByRef dstBitmap As Long) As Status @@ -255,7 +256,7 @@ Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _ (ByVal FileName As Long, ByRef BITMAP As Long) As Status Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _ - (ByVal hbm As Long, ByVal hpal As Long, _ + (ByVal hbm As Long, ByVal hPal As Long, _ ByRef BITMAP As Long) As Status Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" _ @@ -263,31 +264,31 @@ Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" _ ByVal background As Long) As Status Private Declare Function GdipDisposeImage Lib "gdiplus" _ - (ByVal image As Long) As Status + (ByVal Image As Long) As Status Private Declare Function GdipGetImageEncoders Lib "gdiplus" _ - (ByVal numEncoders As Long, ByVal Size As Long, _ + (ByVal numEncoders As Long, ByVal size As Long, _ ByRef Encoders As Any) As Status Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" _ - (ByRef numEncoders As Long, ByRef Size As Long) As Status + (ByRef numEncoders As Long, ByRef size As Long) As Status Private Declare Function GdipGetImagePixelFormat Lib "gdiplus" _ - (ByVal image As Long, ByRef PixelFormat As PixelFormats) As Status + (ByVal Image As Long, ByRef PixelFormat As PixelFormats) As Status Private Declare Function GdipGetImageDimension Lib "gdiplus" _ - (ByVal image As Long, ByRef sngWidth As Single, _ + (ByVal Image As Long, ByRef sngWidth As Single, _ ByRef sngHeight As Single) As Status Private Declare Function GdiplusShutdown Lib "gdiplus" _ - (ByVal token As Long) As Status + (ByVal Token As Long) As Status Private Declare Function GdiplusStartup Lib "gdiplus" _ - (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, _ + (ByRef Token As Long, ByRef lpInput As GdiplusStartupInput, _ Optional ByRef lpOutput As Any) As Status Private Declare Function GdipSaveImageToFile Lib "gdiplus" _ - (ByVal image As Long, ByVal FileName As Long, _ + (ByVal Image As Long, ByVal FileName As Long, _ ByRef clsidEncoder As GUID, _ ByRef encoderParams As Any) As Status @@ -341,8 +342,8 @@ Public UseGDI6 As Boolean Public Function StartUpGDIPlus(ByVal GdipVersion As Long) As Status ' Initialisieren der GDI+ Instanz - Dim GdipStartupInput As GDIPlusStartupInput - GdipStartupInput.GdiPlusVersion = GdipVersion + Dim GdipStartupInput As GdiplusStartupInput + GdipStartupInput.GdiplusVersion = GdipVersion StartUpGDIPlus = GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0) End Function @@ -458,9 +459,9 @@ End If End Function -Private Function HandleToPicture(ByVal hGDIHandle As Long, _ +Public Function HandleToPicture(ByVal hGDIHandle As Long, _ ByVal ObjectType As PictureTypeConstants, _ - Optional ByVal hpal As Long = 0) As StdPicture + Optional ByVal hPal As Long = 0) As StdPicture Dim tPictDesc As PICTDESC Dim IID_IPicture As IID @@ -469,9 +470,9 @@ Dim oPicture As IPicture ' Initialisiert die PICTDESC Structur With tPictDesc .cbSizeOfStruct = Len(tPictDesc) - .picType = ObjectType + .PicType = ObjectType .hgdiObj = hGDIHandle - .hPalOrXYExt = hpal + .hPalOrXYExt = hPal End With ' Initialisiert das IPicture Interface ID @@ -497,20 +498,20 @@ End Function Private Function GetEncoderClsid(mimeType As String, pClsid As GUID) As Boolean Dim num As Long -Dim Size As Long +Dim size As Long Dim pImageCodecInfo() As ImageCodecInfo Dim j As Long Dim buffer As String -Call GdipGetImageEncodersSize(num, Size) +Call GdipGetImageEncodersSize(num, size) -If (Size = 0) Then +If (size = 0) Then GetEncoderClsid = False '// fehlgeschlagen Exit Function End If -ReDim pImageCodecInfo(0 To Size \ Len(pImageCodecInfo(0)) - 1) -Call GdipGetImageEncoders(num, Size, pImageCodecInfo(0)) +ReDim pImageCodecInfo(0 To size \ Len(pImageCodecInfo(0)) - 1) +Call GdipGetImageEncoders(num, size, pImageCodecInfo(0)) For j = 0 To num - 1 buffer = Space$(lstrlenW(ByVal pImageCodecInfo(j).MimeTypePtr)) @@ -583,7 +584,7 @@ If GetEncoderClsid(mimeTIFF, tPicEncoder) = True Then ' Setzen der Kompressions GUID CLSIDFromString StrPtr(EncoderCompression), .GUID .NumberOfValues = 1 - .type = EncoderParameterValueTypeLong + .Type = EncoderParameterValueTypeLong ' Kompressionstyp .Value = VarPtr(eTifCompression) End With @@ -645,7 +646,7 @@ If GetEncoderClsid(mimeTIFF, tPicEncoder) = True Then ' Setzen der Kompressions GUID CLSIDFromString StrPtr(EncoderCompression), .GUID .NumberOfValues = 1 - .type = EncoderParameterValueTypeLong + .Type = EncoderParameterValueTypeLong ' Kompressionstyp .Value = VarPtr(eTifCompression) End With @@ -718,7 +719,7 @@ If GetEncoderClsid(mimeTIFF, tPicEncoder) = True Then ' Setzen der Kompressions GUID CLSIDFromString StrPtr(EncoderCompression), .GUID .NumberOfValues = 1 - .type = EncoderParameterValueTypeLong + .Type = EncoderParameterValueTypeLong ' Kompressionstyp .Value = VarPtr(eTifCompression) End With @@ -736,7 +737,7 @@ Else End If End Function -Public Function SavePictureAsTiff(ByVal Pic As StdPicture, _ +Public Function SavePictureAsTiff(ByVal pic As StdPicture, _ ByVal sFileName As String, _ Optional ByVal eTifCompression As EncoderValueConstants _ = EncoderValueCompressionNone) As Boolean @@ -747,7 +748,7 @@ Dim lBitmap As Long ' Erzeugt eine GDI+ Bitmap vom ' StdPicture Handle -> lBitmap If Execute(GdipCreateBitmapFromHBITMAP( _ - Pic.handle, 0, lBitmap)) = OK Then + pic.Handle, 0, lBitmap)) = OK Then ' Kompressionstyp Select Case eTifCompression @@ -793,7 +794,7 @@ If Execute(GdipCreateBitmapFromHBITMAP( _ End If End Function -Public Function SavePictureAsJPG(ByVal Pic As StdPicture, _ +Public Function SavePictureAsJPG(ByVal pic As StdPicture, _ ByVal FileName As String, Optional ByVal Quality As Long = 85) _ As Boolean @@ -802,7 +803,7 @@ Dim retVal As Boolean Dim lBitmap As Long ' Erzeugt eine GDI+ Bitmap vom StdPicture Handle -> lBitmap -retStatus = Execute(GdipCreateBitmapFromHBITMAP(Pic.handle, 0, lBitmap)) +retStatus = Execute(GdipCreateBitmapFromHBITMAP(pic.Handle, 0, lBitmap)) If retStatus = OK Then @@ -824,7 +825,7 @@ If retStatus = OK Then ' Setzen der Quality GUID CLSIDFromString StrPtr(EncoderQuality), .GUID .NumberOfValues = 1 - .type = EncoderParameterValueTypeLong + .Type = EncoderParameterValueTypeLong .Value = VarPtr(Quality) End With @@ -848,7 +849,7 @@ If retStatus = OK Then End If End Function -Public Function SavePictureAsPNG(ByVal Pic As StdPicture, _ +Public Function SavePictureAsPNG(ByVal pic As StdPicture, _ ByVal sFileName As String) As Boolean Dim lBitmap As Long @@ -857,7 +858,7 @@ Dim tPicEncoder As GUID ' Erzeugt eine GDI+ Bitmap vom ' StdPicture Handle -> lBitmap If Execute(GdipCreateBitmapFromHBITMAP( _ - Pic.handle, 0, lBitmap)) = OK Then + pic.Handle, 0, lBitmap)) = OK Then ' Ermitteln der CLSID vom mimeType Encoder If GetEncoderClsid(mimePNG, tPicEncoder) = True Then diff --git a/Codigo/modPrimitives.bas b/Codigo/modPrimitives.bas new file mode 100644 index 0000000..880d8f8 --- /dev/null +++ b/Codigo/modPrimitives.bas @@ -0,0 +1,32 @@ +Attribute VB_Name = "modPrimitives" +'@Folder("WorldEditor.Modules.Render") +Option Explicit + +Private primitiveTecnique As Integer + +Public Sub InitPrimitivesModule() + primitiveTecnique = wGL_Graphic_Renderer.Create_Technique + + Call wGL_Graphic_Renderer.Update_Technique_Program(primitiveTecnique, wGL_Graphic.Create_Program(LoadBytes("Shader\Effect.vs"), LoadBytes("Shader\Shader1.fs"))) + + Dim Descriptor As wGL_Graphic_Descriptor + + Descriptor.Depth = COMPARISON_LESS_EQUAL + Descriptor.Mask_Red = True: Descriptor.Mask_Green = True: Descriptor.Mask_Blue = True: Descriptor.Mask_Alpha = True + + Descriptor.Blend_Color_Source = BLEND_FACTOR_SRC_ALPHA + Descriptor.Blend_Color_Destination = BLEND_FACTOR_ONE + + Descriptor.Depth_Mask = False + Call wGL_Graphic_Renderer.Update_Technique_Descriptor(primitiveTecnique, Descriptor) + +End Sub +Public Sub DrawBox(ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer, color As Long) + Dim source As wGL_Rectangle, destination As wGL_Rectangle + + destination.X1 = X1 + destination.Y1 = Y1 + destination.X2 = X2 + destination.Y2 = Y2 + Call wGL_Graphic_Renderer.Draw(destination, source, GetDepth(8), 0, color, 0, primitiveTecnique) +End Sub diff --git a/Codigo/modRender.bas b/Codigo/modRender.bas index 454ba32..baece61 100644 --- a/Codigo/modRender.bas +++ b/Codigo/modRender.bas @@ -1,4 +1,5 @@ Attribute VB_Name = "modRender" +'@Folder("WorldEditor.Modules.Render") '************************************************************** 'This program is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by @@ -37,6 +38,23 @@ Public Enum eFormatPic jpg End Enum +Public Type MapExportOptions + Width As Integer + Height As Integer + + floor As Boolean + layer2 As Boolean + layer3 As Boolean + layer4 As Boolean + objects As Boolean + npcs As Boolean + exits As Boolean + triggers As Boolean + blocks As Boolean + format As eFormatPic + +End Type + Public Sub RenderAllMaps(ByRef format As eFormatPic, ByVal SizeX As Long, ByVal SizeY As Long) '************************************************* 'Author: Anagrama @@ -44,7 +62,7 @@ Public Sub RenderAllMaps(ByRef format As eFormatPic, ByVal SizeX As Long, ByVal '12/08/2016: Anagrama - Genera una captura de cada mapa en la carpeta de mapas. '************************************************* Dim FileCount As String - Dim File() As String + Dim file() As String Dim FilePath As String Dim Extension As String Dim num As Integer @@ -56,8 +74,8 @@ Public Sub RenderAllMaps(ByRef format As eFormatPic, ByVal SizeX As Long, ByVal FileCount = Dir$(FilePath & Extension) Do While Len(FileCount) NumFiles = NumFiles + 1 - ReDim Preserve File(1 To NumFiles) As String - File(UBound(File)) = FileCount + ReDim Preserve file(1 To NumFiles) As String + file(UBound(file)) = FileCount FileCount = Dir$ Loop @@ -65,9 +83,9 @@ Public Sub RenderAllMaps(ByRef format As eFormatPic, ByVal SizeX As Long, ByVal frmRenderAll.pgbProgressTotal.max = NumFiles frmRenderAll.lblEstadoTotal = "0/" & NumFiles - For num = 1 To UBound(File) + For num = 1 To UBound(file) Call modMapIO.NuevoMapa - modMapIO.AbrirMapa FilePath & File(num), MapData + modMapIO.AbrirMapa FilePath & file(num), MapData Call MapCapture(format, SizeX, SizeY, 1) frmRenderAll.pgbProgressTotal.Value = frmRenderAll.pgbProgressTotal.Value + 1 frmRenderAll.lblEstadoTotal = frmRenderAll.pgbProgressTotal.Value & "/" & NumFiles @@ -76,285 +94,5 @@ Public Sub RenderAllMaps(ByRef format As eFormatPic, ByVal SizeX As Long, ByVal End Sub Public Sub MapCapture(ByRef format As eFormatPic, ByVal SizeX As Long, ByVal SizeY As Long, Optional ByVal RenderAll As Byte = 0) -'************************************************* -'Author: Torres Patricio(Pato) -'Last modified:12/03/11 -'12/08/2016: Anagrama - Modificado para generar tamaños inferiores sin distorcionarse. -' Cambiado el nombre de la carpeta destino de Screenshots a Renders. -' Ahora guarda el nombre del archivo en vez del nombre del mapa. -' Agregada distincion al capturar 1 o todos los mapas. -'************************************************* -Dim y As Long 'Keeps track of where on map we are -Dim X As Long 'Keeps track of where on map we are -Dim ScreenX As Integer 'Keeps track of where to place tile on screen -Dim ScreenY As Integer 'Keeps track of where to place tile on screen -Dim ScreenXOffset As Integer -Dim ScreenYOffset As Integer -Dim PixelOffsetXTemp As Integer 'For centering grhs -Dim PixelOffsetYTemp As Integer 'For centering grhs -Dim Grh As Grh 'Temp Grh for show tile and blocked -Dim renderSurface As DirectDrawSurface7 -Dim surfaceDesc As DDSURFACEDESC2 -Dim srcRect As RECT -Dim destRect As RECT -Dim MyMinX As Byte -Dim MyMaxX As Byte -Dim MyMinY As Byte -Dim MyMaxY As Byte - - With surfaceDesc - .lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH - If ClientSetup.bUseVideo Then - .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN - Else - .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY - End If - .lHeight = 3200 '32(Tamaño del pixel)*100(Ancho en pixeles)*100(Alto en pixeles) - .lWidth = 3200 - - Set renderSurface = DirectDraw.CreateSurface(surfaceDesc) - End With - - With srcRect - .Right = 3200 - .Bottom = 3200 - End With - - If RenderAll = 0 Then - frmRender.pgbProgress.Value = 0 - frmRender.pgbProgress.max = 50000 - MyMinX = XMinMapSize - MyMaxX = XMaxMapSize - MyMinY = YMinMapSize - MyMaxY = YMaxMapSize - Else - frmRenderAll.pgbProgress.Value = 0 - frmRenderAll.pgbProgress.max = 5 - MyMinX = 9 - MyMaxX = 92 - MyMinY = 7 - MyMaxY = 94 - srcRect.Bottom = 87 * 32 - srcRect.Right = 83 * 32 - End If - Call renderSurface.BltColorFill(srcRect, 0) - - If RenderAll = 1 Then - frmRenderAll.pgbProgress.Value = frmRenderAll.pgbProgress.Value + 1 - frmRenderAll.lblEstado.Caption = "Renderizado de primer capa - 20%" - End If - 'Draw floor layer - For y = MyMinY To MyMaxY - For X = MyMinX To MyMaxX - If RenderAll = 0 Then - 'Layer 1 ********************************** - If MapData(X, y).Graphic(1).grhIndex <> 0 Then - Call DDrawGrhtoSurface(renderSurface, MapData(X, y).Graphic(1), _ - (X - 1) * TilePixelWidth, _ - (y - 1) * TilePixelHeight, _ - 0, 1) - End If - '****************************************** - frmRender.pgbProgress.Value = frmRender.pgbProgress.Value + 1 - frmRender.lblEstado.Caption = "Renderizado de primer capa - " & (y - 1) + (X / 100) & "%" - Else - 'Layer 1 ********************************** - If MapData(X, y).Graphic(1).grhIndex <> 0 Then - Call DDrawGrhtoSurface(renderSurface, MapData(X, y).Graphic(1), _ - (X - 9) * TilePixelWidth, _ - (y - 7) * TilePixelHeight, _ - 0, 1) - End If - '****************************************** - End If - DoEvents - Next X - Next y - - If RenderAll = 1 Then - frmRenderAll.pgbProgress.Value = frmRenderAll.pgbProgress.Value + 1 - frmRenderAll.lblEstado.Caption = "Renderizado de segunda capa - 40%" - End If - - 'Draw floor layer 2 - For y = MyMinY To MyMaxY - For X = MyMinX To MyMaxX - If RenderAll = 0 Then - 'Layer 2 ********************************** - If (MapData(X, y).Graphic(2).grhIndex <> 0) And bVerCapa(2) Then - Call DDrawTransGrhtoSurface(renderSurface, MapData(X, y).Graphic(2), _ - (X - 1) * TilePixelWidth, _ - (y - 1) * TilePixelHeight, _ - 1, 1) - End If - '****************************************** - frmRender.pgbProgress.Value = frmRender.pgbProgress.Value + 1 - frmRender.lblEstado = "Renderizado de segunda capa - " & (y - 1) + (X / 100) & "%" - Else - 'Layer 2 ********************************** - If (MapData(X, y).Graphic(2).grhIndex <> 0) And bVerCapa(2) Then - Call DDrawTransGrhtoSurface(renderSurface, MapData(X, y).Graphic(2), _ - (X - 9) * TilePixelWidth, _ - (y - 7) * TilePixelHeight, _ - 1, 1) - End If - '****************************************** - End If - DoEvents - Next X - Next y - - If RenderAll = 1 Then - frmRenderAll.pgbProgress.Value = frmRenderAll.pgbProgress.Value + 1 - frmRenderAll.lblEstado.Caption = "Renderizado de objetos y tercera capa - 60%" - End If - - 'Draw Transparent Layers - For y = MyMinY To MyMaxY - For X = MyMinX To MyMaxX - If RenderAll = 0 Then - PixelOffsetXTemp = (X - 1) * TilePixelWidth - PixelOffsetYTemp = (y - 1) * TilePixelHeight - Else - PixelOffsetXTemp = (X - 9) * TilePixelWidth - PixelOffsetYTemp = (y - 7) * TilePixelHeight - End If - - With MapData(X, y) - 'Object Layer ********************************** - If (.ObjGrh.grhIndex <> 0) And bVerObjetos Then - Call DDrawTransGrhtoSurface(renderSurface, .ObjGrh, _ - PixelOffsetXTemp, PixelOffsetYTemp, 1, 1) - End If - '*********************************************** - - 'Layer 3 ***************************************** - If (.Graphic(3).grhIndex <> 0) And bVerCapa(3) Then - 'Draw - Call DDrawTransGrhtoSurface(renderSurface, .Graphic(3), _ - PixelOffsetXTemp, PixelOffsetYTemp, 1, 1) - End If - '************************************************ - - If RenderAll = 0 Then - frmRender.pgbProgress.Value = frmRender.pgbProgress.Value + 1 - frmRender.lblEstado.Caption = "Renderizado de objetos y tercer capa - " & (y - 1) + (X / 100) & "%" - End If - DoEvents - End With - Next X - Next y - - Grh.FrameCounter = 1 - Grh.Started = 0 - - If RenderAll = 1 Then - frmRenderAll.pgbProgress.Value = frmRenderAll.pgbProgress.Value + 1 - frmRenderAll.lblEstado.Caption = "Renderizado de cuarta capa - 80%" - End If - - 'Draw layer 4 - For y = MyMinY To MyMaxY - For X = MyMinX To MyMaxX - With MapData(X, y) - If RenderAll = 0 Then - 'Layer 4 ********************************** - If (.Graphic(4).grhIndex <> 0) And bVerCapa(4) Then - 'Draw - Call DDrawTransGrhtoSurface(renderSurface, .Graphic(4), _ - (X - 1) * TilePixelWidth, _ - (y - 1) * TilePixelHeight, _ - 1, 1) - End If - '********************************** - frmRender.pgbProgress.Value = frmRender.pgbProgress.Value + 1 - frmRender.lblEstado.Caption = "Renderizado de cuarta capa - " & (y - 1) + (X / 100) & "%" - Else - 'Layer 4 ********************************** - If (.Graphic(4).grhIndex <> 0) And bVerCapa(4) Then - 'Draw - Call DDrawTransGrhtoSurface(renderSurface, .Graphic(4), _ - (X - 9) * TilePixelWidth, _ - (y - 7) * TilePixelHeight, _ - 1, 1) - End If - '********************************** - End If - DoEvents - End With - Next X - Next y - - If RenderAll = 0 Then - 'Draw trans, bloqs, triggers and select tiles - For y = MyMinY To MyMaxY - For X = MyMinX To MyMaxX - With MapData(X, y) - PixelOffsetXTemp = (X - 1) * TilePixelWidth - PixelOffsetYTemp = (y - 1) * TilePixelHeight - - '********************************** - If (.TileExit.Map <> 0) And bTranslados Then - Grh.grhIndex = 3 - - Call DDrawTransGrhtoSurface(renderSurface, Grh, _ - PixelOffsetXTemp, _ - PixelOffsetYTemp, _ - 1, 0) - End If - - 'Show blocked tiles - If (.Blocked = 1) And bBloqs Then - Grh.grhIndex = 4 - - Call DDrawTransGrhtoSurface(renderSurface, Grh, _ - PixelOffsetXTemp, _ - PixelOffsetYTemp, _ - 1, 0) - End If - '****************************************** - - frmRender.pgbProgress.Value = frmRender.pgbProgress.Value + 1 - frmRender.lblEstado.Caption = "Renderizado de translados y bloqueos - " & (y - 1) + (X / 100) & "%" - DoEvents - End With - Next X - Next y - End If - - destRect.Right = srcRect.Right - destRect.Bottom = srcRect.Bottom - - frmRenderAll.tmpPic.Width = srcRect.Right - frmRenderAll.tmpPic.Height = srcRect.Bottom - - frmRenderAll.picMap.Width = SizeX - frmRenderAll.picMap.Height = SizeY - - Call renderSurface.BltToDC(frmRenderAll.tmpPic.hdc, srcRect, destRect) - - frmRenderAll.tmpPic.Picture = frmRenderAll.tmpPic.Image - - Dim Token As Long - Token = InitGDIPlus - frmRenderAll.picMap = Resize(frmRenderAll.tmpPic.Picture.handle, frmRenderAll.tmpPic.Picture.Type, frmRenderAll.picMap.ScaleWidth, frmRenderAll.picMap.ScaleHeight, , False) - FreeGDIPlus Token - - If Not FileExist(App.path & "\Renders", vbDirectory) Then MkDir (App.path & "\Renders") - - Select Case format - Case eFormatPic.bmp - Call SavePicture(frmRenderAll.picMap.Image, App.path & "\Renders\" & NumMap_Save & ".bmp") - - Case eFormatPic.png - Call StartUpGDIPlus(GdiplusVersion) - Call SavePictureAsPNG(frmRenderAll.picMap.Picture, App.path & "\Renders\" & NumMap_Save & ".png") - Call ShutdownGDIPlus - - Case eFormatPic.jpg - Call StartUpGDIPlus(GdiplusVersion) - Call SavePictureAsJPG(frmRenderAll.picMap.Picture, App.path & "\Renders\" & NumMap_Save & ".jpg") - Call ShutdownGDIPlus - End Select End Sub diff --git a/Codigo/modTileEngine.bas b/Codigo/modTileEngine.bas new file mode 100644 index 0000000..0cee7b3 --- /dev/null +++ b/Codigo/modTileEngine.bas @@ -0,0 +1,871 @@ +Attribute VB_Name = "modTileEngine" +'@Folder("WorldEditor.Modules.Render") +Option Explicit +Public Const ENGINE_SPEED As Single = 0.018 +Public Type tFuente + id As Integer + Tamanio As Long + color As Long +End Type + +Public timerEngine As Currency + +Public Type tFuentesJuego + FuenteBase As tFuente + + 'Nicks + NickCriminal As tFuente + NickCiudadano As tFuente + NickAtacable As tFuente + NickConcilio As tFuente + NickConsejo As tFuente + NickDios As tFuente + NickSemidios As tFuente + NickConsejero As tFuente + NickAdmins As tFuente + NickRolemasters As tFuente + NickNpcs As tFuente + + 'General + Talk As tFuente + Fight As tFuente + Warning As tFuente + Info As tFuente + InfoBold As tFuente + Execution As tFuente + Party As tFuente + Poison As tFuente + Guild As tFuente + Server As tFuente + GuildMsg As tFuente + Centinela As tFuente + GMSG As tFuente + + ConsejoVesA As tFuente + ConcilioVesA As tFuente + + Inventarios As tFuente + +End Type + +Public FuentesJuego As tFuentesJuego +'''''''''''''''''''''''''''''''''''''''''''''''' +''' WGL (TEMPORALLY) +''''''''''''''''''''''''''''''''''''''''''''''' + +Private g_Material(0 To 65535) As Integer +Public g_Technique_1 As Integer +Public g_Technique_2 As Integer +Public g_Swarm As New wGL_Temp_Swarm + + +Private Type PostEffectUniform + Effect As wGL_Uniform +End Type + +Private g_Post_Effect_Device As Integer +Private g_Post_Effect_Material As Integer +Private g_Post_Effect_Technique As Integer +Private g_Post_Effect_Uniform As PostEffectUniform +Private g_Rain_Material As Integer + +Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long +Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long + +Public Sub Invalidate(ByVal hwnd As Long) + Dim udtRect As RECT + + Call GetClientRect(hwnd, udtRect) + Call InvalidateRect(hwnd, udtRect, 1) +End Sub + +Public Function GetImageFromNum(ByVal fileNum As Long) As Byte() +On Error GoTo ErrHandler + + Dim InfoHead As INFOHEADER + + If FileExist(DirGraficos & fileNum & ".PNG", vbArchive) Then + GetImageFromNum = modGeneral.ReadAllBytes(DirGraficos & fileNum & ".PNG") + ElseIf FileExist(DirGraficos & fileNum & ".BMP", vbArchive) Then + GetImageFromNum = modGeneral.ReadAllBytes(DirGraficos & fileNum & ".BMP") + ElseIf Get_InfoHeader(DirGraficos, fileNum & ".PNG", InfoHead) Then + Call Extract_File(DirGraficos, InfoHead, GetImageFromNum) + ElseIf Get_InfoHeader(DirGraficos, fileNum & ".BMP", InfoHead) Then + Call Extract_File(DirGraficos, InfoHead, GetImageFromNum) + Else + Call LogError("Can't find image with number" & fileNum & "en Function GetImageFromNum de modTileEngie.bas") + End If + + Exit Function + +ErrHandler: + Call LogError("Error" & Err.Number & "(" & Err.Description & ") en Function GetImageFromNum de modTileEngie.bas") +End Function + +Public Function CreateFont(ByVal id As Integer, ByVal Tamanio As Long, ByVal color As Long) As tFuente + + CreateFont.id = id + CreateFont.Tamanio = Tamanio + CreateFont.color = color + +End Function + +Public Sub LoadFontDescription() +On Error GoTo ErrHandler + + Dim font As Integer + font = wGL_Graphic_Renderer.Create_Font(LoadBytes("FONT/Primary.ttf")) + + + ' RGBA + FuentesJuego.FuenteBase = CreateFont(font, 14, &HFFFFFFFF) + FuentesJuego.NickCriminal = CreateFont(font, 14, &HFFFF0000) + FuentesJuego.NickCiudadano = CreateFont(font, 14, &HFF0080FF) + FuentesJuego.NickAtacable = CreateFont(font, 14, &HFFB332FF) + FuentesJuego.NickAdmins = CreateFont(font, 14, &HFFFFFFFF) + FuentesJuego.NickDios = CreateFont(font, 14, &HFFFAFA96) + FuentesJuego.NickSemidios = CreateFont(font, 14, &HFF1EFF30) + FuentesJuego.NickConsejero = CreateFont(font, 14, &HFF1E9630) + FuentesJuego.NickAdmins = CreateFont(font, 14, &HFFB4B4B4) + FuentesJuego.NickConcilio = CreateFont(font, 14, &HFFFF3200) + FuentesJuego.NickConsejo = CreateFont(font, 14, &HFF0C3FF) + FuentesJuego.NickNpcs = CreateFont(font, 14, &HFFB6A951) + + FuentesJuego.Talk = CreateFont(font, 14, &HFFFFFFFF) + FuentesJuego.Fight = CreateFont(font, 14, &HFFFF0000) + FuentesJuego.Warning = CreateFont(font, 14, &HFF2033E9) + FuentesJuego.Info = CreateFont(font, 14, &HFF41BE9C) + FuentesJuego.InfoBold = CreateFont(font, 14, &HFF31BE9C) + FuentesJuego.Execution = CreateFont(font, 14, &HFF828282) + FuentesJuego.Party = CreateFont(font, 14, &HFFFFB4FF) + FuentesJuego.Poison = CreateFont(font, 14, &HFF00FF00) + + FuentesJuego.Guild = CreateFont(font, 14, &HFFFFFFFF) + FuentesJuego.Server = CreateFont(font, 14, &HFF00B900) + FuentesJuego.GuildMsg = CreateFont(font, 14, &HFFFFC71B) + + FuentesJuego.ConsejoVesA = CreateFont(font, 14, &HFF00C8FF) + FuentesJuego.ConcilioVesA = CreateFont(font, 14, &HFFFF3200) + + FuentesJuego.Centinela = CreateFont(font, 14, &HFF00FF00) + FuentesJuego.GMSG = CreateFont(font, 14, &HFFFFFFFF) + + FuentesJuego.Inventarios = CreateFont(font, 12, &HFFFFFFFF) + + Exit Sub + +ErrHandler: + Call LogError("Error" & Err.Number & "(" & Err.Description & ") en Sub LoadFontDescription de Mod_TileEngine.bas") +End Sub + +Public Sub Draw(ByRef destination As wGL_Rectangle, ByRef source As wGL_Rectangle, ByVal Depth As Single, ByVal Angle As Single, ByVal color As Long, ByVal Graphic As Long, ByVal Alpha As Boolean) + + If (g_Material(Graphic) = 0) Then + g_Material(Graphic) = wGL_Graphic_Renderer.Create_Material + + Call wGL_Graphic_Renderer.Update_Material_Texture(g_Material(Graphic), &H0, wGL_Graphic.Create_Texture_From_Image(GetImageFromNum(Graphic))) + End If + + If (Alpha) Then + Call wGL_Graphic_Renderer.Draw(destination, source, Depth, Angle, color, g_Material(Graphic), g_Technique_2) + Else + Call wGL_Graphic_Renderer.Draw(destination, source, Depth, Angle, color, g_Material(Graphic), g_Technique_1) + End If + +End Sub + +Public Function GetCharacterDimension(ByVal CharIndex As Integer, ByRef RangeX As Single, ByRef RangeY As Single) + Dim i As Long + + Dim BestRange As Long + + With CharList(CharIndex) + + ' Try to calculate the best width and height using all four direction of the entity's body + If (.iBody <> 0) Then + For i = 1 To 4 + If (GrhData(.Body.Walk(i).grhIndex).TileWidth > RangeX) Then + RangeX = GrhData(.Body.Walk(i).grhIndex).TileWidth + End If + If (GrhData(.Body.Walk(i).grhIndex).TileHeight > RangeY) Then + RangeY = GrhData(.Body.Walk(i).grhIndex).TileHeight + End If + Next i + End If + + ' Try to calculate the best width and height using all four direction of the entity's body + If (.iHead <> 0) Then + + For i = 1 To 4 + If (GrhData(.Head.Head(i).grhIndex).TileWidth > RangeX) Then + RangeX = GrhData(.Head.Head(i).grhIndex).TileWidth + End If + Next i + For i = 1 To 4 + If (GrhData(.Head.Head(i).grhIndex).TileHeight > BestRange) Then + BestRange = GrhData(.Head.Head(i).grhIndex).TileHeight + End If + Next i + + RangeY = RangeY + BestRange + End If + + End With + + +End Function + +Public Function GetDepth(ByVal Layer As Single, Optional ByVal X As Single = 1, Optional ByVal Y As Single = 1, Optional ByVal Z As Single = 1) As Single + + GetDepth = -1# + (Layer * 0.1) + ((Y - 1) * 0.001) + ((X - 1) * 0.00001) + ((Z - 1) * 0.000001) + +End Function + +Public Function LoadBytes(ByVal FileName As String) As Byte() + + Open App.path + "\" + FileName For Binary Access Read Lock Read As #1 + + ReDim LoadBytes(LOF(1) - 1) + + Get #1, , LoadBytes + + Close #1 + +End Function + +Public Function ARGB(Red As Byte, Green As Byte, Blue As Byte, Alpha As Byte) As Long + If Alpha > 127 Then + ARGB = ((Alpha - 128) * &H1000000 Or &H80000000) Or Blue Or (Green * &H100&) Or (Red * &H10000) + Else + ARGB = (Alpha * &H1000000) Or Blue Or (Green * &H100&) Or (Red * &H10000) + End If +End Function + +Public Sub TempClearForm() + + Call wGL_Graphic.Use_Device(&H0) + Call wGL_Graphic.Clear(CLEAR_COLOR Or CLEAR_DEPTH Or CLEAR_STENCIL, &H0, 1#, 0) + +End Sub + +Public Sub SetTileBuffer(ByVal setWindowTileHeight As Integer, ByVal setWindowTileWidth As Integer) + WindowTileHeight = setWindowTileHeight + WindowTileWidth = setWindowTileWidth + + + HalfWindowTileHeight = setWindowTileHeight \ 2 + HalfWindowTileWidth = setWindowTileWidth \ 2 + + 'Compute offset in pixels when rendering tile buffer. + 'We diminish by one to get the top-left corner of the tile for rendering. + + MainViewWidth = TilePixelWidth * WindowTileWidth + MainViewHeight = TilePixelHeight * WindowTileHeight +End Sub + +Public Function InitTileEngine(ByVal setDisplayFormhWnd As Long, ByVal setMainViewTop As Integer, ByVal setMainViewLeft As Integer, ByVal setTilePixelHeight As Integer, ByVal setTilePixelWidth As Integer, ByVal setWindowTileHeight As Integer, ByVal setWindowTileWidth As Integer, ByVal setTileBufferSize As Integer, ByVal pixelsToScrollPerFrameX As Integer, pixelsToScrollPerFrameY As Integer, ByVal engineSpeed As Single) As Boolean +'*************************************************** +'Author: Aaron Perkins +'Last Modification: 08/14/07 +'Last modified by: Juan Martín Sotuyo Dodero (Maraxus) +'Creates all DX objects and configures the engine to start running. +'*************************************************** + Dim surfaceDesc As DDSURFACEDESC2 + Dim ddck As DDCOLORKEY + + 'Fill startup variables + MainViewTop = setMainViewTop + MainViewLeft = setMainViewLeft + TilePixelWidth = setTilePixelWidth + TilePixelHeight = setTilePixelHeight + WindowTileHeight = setWindowTileHeight + WindowTileWidth = setWindowTileWidth + TileBufferSize = setTileBufferSize + + HalfWindowTileHeight = setWindowTileHeight \ 2 + HalfWindowTileWidth = setWindowTileWidth \ 2 + + 'Compute offset in pixels when rendering tile buffer. + 'We diminish by one to get the top-left corner of the tile for rendering. + TileBufferPixelOffsetX = ((TileBufferSize - 1) * TilePixelWidth) + TileBufferPixelOffsetY = ((TileBufferSize - 1) * TilePixelHeight) + + engineBaseSpeed = engineSpeed + + 'Set FPS value to 60 for startup + FPS = 60 + FramesPerSecCounter = 60 + + MinXBorder = XMinMapSize + (ClienteWidth \ 2) + MaxXBorder = XMaxMapSize - (ClienteWidth \ 2) + MinYBorder = YMinMapSize + (ClienteHeight \ 2) + MaxYBorder = YMaxMapSize - (ClienteHeight \ 2) + + MainViewWidth = TilePixelWidth * WindowTileWidth + MainViewHeight = TilePixelHeight * WindowTileHeight + + 'Resize mapdata array + ReDim MapData(XMinMapSize To XMaxMapSize, YMinMapSize To YMaxMapSize) As MapBlock + + 'Set intial user position + UserPos.X = MinXBorder + UserPos.Y = MinYBorder + + 'Set scroll pixels per frame + ScrollPixelsPerFrameX = pixelsToScrollPerFrameX + ScrollPixelsPerFrameY = pixelsToScrollPerFrameY + + 'Set the view rect + With MainViewRect + .Left = MainViewLeft + .Top = MainViewTop + .Right = .Left + MainViewWidth + .Bottom = .Top + MainViewHeight + End With + + 'Set the dest rect + With MainDestRect + .Left = TilePixelWidth * TileBufferSize - TilePixelWidth + .Top = TilePixelHeight * TileBufferSize - TilePixelHeight + .Right = .Left + MainViewWidth + .Bottom = .Top + MainViewHeight + End With + +On Error Resume Next + Set DirectX = New DirectX7 + + If Err Then + MsgBox "No se puede iniciar DirectX. Por favor asegurese de tener la ultima version correctamente instalada." + Exit Function + End If + + + '****** INIT DirectDraw ****** + ' Create the root DirectDraw object + Set DirectDraw = DirectX.DirectDrawCreate("") + + If Err Then + MsgBox "No se puede iniciar DirectDraw. Por favor asegurese de tener la ultima version correctamente instalada." + Exit Function + End If + + + Dim Mode As Long + Mode = MODE_SYNCHRONISED 'MODE_SYNCHRONISED '0 'MODE_COMPATIBLE ' MODE_SYNCHRONISED MODE_COMPATIBLE + + If (wGL_Graphic.Create_Driver(DRIVER_DIRECT3D9, Mode, frmMain.picMain.hwnd, frmMain.picMain.ScaleWidth, frmMain.picMain.ScaleHeight)) = False Then + MsgBox "No se pudo encontrar d3d9.dll. Esto puede deberse a que tu sistema operativo no es compatible, o que alguna de las librerías no está correctamente instalada o actualizada. " _ + & "Contacta a Soporte para más información." + End + End If + + ' TEMPORALLY (New lib's version will remove all of this) + + g_Technique_1 = wGL_Graphic_Renderer.Create_Technique + Call wGL_Graphic_Renderer.Update_Technique_Program(g_Technique_1, wGL_Graphic.Create_Program(LoadBytes("Shader\Basic.vs"), LoadBytes("Shader\Basic-1.fs"))) + + Dim Descriptor As wGL_Graphic_Descriptor + Descriptor.Depth = COMPARISON_LESS_EQUAL + Descriptor.Depth_Mask = True + Descriptor.Mask_Red = True: Descriptor.Mask_Green = True: Descriptor.Mask_Blue = True: Descriptor.Mask_Alpha = True + Descriptor.Stencil_Mask = &HFF + Call wGL_Graphic_Renderer.Update_Technique_Descriptor(g_Technique_1, Descriptor) + + Dim Sampler As wGL_Graphic_Sampler + Sampler.Address_X = SAMPLER_ADDRESS_WRAP + Sampler.Address_Y = SAMPLER_ADDRESS_WRAP + + Call wGL_Graphic_Renderer.Update_Technique_Sampler(g_Technique_1, 0, Sampler) + + g_Technique_2 = wGL_Graphic_Renderer.Create_Technique + Call wGL_Graphic_Renderer.Update_Technique_Program(g_Technique_2, wGL_Graphic.Create_Program(LoadBytes("Shader\Basic.vs"), LoadBytes("Shader\Basic-2.fs"))) + Call wGL_Graphic_Renderer.Update_Technique_Sampler(g_Technique_2, 0, Sampler) + + Descriptor.Blend_Color_Source = BLEND_FACTOR_SRC_ALPHA + Descriptor.Blend_Color_Destination = BLEND_FACTOR_ONE_MINUS_SRC_ALPHA + Descriptor.Depth_Mask = False + Call wGL_Graphic_Renderer.Update_Technique_Descriptor(g_Technique_2, Descriptor) + + Dim Texture As Integer + Texture = wGL_Graphic.Create_Texture(FORMAT_BGRA8, frmMain.picMain.ScaleWidth, frmMain.picMain.ScaleHeight, &H0, True, True) + g_Post_Effect_Material = wGL_Graphic_Renderer.Create_Material + Call wGL_Graphic_Renderer.Update_Material_Texture(g_Post_Effect_Material, 0, Texture) + + g_Post_Effect_Device = wGL_Graphic.Create_Device(Texture, 0, 0, 0, wGL_Graphic.Create_Texture(FORMAT_D24S8, frmMain.picMain.ScaleWidth, frmMain.picMain.ScaleHeight, 0, False, True)) + + g_Post_Effect_Technique = wGL_Graphic_Renderer.Create_Technique + Call wGL_Graphic_Renderer.Update_Technique_Program(g_Post_Effect_Technique, wGL_Graphic.Create_Program(LoadBytes("Shader\Effect.vs"), LoadBytes("Shader\Effect.fs"))) + + g_Rain_Material = wGL_Graphic_Renderer.Create_Material + Call wGL_Graphic_Renderer.Update_Material_Texture(g_Rain_Material, 0, wGL_Graphic.Create_Texture_From_Image(GetImageFromNum(15168))) + + Call LoadFontDescription + 'Load graphic data into memory + modIndices.CargarIndicesDeGraficos + + frmCargando.X.Caption = "Iniciando Control de Superficies..." + + 'Wave Sound + Set DirectSound = DirectX.DirectSoundCreate("") + DirectSound.SetCooperativeLevel setDisplayFormhWnd, DSSCL_PRIORITY + LastSoundBufferUsed = 1 + Call modPrimitives.InitPrimitivesModule + InitTileEngine = True + Call TempClearForm +End Function +Public Sub ShowNextFrame(ByVal DisplayFormTop As Integer, ByVal DisplayFormLeft As Integer, ByVal MouseViewX As Integer, ByVal MouseViewY As Integer) +'*************************************************** +'Author: Arron Perkins +'Last Modification: 08/14/07 +'Last modified by: Juan Martín Sotuyo Dodero (Maraxus) +'Updates the game's model and renders everything. +'*************************************************** + Static OffsetCounterX As Single + Static OffsetCounterY As Single + + '****** Set main view rectangle ****** + MainViewRect.Left = (DisplayFormLeft / Screen.TwipsPerPixelX) + MainViewLeft + MainViewRect.Top = (DisplayFormTop / Screen.TwipsPerPixelY) + MainViewTop + MainViewRect.Right = MainViewRect.Left + MainViewWidth + MainViewRect.Bottom = MainViewRect.Top + MainViewHeight + + If UserMoving Then + '****** Move screen Left and Right if needed ****** + If AddtoUserPos.X <> 0 Then + OffsetCounterX = OffsetCounterX - ScrollPixelsPerFrameX * AddtoUserPos.X * timerTicksPerFrame + If Abs(OffsetCounterX) >= Abs(TilePixelWidth * AddtoUserPos.X) Then + OffsetCounterX = 0 + AddtoUserPos.X = 0 + UserMoving = False + End If + End If + + '****** Move screen Up and Down if needed ****** + If AddtoUserPos.Y <> 0 Then + OffsetCounterY = OffsetCounterY - ScrollPixelsPerFrameY * AddtoUserPos.Y * timerTicksPerFrame + If Abs(OffsetCounterY) >= Abs(TilePixelHeight * AddtoUserPos.Y) Then + OffsetCounterY = 0 + AddtoUserPos.Y = 0 + UserMoving = False + End If + End If + End If + + Call wGL_Graphic.Use_Device(&H0) + Call wGL_Graphic_Renderer.Update_Projection(&H0, frmMain.picMain.ScaleWidth, frmMain.picMain.ScaleHeight) + + g_Post_Effect_Uniform.Effect.X = 0 + + + Call wGL_Graphic.Use_Uniform(&H0, False, g_Post_Effect_Uniform, 1) + + Dim destination As wGL_Rectangle, source As wGL_Rectangle + destination.X1 = 0#: destination.X2 = frmMain.picMain.ScaleWidth: destination.Y1 = 0#: destination.Y2 = frmMain.picMain.ScaleHeight + source.X1 = 0#: source.X2 = 1#: source.Y1 = 0#: source.Y2 = 1# + Call wGL_Graphic_Renderer.Draw(destination, source, 0#, 0#, -1, g_Post_Effect_Material, g_Post_Effect_Technique) + + Call wGL_Graphic_Renderer.Flush + + '****** Update screen ****** + If MapaCargado Then + Call wGL_Graphic.Use_Device(g_Post_Effect_Device) + Call wGL_Graphic.Clear(CLEAR_COLOR Or CLEAR_DEPTH Or CLEAR_STENCIL, &H0, 1#, 0) + Call wGL_Graphic_Renderer.Update_Projection(&H0, frmMain.picMain.ScaleWidth, frmMain.picMain.ScaleHeight) + Call RenderScreen(UserPos.X - AddtoUserPos.X, UserPos.Y - AddtoUserPos.Y, OffsetCounterX, OffsetCounterY) + Call wGL_Graphic_Renderer.Flush + End If + 'Call Dialogos.Render + + 'Call DialogosClanes.Draw(FuentesJuego.Guild) + 'Call DibujarCartel + + 'If (bRain And bLluvia(UserMap)) Then + 'Call DrawRain + 'End If + + + Call wGL_Graphic.Commit + + 'Get timing info + + Dim Elapsed As Currency + Elapsed = GetElapsedTime() + timerTicksPerFrame = Elapsed * ENGINE_SPEED + timerEngine = timerEngine + Elapsed +End Sub + +Public Sub RenderScreen(ByVal TileX As Integer, ByVal TileY As Integer, ByVal OffsetX As Integer, ByVal OffsetY As Integer) + Dim ScreenMinY As Integer 'Start Y pos on current screen + Dim ScreenMaxY As Integer 'End Y pos on current screen + Dim ScreenMinX As Integer 'Start X pos on current screen + Dim ScreenMaxX As Integer 'End X pos on current screen + Dim MinY As Integer 'Start Y pos on current map + Dim MaxY As Integer 'End Y pos on current map + Dim MinX As Integer 'Start X pos on current map + Dim MaxX As Integer 'End X pos on current map + Dim X As Integer + Dim Y As Integer + Dim Drawable As Integer + Dim DrawableX As Integer + Dim DrawableY As Integer + + 'Calculate ceiling alpha + Dim Alpha As Long + Alpha = IIf(bTecho, &H60FFFFFF, -1) + + 'Figure out Ends and Starts of screen + ScreenMinY = TileY - HalfWindowTileHeight + ScreenMaxY = TileY + HalfWindowTileHeight + ScreenMinX = TileX - HalfWindowTileWidth + ScreenMaxX = TileX + HalfWindowTileWidth + + 'Figure out Ends and Starts of map + MinY = ScreenMinY + MaxY = ScreenMaxY + MinX = ScreenMinX + MaxX = ScreenMaxX + + If OffsetY < 0 Then + MaxY = MaxY + 1 + ElseIf OffsetY > 0 Then + MinY = MinY - 1 + End If + If OffsetX < 0 Then + MaxX = MaxX + 1 + ElseIf OffsetX > 0 Then + MinX = MinX - 1 + End If + + If MinY < YMinMapSize Then MinY = YMinMapSize + If MaxY > YMaxMapSize Then MaxY = YMaxMapSize + If MinX < XMinMapSize Then MinX = XMinMapSize + If MaxX > XMaxMapSize Then MaxX = XMaxMapSize + + For Y = MinY To MaxY + DrawableY = (Y - ScreenMinY) * TilePixelHeight + OffsetY + For X = MinX To MaxX + DrawableX = (X - ScreenMinX) * TilePixelWidth + OffsetX + Call DrawGrh(MapData(X, Y).Graphic(1), DrawableX, DrawableY, GetDepth(1, X, Y), 0, 1) + Next X + Next Y + + DrawableY = (SobreY - ScreenMinY) * TilePixelHeight + OffsetY + DrawableX = (SobreX - ScreenMinX) * TilePixelWidth + OffsetX + + If bSelectSup Then + + If MosaicoChecked Then + Call DrawGrh(CurrentGrh(((X + DespX) Mod mAncho) + 1, ((Y + DespY) Mod MAlto) + 1), DrawableX, DrawableY, GetDepth(CurLayer + 1, X, Y), 0, 1) + Else + Call DrawGrh(CurrentGrh(0), DrawableX, DrawableY, GetDepth(CurLayer + 1, X, Y), 0, 1) + End If + End If + If bCursor Then + Call modPrimitives.DrawBox(DrawableX, DrawableY, DrawableX + 32, DrawableY + 32, &H60FFFFFF) + End If + + Dim Results() As wGL_Swarm_Result + Call g_Swarm.Query(MinX, MinY, MaxX, MaxY, Results) + + For Drawable = 0 To UBound(Results) + With Results(Drawable) + + DrawableX = (.X - ScreenMinX) * TilePixelWidth + OffsetX + DrawableY = (.Y - ScreenMinY) * TilePixelHeight + OffsetY + + Select Case (.Layer) + Case 1 + If bVerCapa(2) Then + Call DrawGrh(MapData(.X, .Y).Graphic(2), DrawableX, DrawableY, GetDepth(2, .X, .Y), 1, 1) + End If + Case 2 + If bVerCapa(3) Then + Call DrawGrh(MapData(.X, .Y).Graphic(3), DrawableX, DrawableY, GetDepth(3, .X, .Y, 2), 1, 1, , , , True) + End If + Case 3 + If bVerCapa(4) Then + Call DrawGrh(MapData(.X, .Y).Graphic(4), DrawableX, DrawableY, GetDepth(4, .X, .Y), 1, 1) + End If + Case 4 + If bVerObjetos Then + Call DrawGrh(MapData(.X, .Y).ObjGrh, DrawableX, DrawableY, GetDepth(3, .X, .Y, 1), 1, 1, , , , True) + End If + Case 5 + If bVerNpcs Then + Call CharRender(MapData(.X, .Y).CharIndex, DrawableX, DrawableY) + End If + Case modEdicion.BLOCK_LAYER + If bBloqs Then + Call DrawGrhIndex(modEdicion.BlockGrhIndex, DrawableX, DrawableY, GetDepth(modEdicion.BLOCK_LAYER, .X, .Y, 1), True) + End If + Case modEdicion.EXIT_LAYER + If bTranslados Then + Call DrawGrhIndex(modEdicion.ExitGrhIndex, DrawableX, DrawableY, GetDepth(modEdicion.EXIT_LAYER, .X, .Y, 1), True) + End If + Case modEdicion.TRIGGER_LAYER + If bTriggers Then + Call Draw_Text(FuentesJuego.Talk.id, FuentesJuego.Talk.Tamanio, DrawableX + 16, DrawableY + 16, GetDepth(modEdicion.TRIGGER_LAYER, .X, .Y, 1), FuentesJuego.Talk.color, FONT_ALIGNMENT_MIDDLE Or FONT_ALIGNMENT_CENTER, CStr(MapData(.X, .Y).Trigger)) + End If + End Select + End With + Next Drawable + +End Sub + +Public Sub RenderFullMap() + Dim ScreenMinY As Integer 'Start Y pos on current screen + Dim ScreenMaxY As Integer 'End Y pos on current screen + Dim ScreenMinX As Integer 'Start X pos on current screen + Dim ScreenMaxX As Integer 'End X pos on current screen + Dim MinY As Integer 'Start Y pos on current map + Dim MaxY As Integer 'End Y pos on current map + Dim MinX As Integer 'Start X pos on current map + Dim MaxX As Integer 'End X pos on current map + Dim X As Integer + Dim Y As Integer + Dim Drawable As Integer + Dim DrawableX As Integer + Dim DrawableY As Integer + + 'Calculate ceiling alpha + Dim Alpha As Long + Alpha = IIf(bTecho, &H60FFFFFF, -1) + + + MinY = YMinMapSize + MaxY = YMaxMapSize + MinX = XMinMapSize + MaxX = XMaxMapSize + + For Y = MinY To MaxY + DrawableY = (Y * TilePixelHeight) - 32 + For X = MinX To MaxX + DrawableX = (X * TilePixelWidth) - 32 + Call DrawGrh(MapData(X, Y).Graphic(1), DrawableX, DrawableY, GetDepth(1, X, Y), 0, 1) + Next X + Next Y + + Dim Results() As wGL_Swarm_Result + Call g_Swarm.Query(MinX, MinY, MaxX, MaxY, Results) + + For Drawable = 0 To UBound(Results) + With Results(Drawable) + + DrawableX = .X * TilePixelWidth - 32 + DrawableY = .Y * TilePixelHeight - 32 + + Select Case (.Layer) + Case 1 + Call DrawGrh(MapData(.X, .Y).Graphic(2), DrawableX, DrawableY, GetDepth(2, .X, .Y), 1, 1) + Case 2 + Call DrawGrh(MapData(.X, .Y).Graphic(3), DrawableX, DrawableY, GetDepth(3, .X, .Y, 2), 1, 1, , , , True) + Case 3 + Call DrawGrh(MapData(.X, .Y).Graphic(4), DrawableX, DrawableY, GetDepth(4, .X, .Y), 1, 1) + Case 4 + Call DrawGrh(MapData(.X, .Y).ObjGrh, DrawableX, DrawableY, GetDepth(3, .X, .Y, 1), 1, 1, , , , True) + Case 5 + Call CharRender(MapData(.X, .Y).CharIndex, DrawableX, DrawableY) + End Select + End With + Next Drawable +End Sub + + +Public Sub CharRender(ByVal CharIndex As Long, ByVal PixelOffsetX As Single, ByVal PixelOffsetY As Single) +'*************************************************** +'Author: Juan Martín Sotuyo Dodero (Maraxus) +'Last Modify Date: 25/05/2011 (Amraphen) +'Draw char's to screen without offcentering them +'16/09/2010: ZaMa - Ya no se dibujan los bodies cuando estan invisibles. +'25/05/2011: Amraphen - Agregado movimiento de armas al golpear. +'*************************************************** +On Error GoTo ErrHandler + + Dim moved As Boolean + Dim attacked As Boolean + Dim Pos As Integer + Dim line As String + Dim color As Long + Dim i As Byte + Dim LastIndex As Byte + Dim TextOffsetY As Integer + + With CharList(CharIndex) + If .Moving Then + 'If needed, move left and right + If .scrollDirectionX <> 0 Then + .MoveOffsetX = .MoveOffsetX + ScrollPixelsPerFrameX * Sgn(.scrollDirectionX) * timerTicksPerFrame + + 'Char moved + moved = True + + 'Check if we already got there + If (Sgn(.scrollDirectionX) = 1 And .MoveOffsetX >= 0) Or (Sgn(.scrollDirectionX) = -1 And .MoveOffsetX <= 0) Then + .MoveOffsetX = 0 + .scrollDirectionX = 0 + End If + End If + + 'If needed, move up and down + If .scrollDirectionY <> 0 Then + .MoveOffsetY = .MoveOffsetY + ScrollPixelsPerFrameY * Sgn(.scrollDirectionY) * timerTicksPerFrame + + 'Char moved + moved = True + + 'Check if we already got there + If (Sgn(.scrollDirectionY) = 1 And .MoveOffsetY >= 0) Or (Sgn(.scrollDirectionY) = -1 And .MoveOffsetY <= 0) Then + .MoveOffsetY = 0 + .scrollDirectionY = 0 + End If + End If + End If + + + attacked = False + + 'If done moving stop animation + If Not moved Then + .Body.Walk(.Heading).Started = 0 + + .Moving = False + End If + + PixelOffsetX = PixelOffsetX + .MoveOffsetX + PixelOffsetY = PixelOffsetY + .MoveOffsetY + + 'Draw Body + If .Body.Walk(.Heading).grhIndex Then _ + Call DrawGrh(.Body.Walk(.Heading), PixelOffsetX, PixelOffsetY, GetDepth(3, .Pos.X, .Pos.Y, 2), 1, 1, , 0, , True) + + 'Draw Head + If .Head.Head(.Heading).grhIndex > 0 Then + If .Head.Head(.Heading).grhIndex Then + Call DrawGrh(.Head.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X, PixelOffsetY + .Body.HeadOffset.Y, GetDepth(3, .Pos.X, .Pos.Y, 3), 1, 0, , , , True) + End If + End If + + ' Set chat text offsets + 'TextOffsetY = GetChatOverheadTextOffset(CharIndex, PixelOffsetY, TilePixelHeight) + + 'Update dialogs + 'Call Dialogos.UpdateDialogPos(PixelOffsetX + TilePixelWidth \ 2, TextOffsetY, 0#, CharIndex) + + End With + + Exit Sub + +ErrHandler: + Call LogError("Error" & Err.Number & "(" & Err.Description & ") en Sub CharRender de TileEngine.bas") +End Sub + +Public Sub DrawGrh(ByRef Grh As Grh, ByVal X As Integer, ByVal Y As Integer, ByVal Z As Single, ByVal Center As Byte, ByVal Animate As Byte, Optional ByVal color As Long = -1, Optional ByVal killAtEnd As Byte = 1, Optional ByVal Angle As Integer = 0, Optional ByVal Alpha As Boolean = False) +'***************************************************************** +'Draws a GRH transparently to a X and Y position +'***************************************************************** + Dim CurrentGrhIndex As Integer + Dim CurrentFrame As Integer + + If Animate Then + If Grh.Started = 1 Then + CurrentFrame = ((timerEngine - Grh.FrameCounter) * GrhData(Grh.grhIndex).NumFrames / Grh.Speed) + + If CurrentFrame > GrhData(Grh.grhIndex).NumFrames Then + CurrentFrame = (CurrentFrame Mod GrhData(Grh.grhIndex).NumFrames) + 1 + + If Grh.Loops <> INFINITE_LOOPS Then + If Grh.Loops > 0 Then + Grh.Loops = Grh.Loops - 1 + Else + Grh.Started = 0 + If killAtEnd Then Exit Sub + End If + Else + Grh.FrameCounter = timerEngine + End If + End If + End If + End If + If (CurrentFrame = 0) Then CurrentFrame = 1 + + 'Figure out what frame to draw (always 1 if not animated) + CurrentGrhIndex = GrhData(Grh.grhIndex).Frames(CurrentFrame) + + With GrhData(CurrentGrhIndex) + 'Center Grh over X,Y pos + If Center Then + If .TileWidth <> 1 Then + X = X - Int(.TileWidth * TilePixelWidth / 2) + TilePixelWidth \ 2 + End If + + If .TileHeight <> 1 Then + Y = Y - Int(.TileHeight * TilePixelHeight) + TilePixelHeight + End If + End If + + Dim source As wGL_Rectangle, destination As wGL_Rectangle + + source.X1 = .S0 + source.Y1 = .T0 + source.X2 = .S1 + source.Y2 = .T1 + destination.X1 = X + destination.Y1 = Y + destination.X2 = X + .pixelWidth + destination.Y2 = Y + .pixelHeight + + Call Draw(destination, source, Z, Angle, color, .fileNum, Alpha) + + End With + +End Sub +Public Sub DrawGrhIndexWithLimit(ByVal grhIndex As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal Z As Single, ByVal maxWidth As Integer, ByVal maxHeight As Integer) + + With GrhData(grhIndex) + + Dim source As wGL_Rectangle, destination As wGL_Rectangle + + source.X1 = .S0 + source.Y1 = .T0 + source.X2 = .S1 + source.Y2 = .T1 + destination.X1 = X + destination.Y1 = Y + destination.X2 = X + IIf(.pixelWidth > maxWidth, maxWidth, .pixelWidth) + destination.Y2 = Y + IIf(.pixelHeight > maxHeight, maxHeight, .pixelHeight) + + Call Draw(destination, source, Z, 0, -1#, .fileNum, False) + + End With + +End Sub +Sub DrawGrhIndex(ByVal grhIndex As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal Z As Single, ByVal Center As Byte, Optional ByVal color As Long = -1, Optional ByVal Angle As Integer = 0) + + With GrhData(grhIndex) + 'Center Grh over X,Y pos + If Center Then + If .TileWidth <> 1 Then + X = X - Int(.TileWidth * TilePixelWidth / 2) + TilePixelWidth \ 2 + End If + + If .TileHeight <> 1 Then + Y = Y - Int(.TileHeight * TilePixelHeight) + TilePixelHeight + End If + End If + + Dim source As wGL_Rectangle, destination As wGL_Rectangle + + source.X1 = .S0 + source.Y1 = .T0 + source.X2 = .S1 + source.Y2 = .T1 + destination.X1 = X + destination.Y1 = Y + destination.X2 = X + .pixelWidth + destination.Y2 = Y + .pixelHeight + + Call Draw(destination, source, Z, Angle, color, .fileNum, False) + + End With + +End Sub diff --git a/Shader/Basic-1.fs b/Shader/Basic-1.fs new file mode 100644 index 0000000..db97282 Binary files /dev/null and b/Shader/Basic-1.fs differ diff --git a/Shader/Basic-2.fs b/Shader/Basic-2.fs new file mode 100644 index 0000000..e49340e Binary files /dev/null and b/Shader/Basic-2.fs differ diff --git a/Shader/Basic.vs b/Shader/Basic.vs new file mode 100644 index 0000000..e74f5dd Binary files /dev/null and b/Shader/Basic.vs differ diff --git a/Shader/Effect.fs b/Shader/Effect.fs new file mode 100644 index 0000000..36d273e Binary files /dev/null and b/Shader/Effect.fs differ diff --git a/Shader/Effect.vs b/Shader/Effect.vs new file mode 100644 index 0000000..e74f5dd Binary files /dev/null and b/Shader/Effect.vs differ diff --git a/Shader/Shader1.fs b/Shader/Shader1.fs new file mode 100644 index 0000000..0953161 Binary files /dev/null and b/Shader/Shader1.fs differ diff --git a/WorldEditor.example.ini b/WorldEditor.example.ini new file mode 100644 index 0000000..e39f95f --- /dev/null +++ b/WorldEditor.example.ini @@ -0,0 +1,44 @@ +[PATH] +UltimoMapa=\maps\Mapa1.map +DirGraficos=C:\ao\we\graphics\ +DirMidi=C:\ao\we\midi\ +DirIndex=C:\ao\we\inits\ +DirDats=C:\ao\we\dats\ +DirMp3=C:\ao\we\mp3\ + +[CONFIGURACION] +ObjTranslado=378 +GuardarConfig=1 +AutoCapturarTrans=1 +AutoCapturarSup=0 +UtilizarDeshacer=1 + +[MOSTRAR] +LastPos=63-63 +ControlAutomatico=1 +Capa2=1 +Capa3=1 +Capa4=0 +Grilla=0 +Triggers=0 +Bloqueos=1 +Translados=0 +Objetos=1 +NPCs=1 +'Calcula la pantalla dependiendo de la resolucion +AutoPantalla=0 +'---------------------- +PantallaX=19 +PantallaY=21 +'---------------------- +' AYUDA: +' en 800x600 se usa X = 14 y Y = 16 +' en 1024x768 se usa X = 19 y Y = 21. +'---------------------- +' el valor minimo es 3 en ambos. +' el valor maximo en X es 23 y en Y es 32. +'---------------------- + +ClienteHeight=50 +ClienteWidth=50 +' Configuracion grafica del cliente necesaria para detectar los bordes legales del mapa. diff --git a/WorldEditor.vbp b/WorldEditor.vbp index d9decb3..2758207 100644 --- a/WorldEditor.vbp +++ b/WorldEditor.vbp @@ -1,10 +1,12 @@ Type=Exe -Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation -Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#C:\WINDOWS\SysWow64\dx7vb.dll#DirectX 7 for Visual Basic Type Library -Reference=*\G{00000200-0000-0010-8000-00AA006D2EA4}#2.0#0#C:\Program Files (x86)\Common Files\System\ado\msado20.tlb#Microsoft ActiveX Data Objects 2.0 Library -Reference=*\G{6B263850-900B-11D0-9484-00A0C91110ED}#1.0#0#C:\Windows\SysWow64\MSSTDFMT.DLL#Microsoft Data Formatting Object Library 6.0 (SP6) -Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.OCX -Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0; mscomctl.ocx +Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation +Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#..\..\..\..\..\..\..\Windows\SysWow64\dx7vb.dll#DirectX 7 for Visual Basic Type Library +Reference=*\G{00000200-0000-0010-8000-00AA006D2EA4}#2.0#0#..\..\..\..\..\..\..\Program Files (x86)\Common Files\System\ado\msado20.tlb#Microsoft ActiveX Data Objects 2.0 Library +Reference=*\G{6B263850-900B-11D0-9484-00A0C91110ED}#1.0#0#..\..\..\..\..\..\..\Windows\SysWow64\MSSTDFMT.DLL#Microsoft Data Formatting Object Library 6.0 (SP6) +Reference=*\G{2D240C7D-F21E-4BF0-AF9B-3ED14E903AD6}#1.0#0#..\..\client-vb6\Aurora.Multimedia.dll#Aurora.Multimedia - Aurora Engine - Multimedia +Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX +Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.ocx +Object={97FD4A65-A045-4F5C-8C6C-262505F7C013}#6.0#0; Argentum.ocx Form=Codigo\frmMain.frm Module=modGeneral; Codigo\modGeneral.bas Module=modDeclaraciones; Codigo\modDeclaraciones.bas @@ -26,9 +28,6 @@ UserControl=Codigo\LaVolpe Button\lvButtons.ctl Module=modIndices; Codigo\modIndices.bas Module=modLvTimer; Codigo\LaVolpe Button\modLvTimer.bas Class=clsIniReader; Codigo\clsIniReader.cls -Class=clsSurfaceManDyn; Codigo\clsSurfaceManDyn.cls -Class=clsSurfaceManager; Codigo\clsSurfaceManager.cls -Class=clsSurfaceManStatic; Codigo\clsSurfaceManStatic.cls Form=Codigo\frmAbout.frm Form=Codigo\frmOptimizar.frm Module=modCompression; Codigo\modCompression.bas @@ -42,6 +41,14 @@ Form=Codigo\frmRenderAll.frm Form=Codigo\frmOrgEditor.frm Module=modGdiPlusResizer; Codigo\modGdiPlusResizer.bas Form=Codigo\frmFKEditor.frm +Module=modTileEngine; Codigo\modTileEngine.bas +Class=clsInterval; Codigo\clsInterval.cls +Module=modPrimitives; Codigo\modPrimitives.bas +Form=Codigo\frmPalett.frm +Form=Codigo\frmErrors.frm +Form=Codigo\frmResultados.frm +Class=clsMapExport; Codigo\clsMapExport.cls +UserControl=Codigo\UcRenderOptions.ctl IconForm="frmMain" Startup="Sub Main" HelpFile="" @@ -54,18 +61,18 @@ Description="WorldEditor" CompatibleMode="0" MajorVer=3 MinorVer=5 -RevisionVer=2 +RevisionVer=108 AutoIncrementVer=1 ServerSupportFiles=0 VersionCompanyName="Argentum Online" VersionLegalCopyright="Programado por ^[GS]^" CompilationType=0 OptimizationType=0 -FavorPentiumPro(tm)=-1 +FavorPentiumPro(tm)=0 CodeViewDebugInfo=0 -NoAliasing=0 -BoundsCheck=-1 -OverflowCheck=-1 +NoAliasing=-1 +BoundsCheck=0 +OverflowCheck=0 FlPointCheck=-1 FDIVCheck=-1 UnroundedFP=-1 @@ -78,3 +85,6 @@ DebugStartupOption=0 [MS Transaction Server] AutoRefresh=1 + +[Rubberduck] +ProjectId=1cc0ce32-c63b-4893-b634-0e90db8f820d diff --git a/wGL_Client.dll b/wGL_Client.dll new file mode 100644 index 0000000..07d4c13 Binary files /dev/null and b/wGL_Client.dll differ