frmmain.frm

RPG maker vb源文件 RPG maker vb源文件

Next i
'==========================================================================
CurrentLayer = 1  '一开始打开软件时，地图的层次为1
End Sub

'把地图保存为图片
Private Sub SaveMapPicture()
With Com
    .InitDir = App.Path                         '弹出窗口的类型
    .DialogTitle = "地图保存为图片"             '窗口信息
    .DefaultExt = "*.bmp"                       '保存图片的格式→这是保存时保存的信息
    .Filter = "小熊猫提醒你！保存为BMP格式"     '保存图片的格式→这是保存窗口显示的信息
    .Filename = ""                              '保存文件的名字
    .ShowSave                                   '保存窗口出现的指令
    If .Filename = "" Then Exit Sub             '如果保存完毕
    DrawLayer (1), False                        '图层1按钮为假
    DrawLayer (2), False                        '图层2按钮为假
    DrawLayer (3), False                        '图层3按钮为假
    DrawLayer (4), False                        '图层4按钮为假
    SavePicture PicMap.Image, .Filename         '进行保存
End With                                        '关闭窗口
End Sub

'打开地图图片文件
Private Sub Mnu_LoadTileset_Click()
With Com
    .InitDir = App.Path                         '窗口类型
    .Filename = ""                              '打开文件的名字
    .DialogTitle = "打开地图图片文件"           '窗口标题信息
    .DefaultExt = "*.bmp"                       '打开格式为BMP的文件
    .Filter = "小熊猫提醒你！打开格式为BMP的文件"
    .ShowOpen                                   '打开窗口出现的指令
    If .Filename = "" Then Exit Sub             '如果打开完毕执行下面的代码
    PicTileset.Picture = LoadPicture(App.Path & "\Tilesets\" & .FileTitle)  '地图图片显示的地方显示刚才加载的图片
    CurrentTilesetFile = .FileTitle             '进行显示
End With                                        '关闭窗口

ScrTileset.Max = (PicTileset.Height / 32) - 20   '滚动条的最大值
If ScrTileset.Max <= 0 Then ScrTileset.Enabled = False Else ScrTileset.Enabled = True
'如果滚动条的最大值小于或者等于0时，滚动条功能关闭，否则功能就开启.
End Sub

'打开地图文件
Private Sub Mnu_Open_Click()
With Com
    .InitDir = App.Path                           '窗口类型
    .Filename = ""                                '打开文件的名字
    .DialogTitle = "打开地图文件"                 '窗口标题信息
    .DefaultExt = "*.map"                         '打开文件的类型
    .Filter = "小熊猫提醒你！打开格式为MAP的文件"    '显示信息
    .ShowOpen                                      '启动窗口
    If .Filename = "" Then Exit Sub                '如果打开地图后
    LoadLevel (.Filename)                          '自动加载地图名字和地图
End With                                           '关闭窗口
End Sub

'保存地图文件
Private Sub Mnu_Save_Click()
With Com
    .InitDir = App.Path                        '窗口的类型
    .DialogTitle = "保存地图文件"              '窗口标题信息
    .DefaultExt = "*.map"                      '保存文件的类型
    .Filename = ""                             '保存文件的名字
    .Filter = "小熊猫提醒你！保存格式为MAP的文件"  '保存窗口的信息
    .ShowSave                                  '进行保存
    If .Filename = "" Then Exit Sub           '如果保存成功
    SaveLevel (.Filename)                     '就自动保存地图名字和地图
End With                                      '关闭窗口
End Sub


Private Sub Mnu_SavePicture_Click()
SaveMapPicture                  '保存地图图片
End Sub

'画地图的那个控件的代码
Private Sub PicMap_Click()
On Error Resume Next
'===========定义坐标等地图相关的信息=================
Dim X As Integer, Y As Integer
Dim SelectedTile As TilePos
Dim CurrentTile As TilePos
'====================================================
'=====================地图坐标计算===================
If ToolBar.Buttons(13).Value = tbrPressed Then
    If ShpBig.Width = 32 And ShpBig.Height = 32 Then
            CurrentTile.X = ShpBig.Left / 32
            CurrentTile.Y = ShpBig.Top / 32

            For Y = 0 To SldSize.Value - 1
                For X = 0 To SldSize.Value - 1
                    SelectedTile.X = ShpPlace.Left / 32 + X + 1
                    SelectedTile.Y = ShpPlace.Top / 32 + Y + 1
                    PaintOneTile CurrentTile, SelectedTile
                Next X
            Next Y
    End If
Else
    If ShpBig.Width = 32 And ShpBig.Height = 32 Then
        SelectedTile.X = ShpPlace.Left / 32 + 1
        SelectedTile.Y = ShpPlace.Top / 32 + 1
        CurrentTile.X = ShpBig.Left / 32
        CurrentTile.Y = ShpBig.Top / 32
        PaintOneTile CurrentTile, SelectedTile
    Else
        For Y = 0 To ShpBig.Height / 32 - 1
            For X = 0 To ShpBig.Width / 32 - 1
                CurrentTile.X = ShpBig.Left / 32 + X
                CurrentTile.Y = ShpBig.Top / 32 + Y

                SelectedTile.X = ShpPlace.Left / 32 + X + 1
                SelectedTile.Y = ShpPlace.Top / 32 + Y + 1
                PaintOneTile CurrentTile, SelectedTile
            Next X
        Next Y
    End If
End If
'==========================================================
'===================启动地图编辑===========================
PicMap.Refresh
'==========================================================
End Sub

Private Sub DrawLayer(LayerIndex As Integer, Optional CleanUp As Boolean = True)
Dim X As Integer, Y As Integer
Dim CurrentSelectedTile As TilePos
Dim CurrentPaintTile As TilePos
'===============↑定义变量相关的信息==============
If CleanUp = True Then PicMap.Cls   '如果CleanUp是真的话就自动清理地图
'===============================坐标相关信息==================
For Y = 1 To MapHeight
    For X = 1 To MapWidth
        CurrentPaintTile.X = Layer(LayerIndex).TileCoordinates(X, Y).X
        CurrentPaintTile.Y = Layer(LayerIndex).TileCoordinates(X, Y).Y
        CurrentSelectedTile.X = X
        CurrentSelectedTile.Y = Y
        PaintOneTile CurrentPaintTile, CurrentSelectedTile, False
    Next X
Next Y
'=============================================================
PicMap.Refresh      '==============启动地图编辑===============
'=============================================================
End Sub

'Paint one tile at the moment
Private Sub PaintOneTile(PaintTile As TilePos, Tile As TilePos, Optional Save As Boolean = True)
If Save = True Then     '这是保存相关的信息
    Layer(CurrentLayer).TileCoordinates(Tile.X, Tile.Y).X = PaintTile.X
    Layer(CurrentLayer).TileCoordinates(Tile.X, Tile.Y).Y = PaintTile.Y
    If ToolBar.Buttons(22).Value = tbrPressed Then
        Layer(CurrentLayer).TileCoordinates(Tile.X, Tile.Y).IsAnObject = True
    Else
        Layer(CurrentLayer).TileCoordinates(Tile.X, Tile.Y).IsAnObject = False
    End If
End If

TransparentBlt PicMap.HDC, Tile.X * 32 - 32, Tile.Y * 32 - 32, 32, 32, PicTileset.HDC, PaintTile.X * 32, PaintTile.Y * 32, 32, 32, RGB(84, 138, 150)
End Sub

'Map mouse movement
Private Sub PicMap_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then PicMap_Click

ShpPlace.Left = Split((X / 32), ",")(0) * 32
ShpPlace.Top = Split((Y / 32), ",")(0) * 32
End Sub

'Tileset mouse down
Private Sub PicTileset_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseDownTile.X = Split((X / 32), ",")(0)
MouseDownTile.Y = Split((Y / 32), ",")(0)
End Sub

'Tileset mouse movement
Private Sub PicTileset_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ShpTile.Left = Split((X / 32), ",")(0) * 32
ShpTile.Top = Split((Y / 32), ",")(0) * 32
End Sub

'Tileset mouse up
Private Sub PicTileset_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseUpTile.X = Split((X / 32), ",")(0)
MouseUpTile.Y = Split((Y / 32), ",")(0)

    ToolBar.Buttons(12).Value = tbrPressed
    ToolBar.Buttons(13).Value = tbrUnpressed
    SldSize.Value = 1
    SldSize.Enabled = False

If MouseUpTile.X >= MouseDownTile.X Then
ShpBig.Width = (MouseUpTile.X - MouseDownTile.X + 1) * 32
ShpBig.Left = MouseDownTile.X * 32
End If
If MouseUpTile.X <= MouseDownTile.X Then
ShpBig.Width = (MouseDownTile.X - MouseUpTile.X + 1) * 32
ShpBig.Left = MouseUpTile.X * 32
End If
If MouseUpTile.Y >= MouseDownTile.Y Then
ShpBig.Height = (MouseUpTile.Y - MouseDownTile.Y + 1) * 32
ShpBig.Top = MouseDownTile.Y * 32
End If
If MouseUpTile.Y <= MouseDownTile.Y Then
ShpBig.Height = (MouseDownTile.Y - MouseUpTile.Y + 1) * 32
ShpBig.Top = MouseUpTile.Y * 32
End If

ShpPlace.Width = ShpBig.Width
ShpPlace.Height = ShpBig.Height
End Sub

'Map scroll
Private Sub ScrHMap_Change()
PicMap.Left = 272 - ScrHMap.Value * 32      '拉动滚动条时地图的LEFT位置
End Sub

'Tileset scroll
Private Sub ScrTileset_Change()
PicTileset.Top = 192 - ScrTileset.Value * 32  '拉动滚动条时的地图图片显示的TOP位置
End Sub

'Tileset scroll
Private Sub ScrTileset_Scroll()
PicTileset.Top = 192 - ScrTileset.Value * 32 '拉动滚动条时的地图图片显示的TOP位置
End Sub

'Map scroll
Private Sub ScrVMap_Change()
PicMap.Top = 24 - ScrVMap.Value * 32   '拉动地图滚动条时地图的TOP位置
End Sub

'Size slider
Private Sub SldSize_Change()
SldSize_Scroll
End Sub

'Size slider
Private Sub SldSize_Scroll()
ShpPlace.Width = 32 * SldSize.Value
ShpPlace.Height = 32 * SldSize.Value
End Sub

'Toolbar buttons
Private Sub ToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim i As Integer
'地图层相关的代码
If Button.Index = 1 Then Mnu_LoadTileset_Click
If Button.Index = 2 Then Mnu_Open_Click
If Button.Index = 3 Then Mnu_Save_Click
If Button.Index = 4 Then Mnu_SavePicture_Click
If Button.Index >= 6 And Button.Index <= 10 Then
    ToolBar.Buttons(6).Value = tbrUnpressed
    ToolBar.Buttons(7).Value = tbrUnpressed
    ToolBar.Buttons(8).Value = tbrUnpressed
    ToolBar.Buttons(9).Value = tbrUnpressed
    ToolBar.Buttons(10).Value = tbrUnpressed
    ToolBar.Buttons(Button.Index).Value = tbrPressed
    CurrentLayer = Button.Index - 5
    If CurrentLayer = 5 Then
        DrawLayer (1), False
        DrawLayer (2), False
        DrawLayer (3), False
        DrawLayer (4), False
    Else
        For i = 1 To CurrentLayer
            DrawLayer i, False
            If i = CurrentLayer - 1 Then GrayScale PicMap
        Next i
    End If
End If
If Button.Index = 12 Then
    ToolBar.Buttons(12).Value = tbrPressed
    ToolBar.Buttons(13).Value = tbrUnpressed
    SldSize.Value = 1
    SldSize.Enabled = False
End If
If Button.Index = 13 Then
    ToolBar.Buttons(12).Value = tbrUnpressed
    ToolBar.Buttons(13).Value = tbrPressed
    SldSize.Enabled = True
    SldSize_Scroll
End If
End Sub

'Save the level to text
Private Sub SaveLevel(Filename As String)
'保存地图层相关的信息
Dim File As Integer
Dim X As Integer
Dim Y As Integer
Dim LayerIndex As Integer
Dim IsAnObjectValue As Integer

File = FreeFile

Open Filename For Output As File
    Print #File, MapWidth & "^" & MapHeight & "^" & CurrentTilesetFile
    For LayerIndex = 1 To 4
        Print #File, "[Layer]"
        For Y = 1 To MapHeight
            For X = 1 To MapWidth
                If Layer(LayerIndex).TileCoordinates(X, Y).IsAnObject = True Then IsAnObjectValue = 1 Else IsAnObjectValue = 0
                Print #File, Layer(LayerIndex).TileCoordinates(X, Y).X & "*" & Layer(LayerIndex).TileCoordinates(X, Y).Y & "*" & IsAnObjectValue & "]"
            Next X
        Next Y
    Next LayerIndex
Close File
End Sub

'Load a level from text
Private Sub LoadLevel(Filename As String)
'打开地图层相关的信息
Dim File As Integer
Dim sFile As String
Dim sTemp(0 To 4) As String
Dim sBuf As String
Dim X As Integer
Dim Y As Integer
Dim Counter As Long
Dim LayerIndex As Integer
Dim i As Integer

File = FreeFile

Open Filename For Input As File
sFile = Input(LOF(File), 1)
sFile = Replace(sFile, vbCrLf, "")
sTemp(0) = Mid(Split(sFile, "[Layer]")(0), 1)
sTemp(1) = Mid(Split(sFile, "[Layer]")(1), 1)
sTemp(2) = Mid(Split(sFile, "[Layer]")(2), 1)
sTemp(3) = Mid(Split(sFile, "[Layer]")(3), 1)
sTemp(4) = Mid(Split(sFile, "[Layer]")(4), 1)
'===========================地图层↑===============
Close File


MapWidth = Split(sTemp(0), "^")(0)
MapHeight = Split(sTemp(0), "^")(1)
CurrentTilesetFile = Split(sTemp(0), "^")(2)

PicTileset.Picture = LoadPicture(App.Path & "\Tilesets\" & CurrentTilesetFile)

PicMap.Width = 32 * MapWidth
PicMap.Height = 32 * MapHeight
'===================↑====地图的WIDTH坐标和HEIGHT坐标的算法！
For i = 1 To 4
    ReDim Layer(i).TileCoordinates(1 To MapWidth, 1 To MapHeight)
    
    For Y = 1 To MapHeight
        For X = 1 To MapWidth
            Layer(i).TileCoordinates(X, Y).X = -1
            Layer(i).TileCoordinates(X, Y).Y = -1
        Next X
    Next Y
Next i

For LayerIndex = 1 To 4
    Counter = 0
    For Y = 1 To MapHeight
        For X = 1 To MapWidth
            sBuf = Split(sTemp(LayerIndex), "]")(Counter)
            Layer(LayerIndex).TileCoordinates(X, Y).X = Split(sBuf, "*")(0)
            Layer(LayerIndex).TileCoordinates(X, Y).Y = Split(sBuf, "*")(1)
            Layer(LayerIndex).TileCoordinates(X, Y).IsAnObject = Split(sBuf, "*")(2)
            Counter = Counter + 1
        Next X
    Next Y
Next LayerIndex

CurrentLayer = 1

ScrHMap.Max = MapWidth - 20
ScrVMap.Max = MapHeight - 20

If ScrHMap.Max <= 0 Then ScrHMap.Enabled = False Else ScrHMap.Enabled = True
If ScrVMap.Max <= 0 Then ScrVMap.Enabled = False Else ScrVMap.Enabled = True

ScrTileset.Max = (PicTileset.Height / 32) - 20
If ScrTileset.Max <= 0 Then ScrTileset.Enabled = False Else ScrTileset.Enabled = True
'================地图层次==============
DrawLayer (1), False
DrawLayer (2), False
DrawLayer (3), False
DrawLayer (4), False
'======================================
End Sub