skymain.frm

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

                    ObjBac(SeatX).Width = LoadObj(SeatX).Width * LoadObj(SeatX).AllFps
                    ObjBac(SeatX).Height = LoadObj(SeatX).Height
                    
            Call CFB(PicLoad, ObjBuf(SeatX), ObjBac(SeatX), LoadObj(SeatX).MaskColor)
            LoadObj(SeatX).HdcE = ObjBuf(SeatX).Hdc
            LoadObj(SeatX).HdcBack = ObjBac(SeatX).Hdc
        Next SeatX
End Sub

Private Sub LoadStaticObject()
On Error Resume Next
    Open App.Path & "\StaticEObj\All.con" For Binary As #1
            Get #1, Len(HeadStr) + 1, AllCon
            MaxLoadSta = AllCon
            
        ReDim LoadSta(1 To AllCon)
            Get #1, LenHead + 1, LoadSta
    Close #1
        For SeatX = 1 To AllCon
            Load StaBuf(SeatX)
            Load StaBac(SeatX)
            PicLoad.Picture = LoadPicture(App.Path & "\StaticEObj\" & SeatX & ".ebj")
                    StaBuf(SeatX).Width = LoadSta(SeatX).Width
                    StaBuf(SeatX).Height = LoadSta(SeatX).Height
                    StaBac(SeatX).Width = LoadSta(SeatX).Width
                    StaBac(SeatX).Height = LoadSta(SeatX).Height
                    LoadSta(SeatX).RotateWidth = Sqr(LoadSta(SeatX).Width ^ 2 + LoadSta(SeatX).Height ^ 2)
                    
            If (Not LoadSta(SeatX).IsRotate) And LoadSta(SeatX).IsFlick = 0 Then
                Call CFB(PicLoad, StaBuf(SeatX), StaBac(SeatX), LoadSta(SeatX).MaskColor)
            Else
                Select Case RunEffect
                    Case 1, 3
                        StaBac(SeatX).Picture = PicLoad.Picture
                    Case 2
                        Call CRotateFB(PicLoad, StaBuf(SeatX), StaBac(SeatX), LoadSta(SeatX).MaskColor, LoadSta(SeatX).Width, LoadSta(SeatX).Height, LoadSta(SeatX).RotateWidth)
                        
                End Select
            End If
            LoadSta(SeatX).HdcE = StaBuf(SeatX).Hdc
            LoadSta(SeatX).HdcBack = StaBac(SeatX).Hdc
        Next SeatX
End Sub
Private Sub LoadBackObject()
On Error Resume Next
    Open App.Path & "\BStaObject\All.con" For Binary As #1
            Get #1, Len(HeadStr) + 1, AllCon
            MaxLoadBackObj = AllCon
            
        ReDim LoadBackObj(1 To AllCon)
            Get #1, LenHead + 1, LoadBackObj
    Close #1
        For SeatX = 1 To AllCon
            Load BackObjBuf(SeatX)
            Load BackObjBac(SeatX)
            PicLoad.Picture = LoadPicture(App.Path & "\BStaObject\" & SeatX & ".ebj")
                    BackObjBuf(SeatX).Width = LoadBackObj(SeatX).Width * LoadBackObj(SeatX).AllFps
                    BackObjBuf(SeatX).Height = LoadBackObj(SeatX).Height
                    BackObjBac(SeatX).Width = LoadBackObj(SeatX).Width * LoadBackObj(SeatX).AllFps
                    BackObjBac(SeatX).Height = LoadBackObj(SeatX).Height
            Call CFB(PicLoad, BackObjBuf(SeatX), BackObjBac(SeatX), LoadBackObj(SeatX).MaskColor)
            LoadBackObj(SeatX).HdcE = BackObjBuf(SeatX).Hdc
            LoadBackObj(SeatX).HdcBack = BackObjBac(SeatX).Hdc
        Next SeatX
End Sub
Private Sub LoadBullet()
On Error Resume Next
    Open App.Path & "\Bullet\All.con" For Binary As #1
            Get #1, Len(HeadStr) + 1, AllCon
            MaxLoadBul = AllCon
            
        ReDim LoadBul(1 To AllCon)
            Get #1, LenHead + 1, LoadBul
    Close #1
        For SeatX = 1 To AllCon
            Load BulBuf(SeatX)
            Load BulBac(SeatX)
            PicLoad.Picture = LoadPicture(App.Path & "\Bullet\" & SeatX & ".ebj")
            
                BulBuf(SeatX).Width = LoadBul(SeatX).Width
                BulBuf(SeatX).Height = LoadBul(SeatX).Height
                BulBac(SeatX).Width = LoadBul(SeatX).Width
                BulBac(SeatX).Height = LoadBul(SeatX).Height
                LoadBul(SeatX).RotateWidth = Sqr(LoadBul(SeatX).Width ^ 2 + LoadBul(SeatX).Height ^ 2)
                
            If Not LoadBul(SeatX).IsRotate Then
                Call CFB(PicLoad, BulBuf(SeatX), BulBac(SeatX), LoadBul(SeatX).MaskColor)
            Else
                Select Case RunEffect
                    Case 1, 3
                        BulBac(SeatX).Picture = PicLoad.Picture
                    Case 2
                        Call CRotateFB(PicLoad, BulBuf(SeatX), BulBac(SeatX), LoadBul(SeatX).MaskColor, LoadBul(SeatX).Width, LoadBul(SeatX).Height, LoadBul(SeatX).RotateWidth, 18)
                End Select
            End If
            LoadBul(SeatX).HdcE = BulBuf(SeatX).Hdc
            LoadBul(SeatX).HdcBack = BulBac(SeatX).Hdc
        Next SeatX

End Sub

Private Sub LoadMyBullet()
On Error Resume Next
    Open App.Path & "\MyBullet\All.con" For Binary As #1
            Get #1, Len(HeadStr) + 1, AllCon
            MaxLoadMyBul = AllCon
            
        ReDim LoadMyBul(1 To AllCon)
            Get #1, LenHead + 1, LoadMyBul
    Close #1
        For SeatX = 1 To AllCon
            Load MyBulBuf(SeatX)
            Load MyBulBac(SeatX)
            PicLoad.Picture = LoadPicture(App.Path & "\MyBullet\" & SeatX & ".ebj")
            
                    MyBulBuf(SeatX).Width = LoadMyBul(SeatX).Width
                    MyBulBuf(SeatX).Height = LoadMyBul(SeatX).Height
                    MyBulBac(SeatX).Width = LoadMyBul(SeatX).Width
                    MyBulBac(SeatX).Height = LoadMyBul(SeatX).Height
                
            Call CFB(PicLoad, MyBulBuf(SeatX), MyBulBac(SeatX), LoadMyBul(SeatX).MaskColor)
            
            If LoadMyBul(SeatX).IsLeftToRight Then
                Call MyBulLeftToRight(MyBulBuf(SeatX))
                Call MyBulLeftToRight(MyBulBac(SeatX))
            End If
            
            LoadMyBul(SeatX).HdcE = MyBulBuf(SeatX).Hdc
            LoadMyBul(SeatX).HdcBack = MyBulBac(SeatX).Hdc
        Next SeatX

End Sub

Private Sub LoadExplode()
On Error Resume Next
    Open App.Path & "\Explode\All.con" For Binary As #1
            Get #1, Len(HeadStr) + 1, AllCon
            MaxLoadExp = AllCon
            
        ReDim LoadExp(1 To AllCon)
            Get #1, LenHead + 1, LoadExp
    Close #1
    For SeatX = 1 To AllCon
        Load ExpBuf(SeatX)
        Load ExpBac(SeatX)
        PicLoad.Picture = LoadPicture(App.Path & "\Explode\" & SeatX & ".ebj")
        
                ExpBuf(SeatX).Width = LoadExp(SeatX).Width * LoadExp(SeatX).AllFps
                ExpBuf(SeatX).Height = LoadExp(SeatX).Height
                ExpBac(SeatX).Width = LoadExp(SeatX).Width * LoadExp(SeatX).AllFps
                ExpBac(SeatX).Height = LoadExp(SeatX).Height
                
        Call CFB(PicLoad, ExpBuf(SeatX), ExpBac(SeatX), LoadExp(SeatX).MaskColor)
        LoadExp(SeatX).HdcE = ExpBuf(SeatX).Hdc
        LoadExp(SeatX).HdcBack = ExpBac(SeatX).Hdc
    Next SeatX

End Sub

Private Sub LoadCrash()
On Error Resume Next
    Open App.Path & "\Crash\All.con" For Binary As #1
            Get #1, Len(HeadStr) + 1, AllCon
            MaxLoadCra = AllCon
            
        ReDim LoadCra(1 To AllCon)
            Get #1, LenHead + 1, LoadCra
    Close #1
    For SeatX = 1 To AllCon
        Load CraBuf(SeatX)
        Load CraBac(SeatX)
        PicLoad.Picture = LoadPicture(App.Path & "\Crash\" & SeatX & ".ebj")
        
                CraBuf(SeatX).Width = LoadCra(SeatX).Width * LoadCra(SeatX).AllFps
                CraBuf(SeatX).Height = LoadCra(SeatX).Height
                CraBac(SeatX).Width = LoadCra(SeatX).Width * LoadCra(SeatX).AllFps
                CraBac(SeatX).Height = LoadCra(SeatX).Height
                
        Call CFB(PicLoad, CraBuf(SeatX), CraBac(SeatX), LoadCra(SeatX).MaskColor)
        LoadCra(SeatX).HdcE = CraBuf(SeatX).Hdc
        LoadCra(SeatX).HdcBack = CraBac(SeatX).Hdc
    Next SeatX

End Sub
Private Sub LoadPackage()
On Error Resume Next
    Open App.Path & "\Package\All.con" For Binary As #1
            Get #1, Len(HeadStr) + 1, AllCon
            MaxLoadPac = AllCon
            
        ReDim LoadPac(1 To AllCon)
            Get #1, LenHead + 1, LoadPac
    Close #1
    For SeatX = 1 To AllCon
        Load PacBuf(SeatX)
        Load PacBac(SeatX)
        PicLoad.Picture = LoadPicture(App.Path & "\Package\" & SeatX & ".ebj")
        
                PacBuf(SeatX).Width = LoadPac(SeatX).Width * LoadPac(SeatX).AllFps
                PacBuf(SeatX).Height = LoadPac(SeatX).Height
                PacBac(SeatX).Width = LoadPac(SeatX).Width * LoadPac(SeatX).AllFps
                PacBac(SeatX).Height = LoadPac(SeatX).Height
                
        Call CFB(PicLoad, PacBuf(SeatX), PacBac(SeatX), LoadPac(SeatX).MaskColor)
        LoadPac(SeatX).HdcE = PacBuf(SeatX).Hdc
        LoadPac(SeatX).HdcBack = PacBac(SeatX).Hdc
    Next SeatX

End Sub

Private Sub CFB(ByVal BasicPic As PictureBox, ByVal ForePic As PictureBox, ByVal BackPic As PictureBox, ByVal MaskColorFox As Long)
    Dim FoxHand As Long
    FoxHand = FoxxCreateFastMask(BasicPic.Hdc, 0, 0, BasicPic.Width, BasicPic.Height, 0, 0, MaskColorFox, 1)
        FoxxFastMask ForePic.Hdc, 0, 0, FoxHand
        FoxxFastMask BackPic.Hdc, 0, 0, FoxHand
    FoxxDeleteMask FoxHand
End Sub

Private Sub CRotateFB(ByVal BasicPic As PictureBox, ByVal ForePic As PictureBox, ByVal BackPic As PictureBox, ByVal MaskColorRotate As Long, ByVal Width As Single, ByVal Height As Single, ByVal RotWid As Integer, Optional ByVal RotTimes As Byte = 36)
Dim CurCAngle As Integer
    ForePic.Height = RotWid
    ForePic.Width = RotWid * RotTimes
    BackPic.Height = RotWid
    BackPic.Width = RotWid * RotTimes
    For N = 0 To RotTimes - 1
        FoxRotate ForePic.Hdc, N * RotWid + RotWid \ 2, RotWid \ 2, BasicPic.Width, BasicPic.Height, BasicPic.Hdc, 0, 0, N * 10, MaskColorRotate, BufEffect * 2 + 1 '' BAD ' GOOD '
        FoxRotate BackPic.Hdc, N * RotWid + RotWid \ 2, RotWid \ 2, BasicPic.Width, BasicPic.Height, BasicPic.Hdc, 0, 0, N * 10, MaskColorRotate, BufEffect * 2 + 1 '' BAD ' GOOD '
    Next N

End Sub
''************水平翻转
Public Sub MyBulLeftToRight(BulPic As PictureBox)
    BulPic.Width = BulPic.Width * 2
    BulPic.Picture = BulPic.Image
    BulPic.PaintPicture BulPic.Picture, BulPic.Width \ 2, 0, BulPic.Width \ 2, BulPic.Height, BulPic.Width \ 2, 0, -BulPic.Width \ 2, BulPic.Height
    
End Sub

'Private Function NoZero(ByVal CValue)
'    NoZero = IIf(CValue = 0, 1, CValue)
'End Function


''''''''''''''
Public Sub LoadRandomPic()
On Error Resume Next
Dim HB As Long
Dim RectPic As RECT
    N = 1
    Do While Map.HeadMapFile.RandomPicture(N) > 0
        Load PicLoadRnd(N)
        PicLoadRnd(N).Picture = LoadPicture(App.Path & "\RandomPic\" & Map.HeadMapFile.RandomPicture(N) & ".ebj")
        N = N + 1
    Loop
    MaxLoadRandom = N - 1
    If N > 1 Then ReDim PicRandom(1 To N - 1)
    For N = 1 To MaxLoadRandom
        PicRandom(N).HdcL = PicLoadRnd(N).Hdc
        PicRandom(N).Width = PicLoadRnd(N).Width
        PicRandom(N).Height = PicLoadRnd(N).Height
    Next N

    'PicLoad.Picture = LoadPicture(App.Path & "\RandomPic\" & Map.HeadMapFile.RandomPicture(1) & ".ebj")
    If Map.HeadMapFile.IsRandom Then
        With RectPic
            .Top = 0
            .Left = 0
            .Bottom = MapRandom.Height
            .Right = MapRandom.Width
        End With
        HB = CreatePatternBrush(PicLoadRnd(1).Picture)
        'Call SelectObject(HdcMapRandom, HB)
        Call FillRect(HdcMapRandom, RectPic, HB)
        Call DeleteObject(HB)
    End If
End Sub

Public Sub LoadScore()
On Error Resume Next
Dim S As String
Dim SS As Byte
    Open App.Path & "\ListPro\ListScore.ini" For Input As #1
        Line Input #1, S
    Close #1
    SS = 21
    For N = 1 To Len(S)
        If Asc(Mid(S, N, 1)) < 0 Then SS = SS - 1
    Next N
    LoadHighScore = Val(Mid(S, SS, 10))
End Sub
Public Sub LoadMusic()
On Error Resume Next
Open App.Path & "\Music\MusicList.TXT" For Input As #1
    N = 0
    Do While Not EOF(1)
        N = N + 1
        ReDim Preserve LoadMusicList(N)
        Line Input #1, LoadMusicList(N)
    Loop
Close #1
End Sub

Private Sub TimerMain_Timer()
Dim IsStartPlay As Boolean
If IsUnloadAll Then Exit Sub
    MainTime = MainTime + 1
    If MainTime = 1000 Then
        IsPlaying = False
        PicShowScore.Visible = False
        PicView.Visible = False
        Picture1.Picture = LoadPicture(App.Path & "\ListPro\StartWar.ico")
        'SavePicture Picture1.Picture, "c:\windows\desktop\pic.bmp"
        'Stop
        Picture2.Width = Picture1.Width
        Picture2.Height = Picture1.Height
        Picture3.Width = Picture1.Width
        Picture3.Height = Picture1.Height
        Picture4.Width = 640
        Picture4.Height = 480
        Call StartDemoPlay(Picture4, Picture1, Picture4.Hdc, Picture3.Hdc, Picture2.Hdc, Picture1.Hdc, Me.ScaleWidth \ 2, Me.ScaleHeight \ 2, Picture1.Width, Picture1.Height, &HFF00FF, &H400000, 30, 3)
        If IsUnloadAll Then Unload FrmMain: Exit Sub ''这是结束程序的可能的最后一个过程
                                    ''加上一个unload frmmain的理由，请看
                                    ''Frmmain的form_load过程开始
                                    ''事实上如果frmmain之前已经卸载，并不会运行form_unload过程
                                    ''所以并没什么影响
    End If
    If IsBeforeStart Then
        'IsStartPlay = StartSky.StopPlay()
        If Not IsStartPlay Then
            MainTime = 0
            IsBeforeStart = False
            TimerMain.Enabled = False
            Picture1.Picture = Nothing
            PicView.Visible = True
            Call Play
        End If
    End If
End Sub