frmmain.frm

一款飞机射击游戏的源代码

    With SliFps
        .Min = 1
        .Visible = False
    End With
    For N = 1 To 10
        Load OptionPath(N)
        OptionPath(N).Visible = True
        OptionPath(N).Left = OptionPath(N - 1).Left + OptionPath(0).Width
    Next N
        OptionPath(0).Left = OptionPath(10).Left
        OptionPath(10).Left = 48
        OptionPath(10).Value = True
    For N = 1 To 10
        Load OptionPac(N)
        OptionPac(N).Visible = True
        OptionPac(N).Left = OptionPac(N - 1).Left + OptionPac(0).Width
    Next N
        OptionPac(0).Value = True
    PicPath.Print "PathType"
    PicPac.Print "Package"
    
    'HdcPic = PicCreateHdc '''''''''
    CurAppPath = App.Path
    CurImageIndex = -1
End Sub
    
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim A As Integer
    If IsNewMap Then
        Cancel = 1
        A = MsgBox("原来的地图还没保存，要保存吗?", vbYesNoCancel)
        If A = vbYes Then
            Call mnuFileSave_Click
        ElseIf A = vbNo Then
            IsNewMap = False
        Else
            Exit Sub
        End If
        
    End If
Cancel = 0
Unload Me
End Sub

'Private Sub Form_Paint()
'    'EditMain.View = Val(GetSetting(App.Title, "Settings", "ViewMode", "0"))
'    Select Case EditMain.View
'        Case lvwIcon
'            tbToolBar.Buttons(LISTVIEW_MODE0).Value = tbrPressed
'        Case lvwSmallIcon
''            tbToolBar.Buttons(LISTVIEW_MODE1).Value = tbrPressed
'        Case lvwList
'            tbToolBar.Buttons(LISTVIEW_MODE2).Value = tbrPressed
'        Case lvwReport
'            tbToolBar.Buttons(LISTVIEW_MODE3).Value = tbrPressed
'    End Select
'End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer
On Error Resume Next

    For i = 1 To ImageList.Count - 1
        ImageList(i).Picture = Nothing
        Unload ImageList(i)
    Next i
    Call UnloadAllObject
    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
        
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
        SaveSetting App.Title, "Settings", "PicBackColor", RunPic.BackColor
        SaveSetting App.Title, "Settings", "EditBackColor", EditMain.BackColor
    End If
End Sub



Private Sub Form_Resize()
    On Error Resume Next
    If Me.Width < 3000 Then Me.Width = 3000
    SizeControls imgSplitter.Left
    ScrList.Height = ObjList.Height - ComboObj.Height - 80
    With SingleList
        .Left = ScrList.Width + 30
        .Width = ObjList.Width - ScrList.Width - 100
    End With
    'If Command <> "" Then
        'Command = ""
    'Else
    frmPro.Visible = IIf((Me.WindowState = 1), False, True)

    'End If
    If Not IsEditMap Then
        ReSeatMainpic
    Else
        ScrMap.Left = EditMain.ScaleWidth - ScrMap.Width
        ScrMap.Height = EditMain.ScaleHeight
        ScrMap2.Width = EditMain.ScaleWidth - ScrMap.Width
        ScrMap2.Top = EditMain.ScaleHeight - ScrMap2.Height
        
        ScrMap2.Max = Map.HeadMapFile.WidthTotal - EditMain.ScaleWidth + ScrMap.Width
        If ScrMap2.Max >= 1 Then
            ScrMap2.Visible = True
            ScrMap2.ZOrder 0
            ScrMap.Max = Map.HeadMapFile.HeightTotal - EditMain.ScaleHeight + ScrMap2.Height
        Else
            ScrMap2.Visible = False
            MainPic.Move (frmMain.EditMain.ScaleWidth - frmMain.ScrMap.Width - Map.HeadMapFile.WidthTotal) / 2, 0, Map.HeadMapFile.WidthTotal, Map.HeadMapFile.HeightTotal
            ScrMap.Max = Map.HeadMapFile.HeightTotal - EditMain.ScaleHeight
        End If
    End If
End Sub
Private Sub ReSeatMainpic()
    With MainPic
        .Top = (EditMain.ScaleHeight - .Height) / 2
        .Left = (EditMain.ScaleWidth - .Width) / 2
    End With
End Sub

Private Sub ImageList_Click(Index As Integer)
On Error Resume Next
If ComboObj.ListIndex = -1 Then Exit Sub
    ImageList(Index).ZOrder 0
    CurImageIndex = Index
    LabBack.Top = ImageList(Index).Top - 50
    Call InitSaveObject(LoadObj)
    Open GetPath(ComboObj.ListIndex) & "All.con" For Binary As #1
            Select Case ComboObj.ListIndex
                Case 0
                    Get #1, LenHead + 1 + (Index - 1) * Len(LoadObj), LoadObj
                Case 1
                    Get #1, LenHead + 1 + (Index - 1) * Len(LoadSta), LoadSta
                        
                Case 2
                    Get #1, LenHead + 1 + (Index - 1) * Len(LoadPla), LoadPla
                Case 3
                Case 4
                    Get #1, LenHead + 1 + (Index - 1) * Len(LoadBackObj), LoadBackObj
                Case 5
                Case 6
                    Get #1, LenHead + 1 + (Index - 1) * Len(LoadBul), LoadBul
                Case 7
                    Get #1, LenHead + 1 + (Index - 1) * Len(LoadMyBul), LoadMyBul
                Case 8
                    Get #1, LenHead + 1 + (Index - 1) * Len(LoadExp), LoadExp
                Case 9
                    Get #1, LenHead + 1 + (Index - 1) * Len(LoadCra), LoadCra
                Case 10
                    Get #1, LenHead + 1 + (Index - 1) * Len(LoadPac), LoadPac
                    Select Case LoadPac.TypePac
                        Case 0 To 3
                            sbStatusBar.Panels.Item(1).Text = "加火力类包裹 " & IIf(LoadPac.TypePac = 0, 1, LoadPac.TypePac)
                        Case 4
                            sbStatusBar.Panels.Item(1).Text = "加雷的包裹"
                        Case 5, 6
                            sbStatusBar.Panels.Item(1).Text = "加生命值的包裹"
                    End Select
                Case 11
                    Get #1, LenHead + 1 + (Index - 1) * Len(LoadBom), LoadBom
            End Select
    Close #1
            Call LoadProperty(ComboObj.ListIndex, frmPro.Pro)
If Err Then MsgBox Err.Description
End Sub

Private Sub ImageList_DblClick(Index As Integer)
On Error Resume Next
    If ComboObj.ListIndex = -1 Then Exit Sub
    If IsEditMap Then
        IsNewMap = True
        Select Case ComboObj.ListIndex
            Case 0, 1, 4
                    If ImgDel > 0 Then
                        For N = 1 To ImgMap.UBound
                            If ImgMap(N).Tag = "0" Then
                                CurEditImg = N
                                ImgDel = ImgDel - 1
                                ImgDel = IIf((ImgDel < 0), 0, ImgDel)
                                Exit For
                            End If
                        Next N
                    Else
                        Load ImgMap(ImgMap.Count)
                        CurEditImg = ImgMap.UBound
                    End If
                        TagImgType = ComboObj.ListIndex
                        TagImgIndex = Index
                        With ImgMap(CurEditImg)
                            .Visible = True
                            Select Case ComboObj.ListIndex
                                'Case 0, 4
                                    'PicLoad.Picture = ImageList(Index).Picture
                                    'PicLoad.Width = LoadObj.Width
                                    'PicLoad.Height = LoadObj.Height
                                    '.Picture = PicLoad.Image
                                Case 0
                                    .Picture = ImgAll0(Index).Picture
                                Case 4
                                    .Picture = ImgAll4(Index).Picture
                                Case 1
                                    .Picture = ImgAll1(Index).Picture
                                'Case Else
                                    '.Picture = ImageList(Index).Picture
                            End Select
                            .Left = IIf(ScrMap2.Visible, (ScrMap2.Value + Map.HeadMapFile.WidthTotal) \ 2, Map.HeadMapFile.WidthTotal \ 2)
                            .Top = ScrMap.Value + 200
                            .Tag = TagImgType & TagImgIndex & TagPath & TagPac
                            If Index = 0 Or Index = 1 Then .ZOrder 0
                        End With
            Case Else
                MsgBox "只有动、静态物体和背景图能放到地图上,如果需要添加包裹请选中包裹选项(除第一项外)", vbOKOnly, "编辑错误"
        End Select
            
    Else
            If IsRunning Then Exit Sub
                CurListObj = Index
                MainPic.Picture = ImageList(Index).Picture
                ReSeatMainpic
                CurrentType = ComboObj.ListIndex
                SliFps.Visible = True
                Select Case CurrentType
                    Case 0
                        EditObj = LoadObj
                        If LoadObj.AllFps <= 0 Then Exit Sub
                            If EditObj.AllFps > 1 Then SliFps.Max = EditObj.AllFps Else SliFps.Visible = False
                        'MainPic.Width = EditObj.Width * EditObj.AllFps
                        'MainPic.Height = EditObj.Height
                        RunPic.Width = EditObj.Width 'MainPic.Width / EditObj.AllFps
                    Case 1
                        EditSta = LoadSta
                            SliFps.Visible = False
                            RunPic.Width = MainPic.Width
                    Case 2
                        EditPla = LoadPla
                        RunPic.Width = EditPla.Width
                        SliFps.Max = EditPla.AllFps
                    Case 3
                    Case 4
                        EditBackObj = LoadBackObj
                        RunPic.Width = EditBackObj.Width
                        If EditBackObj.AllFps > 1 Then SliFps.Max = EditBackObj.AllFps Else SliFps.Visible = False
                    Case 5
                    Case 6
                        EditBul = LoadBul
                        SliFps.Visible = False
                        RunPic.Width = EditBul.Width
                    Case 7
                        EditMyBul = LoadMyBul
                        SliFps.Visible = False
                        RunPic.Width = EditMyBul.Width
                    Case 8
                        EditExp = LoadExp
                        RunPic.Width = EditExp.Width
                        If EditExp.AllFps > 1 Then SliFps.Max = EditExp.AllFps Else SliFps.Visible = False
                     Case 9
                        EditCra = LoadCra
                        RunPic.Width = EditCra.Width
                        If EditCra.AllFps > 1 Then SliFps.Max = EditCra.AllFps Else SliFps.Visible = False
                    Case 10
                        EditPac = LoadPac
                        RunPic.Width = EditPac.Width
                        If EditPac.AllFps > 1 Then SliFps.Max = EditPac.AllFps Else SliFps.Visible = False
                    Case 11
                        EditBom = LoadBom
                        RunPic.Width = EditBom.Width
                End Select
                RunPic.Width = RunPic.Width + 2
                RunPic.Height = MainPic.Height
    End If
If Err Then MsgBox Err.Description
End Sub
        


Private Sub ImgMap_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    ImgX = X / 15
    ImgY = Y / 15
    CurEditImg = Index
    TagImgType = Left(ImgMap(Index).Tag, 5)
    TagImgIndex = Mid(ImgMap(Index).Tag, 6, 5)
    TagPath = Mid(ImgMap(Index).Tag, 11, 2)
    TagPac = Right(ImgMap(Index).Tag, 2)
    
    OptionPath(Val(TagPath)).Value = True
    OptionPac(Val(TagPac)).Value = True
    
    With LabBack2
        .Visible = True
        .Width = ImgMap(Index).Width + 4
        .Height = ImgMap(Index).Height + 4
        .Move ImgMap(Index).Left - 2, ImgMap(Index).Top - 2
        .ZOrder 0
    End With
        If TagImgType = 0 Or TagImgType = 1 Then
            ImgMap(Index).ZOrder 0
        Else
            LabBack2.Visible = False
        End If
    
End Sub

Private Sub ImgMap_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Static Lx As Integer
Static Ly As Integer
Static LIndex As Integer
    If Button = 1 Then
        'If LIndex <> Index Then
        '    Lx = 0
        '    Ly = 0
        '    LIndex = Index
        'End If
        ImgRealX = ImgMap(Index).Left + X / 15 - ImgX
        ImgRealY = ImgMap(Index).Top + ImgMap(Index).Height + Y / 15 - ImgY
        ImgRealX = (ImgRealX \ 10) * 10
        ImgRealY = (ImgRealY \ 20) * 20
        ImgMap(Index).Move ImgRealX, ImgRealY - ImgMap(Index).Height
        IsNewMap = True
        LabBack2.Move ImgMap(Index).Left - 2, ImgMap(Index).Top - 2
        If Lx <> ImgRealX Or Ly <> ImgRealY Then
            Lx = ImgRealX
            Ly = ImgRealY
        End If
    End If
End Sub

Private Sub ImgMap_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        'mnuEditUndo.Enabled = False
        mnuEditCut.Enabled = False
        mnuEditCopy.Enabled = False
        mnuEditPaste.Enabled = False
        DelObject.Enabled = IsEditMap
        PopupMenu mnuEdit, 2
    End If
End Sub

Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True
End Sub

Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single

    If mbMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            picSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter.Left = Me.Width - sglSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If
End Sub

Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbMoving = False
    ComboObj.Width = ObjList.ScaleWidth
    SingleList.Width = ObjList.Width - ScrList.Width - 100
    
    ReSeatMainpic
    
    For N = 0 To ImageList.Count - 1
        ImageList(N).Width = SingleList.Width - 240
    Next N
    LabBack.Width = ImageList(0).Width + 100
Form_Resize