📄 frmmain.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmMain
BorderStyle = 1 'Fixed Single
ClientHeight = 10200
ClientLeft = 615
ClientTop = 420
ClientWidth = 13935
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 680
ScaleMode = 3 'Pixel
ScaleWidth = 929
Begin MSComctlLib.Toolbar ToolBar
Align = 1 'Align Top
Height = 360
Left = 0
TabIndex = 0
Top = 0
Width = 13935
_ExtentX = 24580
_ExtentY = 635
ButtonWidth = 609
ButtonHeight = 582
Appearance = 1
Style = 1
ImageList = "ImgLstToolbar"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 22
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Opentileset"
Object.ToolTipText = "Open"
ImageIndex = 13
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Open"
Object.ToolTipText = "Save"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Save"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "SavePic"
ImageIndex = 14
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "x1"
ImageIndex = 8
Style = 1
Value = 1
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "x2"
ImageIndex = 9
Style = 1
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "x3"
ImageIndex = 10
Style = 1
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "x4"
ImageIndex = 11
Style = 1
EndProperty
BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
ImageIndex = 12
Style = 1
EndProperty
BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
ImageIndex = 5
Style = 3
EndProperty
BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
ImageIndex = 6
Style = 1
Value = 1
EndProperty
BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628}
ImageIndex = 7
Style = 1
EndProperty
BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Button20 {66833FEA-8583-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Button21 {66833FEA-8583-11D1-B16A-00C0F0283628}
ImageIndex = 2
Style = 3
EndProperty
BeginProperty Button22 {66833FEA-8583-11D1-B16A-00C0F0283628}
ImageIndex = 12
Style = 1
EndProperty
EndProperty
Begin MSComctlLib.Slider SldSize
Height = 315
Left = 4200
TabIndex = 4
Top = 0
Width = 2055
_ExtentX = 3625
_ExtentY = 556
_Version = 393216
Min = 2
Max = 20
SelStart = 2
TickStyle = 3
TickFrequency = 10
Value = 2
End
End
Begin VB.PictureBox PicTileset
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 18720
Left = 0
ScaleHeight = 1248
ScaleMode = 3 'Pixel
ScaleWidth = 255
TabIndex = 1
Top = 2880
Width = 3825
Begin VB.Shape ShpBig
BorderColor = &H00FF0000&
BorderStyle = 3 'Dot
Height = 480
Left = 0
Top = 0
Width = 480
End
Begin VB.Shape ShpTile
BorderColor = &H000000FF&
Height = 480
Left = 0
Top = 0
Width = 480
End
End
Begin VB.HScrollBar ScrHMap
Height = 255
Left = 4080
Max = 0
TabIndex = 6
Top = 9960
Width = 9600
End
Begin VB.VScrollBar ScrVMap
Height = 9615
Left = 13680
Max = 0
TabIndex = 5
Top = 360
Width = 255
End
Begin VB.VScrollBar ScrTileset
Enabled = 0 'False
Height = 7335
Left = 3840
Max = 0
TabIndex = 2
Top = 2880
Width = 255
End
Begin VB.PictureBox Pic
BorderStyle = 0 'None
Height = 8055
Index = 1
Left = -480
ScaleHeight = 8055
ScaleWidth = 4335
TabIndex = 8
Top = 2040
Width = 4335
End
Begin VB.PictureBox Pic
BorderStyle = 0 'None
Height = 255
Index = 0
Left = 13680
ScaleHeight = 255
ScaleWidth = 255
TabIndex = 7
Top = 9960
Width = 255
End
Begin VB.PictureBox PicMap
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 9600
Left = 4080
ScaleHeight = 640
ScaleMode = 3 'Pixel
ScaleWidth = 640
TabIndex = 3
Top = 360
Width = 9600
Begin VB.Shape ShpPlace
BorderColor = &H00FF0000&
BorderStyle = 3 'Dot
Height = 480
Left = 0
Top = 0
Width = 480
End
End
Begin MSComDlg.CommonDialog Com
Left = 840
Top = 120
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComctlLib.ImageList ImgLstToolbar
Left = 120
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 14
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":0000
Key = "New"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":0112
Key = "Open"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":0224
Key = "Save"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":0336
Key = "Undo"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":0448
Key = "Redo"
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":055A
Key = "Arc"
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":066C
Key = "Rectangle"
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":077E
Key = "x1"
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":0AD0
Key = "x2"
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":0E22
Key = "x3"
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":1174
Key = "x4"
EndProperty
BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":14C6
Key = ""
EndProperty
BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":1818
Key = ""
EndProperty
BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":1BAA
Key = ""
EndProperty
EndProperty
End
Begin VB.Menu Mnu_File
Caption = "文件"
Begin VB.Menu Mnu_LoadTileset
Caption = "打开地图图片"
End
Begin VB.Menu Mnu_Open
Caption = "打开地图文件"
Shortcut = ^O
End
Begin VB.Menu sep
Caption = "-"
End
Begin VB.Menu Mnu_Save
Caption = "保存地图"
Shortcut = ^S
End
Begin VB.Menu Mnu_SavePicture
Caption = "保存图片"
End
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit '自动检测代码是否出错代码
'↓↓↓↓↓↓↓↓↓↓都是一些定义之类的东西↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
'Private Api's
Private Declare Function TransparentBlt Lib "msimg32" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal crTransparent As Long) As Long
'Private types
Private Type TilePos
X As Integer
Y As Integer
IsAnObject As Boolean
End Type
Private Type Map
TileCoordinates() As TilePos
End Type
'Private Variables
Private MouseDownTile As TilePos
Private MouseUpTile As TilePos
Private Layer(1 To 4) As Map
Private MapWidth As Integer
Private MapHeight As Integer
Private CurrentLayer As Integer
Private CurrentTilesetFile As String
'↑↑↑↑↑↑↑↑↑↑都是一些定义之类的东西↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
'Start the program
Private Sub Form_Load()
Dim i As Integer, Y As Integer, X As Integer '定义X坐标和Y坐标
MapWidth = 15 '游戏地图的长
MapHeight = 15 '游戏地图的宽
PicMap.Width = 32 * MapWidth '画地图格子的长
PicMap.Height = 32 * MapHeight '画地图格子的宽
ScrHMap.Max = MapWidth - 20 '选择地图图片的格子的长
ScrVMap.Max = MapHeight - 20 '选择地图图片的格子的宽
If ScrHMap.Max <= 0 Then ScrHMap.Enabled = False Else ScrHMap.Enabled = True '如果选择地图图片的格子的长小于或者等于0的时候，关闭选择地图图片功能否则就打开！
If ScrVMap.Max <= 0 Then ScrVMap.Enabled = False Else ScrVMap.Enabled = True '如果选择地图图片的格子的宽小于或者等于0的时候，关闭选择地图图片功能否则就打开！
'=========================================================================
'这里是设置那个同时选择多个地图图片的时候要执行的代码
For i = 1 To 4 '变量i 1到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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -