📄 frmmapproperty.frm
字号:
VERSION 5.00
Begin VB.Form FrmMap
BorderStyle = 1 'Fixed Single
Caption = "Map Property"
ClientHeight = 3510
ClientLeft = 1545
ClientTop = 1875
ClientWidth = 4935
ControlBox = 0 'False
Icon = "FrmMapProperty.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3510
ScaleWidth = 4935
Begin VB.TextBox TxtMap
Height = 270
Index = 9
Left = 4560
Locked = -1 'True
MaxLength = 1
TabIndex = 25
Top = 2160
Width = 300
End
Begin VB.TextBox TxtName
Height = 270
Left = 960
MaxLength = 30
TabIndex = 23
Top = 0
Width = 3855
End
Begin VB.CommandButton CmdCancel
Cancel = -1 'True
Caption = "取 消"
Height = 375
Left = 2280
TabIndex = 0
Top = 2880
Width = 1215
End
Begin VB.CheckBox ChkDrawBack
Alignment = 1 'Right Justify
Caption = "是否动态画法"
Height = 255
Left = 2520
TabIndex = 21
Top = 1800
Width = 2295
End
Begin VB.TextBox TxtMap
Height = 270
Index = 8
Left = 960
MaxLength = 26
TabIndex = 10
Top = 2520
Width = 1335
End
Begin VB.TextBox TxtMap
Height = 270
Index = 7
Left = 3360
Locked = -1 'True
MaxLength = 1
TabIndex = 9
Top = 2160
Width = 300
End
Begin VB.TextBox TxtMap
Height = 270
Index = 6
Left = 960
MaxLength = 10
TabIndex = 8
Top = 2160
Width = 1335
End
Begin VB.TextBox TxtMap
Height = 270
Index = 5
Left = 960
MaxLength = 3
TabIndex = 7
Top = 1800
Width = 1335
End
Begin VB.TextBox TxtMap
Height = 270
Index = 4
Left = 3480
MaxLength = 4
TabIndex = 6
Top = 1440
Width = 1335
End
Begin VB.TextBox TxtMap
Height = 270
Index = 3
Left = 960
MaxLength = 3
TabIndex = 5
Top = 1440
Width = 1335
End
Begin VB.TextBox TxtMap
Height = 270
Index = 2
Left = 960
MaxLength = 50
TabIndex = 4
Top = 1080
Width = 3855
End
Begin VB.TextBox TxtMap
Height = 270
Index = 1
Left = 960
MaxLength = 50
TabIndex = 3
Top = 720
Width = 3855
End
Begin VB.TextBox TxtMap
Height = 270
IMEMode = 3 'DISABLE
Index = 0
Left = 960
MaxLength = 20
PasswordChar = "*"
TabIndex = 2
Top = 360
Width = 3855
End
Begin VB.CommandButton CmdOK
Caption = "确 定"
Default = -1 'True
Height = 375
Left = 3600
TabIndex = 1
Top = 2880
Width = 1215
End
Begin VB.CheckBox ChkRandom
Alignment = 1 'Right Justify
Caption = "是否随机贴图"
Height = 255
Left = 2520
TabIndex = 11
Top = 2520
Width = 2295
End
Begin VB.Label LabMapProperty
Caption = "背景速度"
Height = 255
Index = 10
Left = 3720
TabIndex = 24
Top = 2160
Width = 735
End
Begin VB.Label LabMapProperty
Caption = "名称"
Height = 255
Index = 9
Left = 120
TabIndex = 22
Top = 0
Width = 735
End
Begin VB.Label LabMapProperty
Caption = "背景贴图"
Height = 255
Index = 8
Left = 120
TabIndex = 20
Top = 2520
Width = 735
End
Begin VB.Label LabMapProperty
Caption = "装载速度"
Height = 255
Index = 7
Left = 2520
TabIndex = 19
Top = 2160
Width = 735
End
Begin VB.Label LabMapProperty
Caption = "背景色"
Height = 255
Index = 6
Left = 120
TabIndex = 18
Top = 2160
Width = 735
End
Begin VB.Label LabMapProperty
Caption = "显示宽度"
Height = 255
Index = 5
Left = 120
TabIndex = 17
Top = 1800
Width = 735
End
Begin VB.Label LabMapProperty
Caption = "总高度"
Height = 255
Index = 4
Left = 2520
TabIndex = 16
Top = 1440
Width = 735
End
Begin VB.Label LabMapProperty
Caption = "总宽度"
Height = 255
Index = 3
Left = 120
TabIndex = 15
Top = 1440
Width = 735
End
Begin VB.Label LabMapProperty
Caption = "作者"
Height = 255
Index = 2
Left = 120
TabIndex = 14
Top = 1080
Width = 735
End
Begin VB.Label LabMapProperty
Caption = "描述"
Height = 255
Index = 1
Left = 120
TabIndex = 13
Top = 720
Width = 735
End
Begin VB.Label LabMapProperty
Caption = "密码"
Height = 255
Index = 0
Left = 120
TabIndex = 12
Top = 360
Width = 735
End
End
Attribute VB_Name = "FrmMap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub CmdOk_Click()
'On Error Resume Next
If Trim(TxtName.Text) = "" Then MsgBox "请为你的地图起个名字": Exit Sub
If IsChinese Then MsgBox "你的描述中包含汉字，请不要过长，否则存储会不正确", , "注意"
If IsNewMap And IsExistFile(App.Path & "\Map\" & Trim(TxtName.Text) & ".Smp") Then MsgBox "该名字的地图已经存在，请另选名字", , "无法创建新地图": Exit Sub
If IsNewMap Then
Call frmMain.UnloadMapImgObject
Call frmMain.LoadAllObject
End If
With Map.HeadMapFile
.MapHeadStr = "I'm a map for SkyWar"
.NameMap = TxtName.Text
Call WritePW(TxtMap(0).Text)
.MapDescription = TxtMap(1).Text
.Editor = TxtMap(2).Text
.WidthTotal = (Val(TxtMap(3).Text) \ 10) * 10
.HeightTotal = (Val(TxtMap(4).Text) \ 20) * 20
.WidthShow = (Val(TxtMap(5).Text) \ 10) * 10
.IsDrawBack = ChkDrawBack.Value
.BackColor = TxtMap(6).Text
.SpeedMap = TxtMap(7).Text
If .SpeedMap = 0 Then .SpeedMap = 1
.SpeedBack = TxtMap(9).Text
Call WriteRndPic(TxtMap(8).Text)
.IsRandom = ChkRandom.Value
End With
'Open App.Path & "\Map\0.Smp" For Binary As #1
' Put #1, 1, Map.HeadMapFile
'Close #1
'不在此存
'frmmain.ChkOption.Caption ="是否带
Call InitEditMapfrmMain
Unload Me
frmMain.WindowState = 2
If Err Then MsgBox Err.Description
End Sub
Public Sub InitEditMapfrmMain()
frmMain.ScrMap2.Max = Map.HeadMapFile.WidthTotal - frmMain.EditMain.ScaleWidth + frmMain.ScrMap.Width
frmMain.ScrMap.Visible = True
frmMain.ScrMap2.Visible = True
frmMain.ScrMap.ZOrder 0
frmMain.ScrMap2.ZOrder 0
If frmMain.ScrMap2.Value <= 1 Then
frmMain.ScrMap.Max = Map.HeadMapFile.HeightTotal - frmMain.EditMain.ScaleHeight
Else
frmMain.ScrMap.Max = Map.HeadMapFile.HeightTotal - frmMain.EditMain.ScaleHeight + frmMain.ScrMap2.Height
End If
frmMain.MainPic.Move (frmMain.EditMain.ScaleWidth - frmMain.ScrMap.Width - Map.HeadMapFile.WidthTotal) / 2, 0, Map.HeadMapFile.WidthTotal, Map.HeadMapFile.HeightTotal
frmMain.MainPic.Picture = Nothing
frmMain.MainPic.BackColor = Map.HeadMapFile.BackColor
frmMain.MainPic.Line ((Map.HeadMapFile.WidthTotal - Map.HeadMapFile.WidthShow) / 2, 0)-((Map.HeadMapFile.WidthShow + Map.HeadMapFile.WidthTotal) / 2, frmMain.MainPic.ScaleHeight - 2), &HFF00FF, B
frmMain.RunPic.Picture = Nothing
frmMain.RunPic.Visible = False
frmMain.SliFps.Visible = False
frmMain.PicPath.Visible = True
frmMain.PicPac.Visible = True
frmMain.DelObject.Enabled = True
End Sub
Private Function IsChinese() As Boolean
For N = TxtMap.LBound To TxtMap.UBound
For M = 1 To Len(TxtMap(N).Text)
If Asc(Mid(TxtMap(N).Text, M, 1)) < 0 Then
IsChinese = True
Exit Function
End If
Next M
Next N
End Function
Private Sub CmdCancel_Click()
'IsNewMap = False
If frmMain.mnuWindowObjectWin.Checked = False Then IsNewMap = False
Unload Me
End Sub
Private Sub Form_Load()
Dim RN As Byte
If Not IsNewMap Or frmMain.mnuWindowObjectWin.Checked = True Then
'Open App.Path & "\Map\0.Smp" For Binary As #1
' Get #1, 1, Map.HeadMapFile
'Close #1
With Map.HeadMapFile
'TxtName.Enabled = False
TxtName.Text = Trim(.NameMap)
TxtMap(0).Text = ReadPW(Map.HeadMapFile)
TxtMap(1).Text = RTrim(.MapDescription)
TxtMap(2).Text = RTrim(.Editor)
TxtMap(3).Text = .WidthTotal
TxtMap(4).Text = .HeightTotal
TxtMap(5).Text = .WidthShow
ChkDrawBack.Value = Abs(.IsDrawBack)
TxtMap(6).Text = CRGB(.BackColor)
TxtMap(7).Text = .SpeedMap
TxtMap(9).Text = .SpeedBack
For RN = 1 To 10
If .RandomPicture(RN) = 0 Then Exit For
TxtMap(8).Text = TxtMap(8).Text & .RandomPicture(RN) & ","
Next RN
If .RandomPicture(1) <> 0 Then TxtMap(8).Text = Left(TxtMap(8).Text, Len(TxtMap(8).Text) - 1)
ChkRandom.Value = Abs(.IsRandom)
End With
Else
TxtMap(3).Text = 480
TxtMap(4).Text = 6000
TxtMap(5).Text = 420
TxtMap(6).Text = CRGB(&H800000)
TxtMap(7).Text = 2
TxtMap(8).Text = "0,0,0"
TxtMap(9).Text = 1
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmMain.mnuWindowObjectWin.Checked = False
End Sub
Private Sub TxtMap_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
Case 7
Select Case KeyAscii
Case 49, 50, 52, 56
TxtMap(Index).Text = Chr(KeyAscii)
Case Else: KeyAscii = 0
End Select
Case 9
Select Case KeyAscii
Case 48, 49, 50, 52, 56
TxtMap(Index).Text = Chr(KeyAscii)
Case Else: KeyAscii = 0
End Select
TxtMap(Index).SelStart = 2
End Select
End Sub
Private Sub WriteRndPic(ByVal S As String)
On Local Error Resume Next
Dim RN As Byte
Dim SeatP As Byte
S = Trim(S)
If S = "" Then Exit Sub
For RN = 1 To 10
SeatP = InStr(S, ",")
If SeatP <= 1 Or SeatP >= Len(S) Then Exit Sub
Map.HeadMapFile.RandomPicture(RN) = Left(S, SeatP - 1)
S = Right(S, Len(S) - SeatP)
If InStr(S, ",") = 0 And S <> "" Then Map.HeadMapFile.RandomPicture(RN + 1) = S: Exit Sub
Next
'If Err Then MsgBox Err.Description
End Sub
Sub WritePW(ByVal S As String)
Dim Ls As Byte
Dim BufS As String
Map.HeadMapFile.PL = Len(S)
For Ls = 1 To Len(S)
Map.HeadMapFile.PassWord(Ls) = (Asc(Mid(S, Ls, 1)) + 100) Mod 256
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -