📄 frmmain.frm
字号:
Style = 6
AutoSize = 2
TextSave = "03-8-30"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
AutoSize = 2
TextSave = "17:57"
EndProperty
EndProperty
End
Begin MSComDlg.CommonDialog dlgCommonDialog
Left = 2040
Top = 1800
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin MSComctlLib.ImageList imlToolbarIcons
Left = 2160
Top = 2880
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 9
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0442
Key = "Cut"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0554
Key = "Copy"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0666
Key = "Paste"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0778
Key = "Delete"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":088A
Key = "Forward"
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":099C
Key = "View Large Icons"
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0AAE
Key = "View Small Icons"
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0BC0
Key = "Point"
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1020
Key = "Save"
EndProperty
EndProperty
End
Begin VB.Image ImgAll4
Height = 735
Index = 0
Left = 6360
Top = 1920
Width = 735
End
Begin VB.Image ImgAll1
Height = 735
Index = 0
Left = 6120
Top = 1680
Width = 735
End
Begin VB.Image ImgAll0
Height = 735
Index = 0
Left = 5880
Top = 1440
Width = 855
End
Begin VB.Image ImgCancle
Height = 1095
Left = 3600
Top = 3960
Width = 1215
End
Begin VB.Image ImageCopy
Height = 855
Left = 600
Top = 4080
Width = 975
End
Begin VB.Image imgSplitter
Height = 2985
Left = 1680
MousePointer = 9 'Size W E
Top = 480
Width = 150
End
Begin VB.Menu mnuFile
Caption = "文件(&F)"
Begin VB.Menu mnuFileOpen
Caption = "打开(&O)..."
End
Begin VB.Menu mnuFileNew
Caption = "新建(&N)"
Begin VB.Menu mnuObj
Caption = "物体"
Shortcut = ^N
End
Begin VB.Menu mnuMap
Caption = "地图"
End
End
Begin VB.Menu mnuFileSave
Caption = "保存(&S)"
Shortcut = ^S
End
Begin VB.Menu mnuCloseMap
Caption = "关闭地图"
Shortcut = ^Q
End
Begin VB.Menu mnuFileBar0
Caption = "-"
End
Begin VB.Menu mnuFileClose
Caption = "关闭(&C)"
End
End
Begin VB.Menu mnuEdit
Caption = "编辑(&E)"
Begin VB.Menu DelObject
Caption = "删除"
Shortcut = {DEL}
End
Begin VB.Menu mnuEditBar0
Caption = "-"
End
Begin VB.Menu mnuEditCut
Caption = "剪切(&X)"
Enabled = 0 'False
Shortcut = ^X
End
Begin VB.Menu mnuEditCopy
Caption = "复制(&C)"
Enabled = 0 'False
Shortcut = ^C
End
Begin VB.Menu mnuEditPaste
Caption = "粘贴(&P)"
Enabled = 0 'False
Shortcut = ^V
End
End
Begin VB.Menu mnuView
Caption = "视图(&V)"
Begin VB.Menu mnuViewToolbar
Caption = "工具栏(&T)"
Checked = -1 'True
End
Begin VB.Menu mnuViewStatusBar
Caption = "状态栏(&B)"
Checked = -1 'True
End
Begin VB.Menu mnuViewOptions
Caption = "选项(&O)..."
End
End
Begin VB.Menu mnuSetObject
Caption = "设置"
Begin VB.Menu mnuSetObjectRunX
Caption = "运行"
Shortcut = {F5}
End
Begin VB.Menu mnuOpenWith
Caption = "用画图编辑"
Shortcut = {F8}
End
Begin VB.Menu Zlinez
Caption = "-"
End
Begin VB.Menu mnuSetColor
Caption = "设置播放背景色"
End
Begin VB.Menu mnuSetBColor
Caption = "设置编辑背景色"
End
Begin VB.Menu Zl
Caption = "-"
End
Begin VB.Menu mnuSetStage
Caption = "将地图选入关"
End
End
Begin VB.Menu mnuWindow
Caption = "窗口(&W)"
WindowList = -1 'True
Begin VB.Menu mnuWindowPropertyWin
Caption = "属性窗口"
Shortcut = {F4}
End
Begin VB.Menu mnuWindowObjectWin
Caption = "地图属性"
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuHelpSearchForHelpOn
Caption = "搜索帮助主题(&S)..."
End
Begin VB.Menu mnuHelpBar0
Caption = "-"
End
Begin VB.Menu mnuHelpAbout
Caption = "关于(&A) "
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 Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Dim N As Integer '通用计量值
Dim mbMoving As Boolean
Dim IsNew As Boolean
Dim ImgX As Integer
Dim ImgY As Integer
Dim ImgRealX As Integer
Dim ImgRealY As Integer
Dim ImgDel As Integer
Dim CurEditImg As Integer
Dim TagImgType As String * 5
Dim TagImgIndex As String * 5
Dim TagPath As String * 2
Dim TagPac As String * 2
'Dim OptionPathIndex As Byte
'Dim OptionPacIndex As Byte
Dim IsLoadedAllThing As Boolean
Dim PathType() As String
Dim PackageType() As String
Const sglSplitLimit = 500
Private Sub ComboObj_Click()
'*************该处有点小问题
On Error Resume Next
Dim PathAllcon As String
If ComboObj.ListIndex = -1 Then Exit Sub
Screen.MousePointer = 11
PathAllcon = GetPath(ComboObj.ListIndex)
Open PathAllcon & "All.con" For Binary As #1
Get #1, Len(HeadStr) + 1, AllCon
'MsgBox allcon & " " & LenHead
Close #1
'MsgBox allcon
SingleList.Height = Screen.Height + AllCon * (ImageList(0).Height + 120)
ScrList.Min = 1
ScrList.Max = AllCon
If ImageList.UBound < AllCon Then
For N = ImageList.UBound + 1 To AllCon
Load ImageList(N)
ImageList(N).Top = ImageList(N - 1).Top + ImageList(0).Height + 120
ImageList(N).Visible = True
Next N
ElseIf ImageList.UBound > AllCon Then
For N = AllCon + 1 To ImageList.UBound
ImageList(N).Picture = Nothing
ImageList(N).Visible = False
Next N
End If
For N = 1 To AllCon
ImageList(N).Picture = Nothing
ImageList(N).Picture = LoadPicture(PathAllcon & N & ".Ebj")
ImageList(N).Visible = True
Next N
LabBack.Top = -2000
'ImageList(0).Picture = LoadPicture(App.Path & "\eobject\" & NewObj.EName & ".ebj")
CurrentEditType = ComboObj.ListIndex
Screen.MousePointer = 0
ScrList.SetFocus
If Err Then MsgBox Err.Description
End Sub
Private Sub DelObject_Click()
On Error Resume Next
If IsEditMap Then
With ImgMap(CurEditImg)
.Picture = Nothing
.Visible = False
.Tag = "0"
End With
ImgDel = ImgDel + 1
IsNewMap = True
CurEditImg = 0
LabBack2.Visible = False
'Else
'MsgBox "无法删除元素，"
End If
End Sub
Private Sub Form_Load()
If IsLoadedAllThing Then Exit Sub
IsLoadedAllThing = True
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
RunPic.BackColor = GetSetting(App.Title, "Settings", "PicBackColor", &H800000)
EditMain.BackColor = GetSetting(App.Title, "Settings", "EditBackColor", &H8000000F)
Call MapEditRegister(App.Path, App.EXEName)
Call InitList
'MsgBox Command
If Command <> "" Then Unload frmPro: Call LoadMapFile(Command)
End Sub
Private Sub InitList()
Dim S As String
N = 0
On Error Resume Next
With ComboObj
.Text = "请选择..."
.Top = 0
.Left = 0
.Width = ObjList.ScaleWidth
End With
Open App.Path & "\ListPro\ListCaption.ini" For Input As #1
Do While Not EOF(1)
Line Input #1, S
ComboObj.AddItem S, N
N = N + 1
If N > 20 Then Exit Do
Loop
Close #1
With ScrList
.Width = 200
.Top = ComboObj.Height + 10
'.Height = ObjList.Height - ComboObj.Height - 150
End With
'重新initi singlelist
With SingleList
.Top = -120
.Height = ScrList.Height + ObjList.Height
End With
With ImageList(0)
.Left = 120
.Top = 480
.Width = SingleList.Width - 240
.Height = 1000
End With
With LabBack
.Width = ImageList(0).Width + 100
.Height = ImageList(0).Height + 100
.Left = ImageList(0).Left - 50
.Top = -2000 'ImageList(0).Top - 50
End With
With RunPic
.Left = 0
.Top = 0
'.AutoRedraw = True
End With
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -