pubedit.bas

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

'Dim ProString As String        '读入词条
'    ListPro.ListItems.Clear
    '*************************************
    Select Case ObjType
        Case 0
            With ProObj
                .SaveName = CurImgIndex ' ListPro.ListItems(1).Text
                .AllFps = IIf((ListPro.ListItems(2).Text = 0), 1, ListPro.ListItems(2).Text)
                .Width = ListPro.ListItems(3).Text
                .Height = ListPro.ListItems(4).Text
                .ExplodeType = ListPro.ListItems(5).Text
                .IsFlicker = ListPro.ListItems(6).Text
                .IsRotate = ListPro.ListItems(7).Text
                .Life = NoZero(ListPro.ListItems(8).Text)
                .MaskColor = ListPro.ListItems(9).Text        ''重新设置
                .NextDelay = ListPro.ListItems(10).Text
                .NextEObject = ListPro.ListItems(11).Text
                .DelayFps = NoZero(ListPro.ListItems(12).Text)
            
                .FireSet(1).DelayFps = ListPro.ListItems(13).Text
                .FireSet(1).FireType = ListPro.ListItems(14).Text
                .FireSet(1).FireSeat.X = RT(ListPro.ListItems(15).Text, 1)
                .FireSet(1).FireSeat.Y = RT(ListPro.ListItems(15).Text, 2)
                
                .FireSet(2).DelayFps = ListPro.ListItems(16).Text
                .FireSet(2).FireType = ListPro.ListItems(17).Text
                .FireSet(2).FireSeat.X = RT(ListPro.ListItems(18).Text, 1)
                .FireSet(2).FireSeat.Y = RT(ListPro.ListItems(18).Text, 2)
                
                .FireSet(3).DelayFps = ListPro.ListItems(19).Text
                .FireSet(3).FireType = ListPro.ListItems(20).Text
                .FireSet(3).FireSeat.X = RT(ListPro.ListItems(21).Text, 1)
                .FireSet(3).FireSeat.Y = RT(ListPro.ListItems(21).Text, 2)
                .Sound = ListPro.ListItems(22)
            End With

            EditObj = ProObj
            Open CurFile For Binary As #1
                Put #1, LenHead + 1 + (CurImgIndex - 1) * Len(ProObj), ProObj
            Close #1
        Case 1
            With ProSta
                .SaveName = CurImgIndex ' ListPro.ListItems(1).Text
                .Width = ListPro.ListItems(2).Text
                .Height = ListPro.ListItems(3).Text
                .MaskColor = ListPro.ListItems(4).Text
                .Life = ListPro.ListItems(5).Text
                .IsRotate = ListPro.ListItems(6).Text
                .IsFlick = ListPro.ListItems(7).Text
                .FireSet(1).DelayFps = ListPro.ListItems(8).Text
                .FireSet(1).FireType = ListPro.ListItems(9).Text
                .FireSet(1).FireSeat.X = RT(ListPro.ListItems(10).Text, 1)
                .FireSet(1).FireSeat.Y = RT(ListPro.ListItems(10).Text, 2)
                
                .FireSet(2).DelayFps = ListPro.ListItems(11).Text
                .FireSet(2).FireType = ListPro.ListItems(12).Text
                .FireSet(2).FireSeat.X = RT(ListPro.ListItems(13).Text, 1)
                .FireSet(2).FireSeat.Y = RT(ListPro.ListItems(13).Text, 2)
                
                .FireSet(3).DelayFps = ListPro.ListItems(14).Text
                .FireSet(3).FireType = ListPro.ListItems(15).Text
                .FireSet(3).FireSeat.X = RT(ListPro.ListItems(16).Text, 1)
                .FireSet(3).FireSeat.Y = RT(ListPro.ListItems(16).Text, 2)
                .Sound = ListPro.ListItems(17)
            End With
            EditSta = ProSta
            Open CurFile For Binary As #1
                Put #1, LenHead + 1 + (CurImgIndex - 1) * Len(ProSta), ProSta
            Close #1

        Case 2
            With ProPla
                .SaveName = CurImgIndex ' ListPro.ListItems(1).Text
                .Width = ListPro.ListItems(2).Text
                .Height = ListPro.ListItems(3).Text
                .MaskColor = ListPro.ListItems(4).Text
                .Life = ListPro.ListItems(5).Text
                .AllFps = IIf((ListPro.ListItems(6).Text = 0), 1, ListPro.ListItems(6).Text)
                .ExplodeType = ListPro.ListItems(7).Text
                .FireSeatX1 = ListPro.ListItems(8).Text
                .FireSeatY1 = ListPro.ListItems(9).Text
                .FireSeatX2 = ListPro.ListItems(10).Text
                .FireSeatY2 = ListPro.ListItems(11).Text
                .Sound = ListPro.ListItems(12)
            End With
            EditPla = ProPla
            Open CurFile For Binary As #1
                Put #1, LenHead + 1 + (CurImgIndex - 1) * Len(ProPla), ProPla
            Close #1

        Case 3
        Case 4
            With ProBackObj
                .SaveName = CurImgIndex ' ListPro.ListItems(1).Text
                .Width = ListPro.ListItems(2).Text
                .Height = ListPro.ListItems(3).Text
                .MaskColor = ListPro.ListItems(4).Text
                .AllFps = IIf((ListPro.ListItems(5).Text = 0), 1, ListPro.ListItems(5).Text)
                .DelayFps = NoZero(ListPro.ListItems(6).Text)
            End With
            EditBackObj = ProBackObj
            Open CurFile For Binary As #1
                Put #1, LenHead + 1 + (CurImgIndex - 1) * Len(ProBackObj), ProBackObj
            Close #1
        Case 5
        Case 6
            With ProBul
                .SaveName = CurImgIndex ' ListPro.ListItems(1).Text
                .Width = ListPro.ListItems(2).Text
                .Height = ListPro.ListItems(3).Text
                .MaskColor = ListPro.ListItems(4).Text
                .IsRotate = ListPro.ListItems(5).Text
                .Power = IIf((ListPro.ListItems(6).Text = 0), 1, ListPro.ListItems(6).Text)
                .Sound = ListPro.ListItems(7).Text
                .TypeMove = ListPro.ListItems(8).Text
                .SpeedInit = ListPro.ListItems(9).Text
                .TailColor = ListPro.ListItems(10).Text
                .IsFollow = ListPro.ListItems(11).Text
            End With
            EditBul = ProBul
            Open CurFile For Binary As #1
                Put #1, LenHead + 1 + (CurImgIndex - 1) * Len(ProBul), ProBul
            Close #1

        Case 7
            With ProMybul
                .SaveName = CurImgIndex ' ListPro.ListItems(1).Text
                .Width = ListPro.ListItems(2).Text
                .Height = ListPro.ListItems(3).Text
                .MaskColor = ListPro.ListItems(4).Text
                .Power = IIf((ListPro.ListItems(5).Text = 0), 1, ListPro.ListItems(5).Text)
                .Sound = ListPro.ListItems(6).Text
                .IsLeftToRight = ListPro.ListItems(7).Text
            End With
            EditMyBul = ProMybul
            Open CurFile For Binary As #1
                Put #1, LenHead + 1 + (CurImgIndex - 1) * Len(ProMybul), ProMybul
            Close #1

        Case 8
            With ProExp
                .SaveName = CurImgIndex ' ListPro.ListItems(1).Text
                .Width = ListPro.ListItems(2).Text
                .Height = ListPro.ListItems(3).Text
                .MaskColor = ListPro.ListItems(4).Text
                .AllFps = IIf((ListPro.ListItems(5).Text = 0), 1, ListPro.ListItems(5).Text)
                .DelayFps = NoZero(ListPro.ListItems(6).Text)
                .Sound = ListPro.ListItems(7).Text
            End With
            EditExp = ProExp
            Open CurFile For Binary As #1
                Put #1, LenHead + 1 + (CurImgIndex - 1) * Len(ProExp), ProExp
            Close #1

        Case 9
            With ProCra
                .SaveName = CurImgIndex ' ListPro.ListItems(1).Text
                .Width = ListPro.ListItems(2).Text
                .Height = ListPro.ListItems(3).Text
                .MaskColor = ListPro.ListItems(4).Text
                .AllFps = IIf((ListPro.ListItems(5).Text = 0), 1, ListPro.ListItems(5).Text)
                .DelayFps = NoZero(ListPro.ListItems(6).Text)
                .Sound = ListPro.ListItems(7).Text
            End With
            EditCra = ProCra
            Open CurFile For Binary As #1
                Put #1, LenHead + 1 + (CurImgIndex - 1) * Len(ProCra), ProCra
            Close #1

        Case 10
            With ProPac
                .SaveName = CurImgIndex ' ListPro.ListItems(1).Text
                .Width = ListPro.ListItems(2).Text
                .Height = ListPro.ListItems(3).Text
                .MaskColor = ListPro.ListItems(4).Text
                .AllFps = IIf((ListPro.ListItems(5).Text = 0), 1, ListPro.ListItems(5).Text)
                .TypePac = ListPro.ListItems(6).Text
                .DelayFps = NoZero(ListPro.ListItems(7).Text)
                .Sound = ListPro.ListItems(8).Text
            End With
            EditPac = ProPac
            Open CurFile For Binary As #1
                Put #1, LenHead + 1 + (CurImgIndex - 1) * Len(ProPac), ProPac
            Close #1

        Case 11
            With ProBom
                .SaveName = CurImgIndex ' ListPro.ListItems(1).Text
                .Width = ListPro.ListItems(2).Text
                .Height = ListPro.ListItems(3).Text
                .MaskColor = ListPro.ListItems(4).Text
                .IsDrawType = ListPro.ListItems(5).Text
                .Sound = ListPro.ListItems(6).Text
            End With
            EditBom = ProBom
            Open CurFile For Binary As #1
                Put #1, LenHead + 1 + (CurImgIndex - 1) * Len(ProBom), ProBom
            Close #1

    End Select
If Err Then MsgBox Err.Description
End Sub
Public Function CRGB(ByVal LongColor As Long) As String
On Error GoTo EX
    Dim S As String
    Dim GN As Byte
    Dim NN As Integer
    For NN = 5 To 0 Step -1
        GN = LongColor \ (&H10) ^ NN
        LongColor = LongColor - (&H10) ^ NN * GN
        If GN <= 9 Then
            S = S & GN
        Else
            S = S & Chr(GN + 55)
        End If
    Next NN
    CRGB = "&H" & S
Exit Function
EX:
MsgBox Err.Description
CRGB = "Error Property"
End Function

Public Function RT(ByVal StrText As String, ByVal SeatXY As Byte) As Single
    Dim SD As Byte
    SD = InStr(StrText, ",")
    If SD <> 0 Then
        If SeatXY = 1 Then
            RT = Val(Left(StrText, SD - 1))
        Else
            RT = Val(Right(StrText, Len(StrText) - SD))
        End If
    Else
        MsgBox "Error Property"
    End If
End Function

Public Function IsExistFile(ByVal FileStr As String) As Boolean
On Error GoTo EX
    Open FileStr For Input As #1
    Close #1
    IsExistFile = True
    Exit Function
EX:
Close
If Err = 53 Then IsExistFile = False
End Function