Вход на сайт
Аркада Win16 27.02.2025
584 просмотров
Перейти к просмотру всей ветки
Назад
в ответ uscheswoi_82 27.02.25 17:40
Короче сделал я стрелялку простую.
Вот код frmmain.frm:
VERSION 4.00
Begin VB.Form frmKiller
BackColor = &H00000000&
Caption = "Killer"
ClientHeight = 7200
ClientLeft = 1005
ClientTop = 1815
ClientWidth = 9600
Height = 7935
Left = 945
LinkTopic = "Form1"
MouseIcon = "FRMKILLE.frx":0000
MousePointer = 99 'Custom
Picture = "FRMKILLE.frx":0152
ScaleHeight = 480
ScaleMode = 3 'Pixel
ScaleWidth = 640
Top = 1140
Width = 9720
Begin VB.PictureBox picNN
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 495
Left = 3240
Picture = "FRMKILLE.frx":1C3D4
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 21
Top = 5640
Visible = 0 'False
Width = 285
End
Begin VB.PictureBox picK1
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 495
Left = 3840
Picture = "FRMKILLE.frx":1C5E2
ScaleHeight = 495
ScaleWidth = 285
TabIndex = 20
Top = 5640
Visible = 0 'False
Width = 285
End
Begin VB.PictureBox picK0
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 495
Left = 4320
Picture = "FRMKILLE.frx":1CDE0
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 19
Top = 5640
Visible = 0 'False
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 17
Left = 6750
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 18
Top = 3120
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 16
Left = 5790
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 17
Top = 3120
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 15
Left = 4815
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 16
Top = 3120
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 14
Left = 3840
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 15
Top = 3120
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 13
Left = 2880
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 14
Top = 3120
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 12
Left = 1920
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 13
Top = 3120
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 11
Left = 6750
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 12
Top = 2160
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 10
Left = 5790
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 11
Top = 2160
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 9
Left = 4815
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 10
Top = 2160
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 8
Left = 3840
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 9
Top = 2160
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 7
Left = 2880
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 8
Top = 2160
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 6
Left = 1920
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 7
Top = 2160
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 5
Left = 6750
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 6
Top = 1200
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 4
Left = 5790
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 5
Top = 1200
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 3
Left = 4815
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 4
Top = 1200
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 2
Left = 3840
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 3
Top = 1200
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 1
Left = 2880
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 2
Top = 1200
Width = 285
End
Begin VB.PictureBox picKiller
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Index = 0
Left = 1920
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 19
TabIndex = 1
Top = 1200
Width = 285
End
Begin VB.Timer tmTimerScore
Left = 5160
Top = 5640
End
Begin VB.Timer tmTimer
Left = 5640
Top = 5640
End
Begin VB.Label lbScore
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Scores:0 Lives:5"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 13.5
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 360
Left = 120
TabIndex = 0
Top = 5640
Width = 2310
End
Begin VB.Menu mnuGame
Caption = "&Game"
Begin VB.Menu popupNewGame
Caption = "&New game"
Shortcut = ^N
End
Begin VB.Menu popupQuit
Caption = "&Quit"
Shortcut = ^Q
End
End
Begin VB.Menu mnuHelp
Caption = "&Help"
Begin VB.Menu popupAbout
Caption = "&About..."
End
End
End
Attribute VB_Name = "frmKiller"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim intScores As Integer
Dim intLives As Integer
Dim intKillerWindows As Integer
Const cintWindows As Integer = 17
'Показывает киллера
Private Sub show_killer()
Dim i As Integer
'Прячим все окошки
For i = 0 To cintWindows
picKiller(i).Picture = picNN.Picture
Next i
intKillerWindows = Int((cintWindows * Rnd()) + 1) 'Ищет случайное окошко в здание от 17 до 1
picKiller(intKillerWindows).Picture = picK0 'Отображает спрайт киллера в окошке в здание
tmTimer.Enabled = True 'Таймет запускаем чтобы киллер застрелил
tmTimer.Interval = 2000
End Sub
'Показывает стреляющего киллера, если пользователь промазал
Private Sub show_killed()
picKiller(intKillerWindows).Picture = picK1.Picture 'В окошко в здание добавляем спрайт киллера который стрелят
sndPlaySound App.Path & "\explode.wav", SND_ASYNC 'Проигрывает звук взрыва
'Если жизней ещё больше 0, то вычитаем жизнь
If intLives > 0 Then
intLives = intLives - 1
End If
tmTimer.Enabled = False
End Sub
Private Sub Form_Load()
Randomize Timer
Dim i As Integer
tmTimer.Enabled = False
tmTimer.Interval = 0
tmTimerScore.Enabled = True
tmTimerScore.Interval = 100
'Окошки в здание чёрного цвета
For i = 0 To cintWindows
picKiller(i).BackColor = vbBlack
Next i
End Sub
'Если пользователь нажал на окошки
Private Sub picKiller_Click(Index As Integer)
tmTimer.Enabled = False 'Останавливаем таймер
'Если пользователь попад в окошко где находится киллер
If intKillerWindows = Index Then
intScores = intScores + 10
picKiller(Index).Picture = picNN.Picture
Else
If intLives > 0 Then
intLives = intLives - 1
End If
End If
sndPlaySound App.Path & "\gunshot.wav", SND_ASYNC 'Проигрывает звук выстрела из пистолета
show_killer 'Показывает спрайт киллера
End Sub
Private Sub popupAbout_Click()
MsgBox "Author uscheswoi_82", vbOKOnly + vbInformation
End Sub
Private Sub popupNewGame_Click()
intScores = 0
intLives = 5
intKillerWindows = -1
'Показывает киллера в случайном окошке в здание
show_killer
End Sub
Private Sub popupQuit_Click()
Unload Me
End Sub
'Таймер для отображение киллера
Private Sub tmTimer_Timer()
show_killed 'Показываем киллера
int_lives = int_lives - 1 'Вычитаем жизнь
End Sub
'Таймер для отображение очков и жизний
Private Sub tmTimerScore_Timer()
Me.lbScore.Caption = "Score:" & intScores & " Lives:" & intLives
End Sub
Вот код modmain.bas:
Attribute VB_Name = "modMain" Public Const SND_ASYNC = &H1 ' Asynchrones Abspielen Public Declare Function sndPlaySound Lib "MMSYSTEM" (ByVal lpszSoundName As String, ByVal uFlags As Integer) As Integer
Вот так выглядет проект:
Вуаля! А вот и результат...
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение