русский

Аркада Win16 27.02.2025

27.02.25 13:18
Re: Аркада Win16 27.02.2025
 
uscheswoi_82 патриот

Вот код на Visual Basic 6.0, да я использовал DirectX 7, см (27.11.2003 17:35):

Option Explicit
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long
Const SND_ASYNC = &H1         '  play asynchronously
Const SND_SYNC = &H0         '  play synchronously (default)
Dim i As Long, n As Long, res As Long
Dim what_cols(10) As Boolean
Dim col As Long, curr As Long
Dim scores As Long, Lives As Long
Dim ObjDx As DirectX7
Dim ObjDraw As DirectDraw7

Private Sub Form_Load()
Dim j As Long
    Set ObjDx = New DirectX7
    Set ObjDraw = ObjDx.DirectDrawCreate("")
    ObjDraw.SetCooperativeLevel frmLevel0.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE
    ObjDraw.SetDisplayMode 640, 480, 16, 0, DDSDM_DEFAULT
    Lives = 5
    Me.Picture = LoadPicture(App.Path & "\bgpic.img")
    Me.MouseIcon = Me.picCursor.Picture
    For j = 0 To Me.PictWindows.Count - 1
        Me.PictWindows(j).Visible = True
        Me.PictWindows(j).Picture = Me.picWindow
        Me.PictWindows(j).MouseIcon = Me.picCursor.Picture
        what_cols(j) = False
    Next j
    col = 1
    Timer1.Interval = 1000
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    sndPlaySound App.Path & "\gunshot.wav", SND_ASYNC
    Me.PSet (X, Y), vbBlack
    Me.PSet (X + 1, Y), vbBlack
    Me.PSet (X, Y + 1), vbBlack
    Me.PSet (X + 1, Y + 1), vbBlack
    scores = scores - 10
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Timer2.Enabled = False
End Sub

Private Sub lbClose_Click()
    Unload Me
End Sub

Private Sub PictWindows_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim j As Long
    sndPlaySound App.Path & "\gunshot.wav", SND_ASYNC
    If what_cols(Index) = True Then
        scores = scores + 10
        Timer2.Enabled = False
    Else
        scores = scores - 10
    End If
    For j = 0 To Me.PictWindows.Count - 1
        Me.PictWindows(j).Visible = True
        Me.PictWindows(j).Picture = Me.picWindow
        Me.PictWindows(j).MouseIcon = Me.picCursor.Picture
    Next j
End Sub

Private Sub PictWindows_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Timer2.Enabled = True
    Timer2.Interval = Timer1.Interval + 100
    curr = Index
End Sub

Private Sub PictWindows_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim j As Long
    For j = 0 To Me.PictWindows.Count - 1
        what_cols(j) = False
    Next j
End Sub

Private Sub Timer1_Timer()
Dim j As Long
    For j = 0 To Me.PictWindows.Count - 1
        Me.PictWindows(j).Visible = True
        Me.PictWindows(j).Picture = Me.picWindow
        Me.PictWindows(j).MouseIcon = Me.picCursor.Picture
    Next j

    For i = 1 To col
        res = Int(Rnd * 9)
        Me.PictWindows(res) = Me.picSoldat.Picture
        what_cols(res) = True
    Next i

    For j = 0 To 5000
        Sin 0.5
        Timer1.Enabled = False
    Next j
    Timer1.Enabled = True
    Me.Label1.Caption = "Очки:" & scores & "  Жизней:" & Lives
End Sub

Private Sub Timer2_Timer()
Dim j As Long
    Me.PictWindows(res).Picture = Me.picSoldat.Picture
    Timer2.Enabled = False
    sndPlaySound App.Path & "\explode.wav", SND_ASYNC
    Me.PictWindows(res) = Me.picSoldatFire.Picture
    Lives = Lives - 1
End Sub
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
 

Sprung zu