Вход на сайт
Аркада Win16 27.02.2025
403
NEW 27.02.25 12:33
Всем привет! Попытаюсь сделать стрелялку на Visual Basic 4.0 под архитектуру Win16 для Windows 3.1. Но ничего не обещаю.
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
NEW 27.02.25 12:43
в ответ uscheswoi_82 27.02.25 12:33
В г. Алматы я сидел всё время дома, и занимался дизайном игры. Вот это я рисовал перед отъездом в Германию. Рисовал это всё я в обычном Paint Brush-е ну или в Microsoft Paint:
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
NEW 27.02.25 12:49
в ответ uscheswoi_82 27.02.25 12:43
Сегодня я где-то 2 часа потратил чтобы сделать это всё сделать в программе Blender 2.79. Это то, что у меня получилось:
Это оригинальный скрин:
Покуда в графической оболочки Windows 3.1 чаще всего максимум 16 цветов, поэтому было уменьшено до 16 цветов:
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
27.02.25 13:06
в ответ uscheswoi_82 27.02.25 12:49
Короче из окон должен появлятся слкчайно чувaчёк или одновременно несколько чувачкoв, , по которым нужно было cтрeлять. Когда попадаешь, получаешь oчки. Я рисовал чyвочка с ceбя, мoя мaть в Гepмaнии купила видеокамеру Panasonic и фотоаппарат Canon, я фотол сeбя спомощью видеокамеры Panasonic, дело в том, что камера подключалась через COM-порт, и сохраняла фотографии в формате JPEG на SD-карту:
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
NEW 27.02.25 13:18
в ответ uscheswoi_82 27.02.25 13:15
Вот код на 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Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
NEW 27.02.25 16:29
в ответ uscheswoi_82 27.02.25 13:39
Я переделал игру тараканьи бега см. Тараканьи бега 09.05.2024 под Win16 / Windows 3.11. Писал на Visual Basic 4.0 :
Вот так выглядет проект:
Вот так выглядет диалоговое окно игры:
Алгоритм frmGame.frm:
Attribute VB_Name = "frmGame"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim stavka_tarakan As Integer
Const cnt_tarakany As Integer = 5
Private Sub cmdStart_Click()
On Error Resume Next
Do While Not (stavka_tarakan >= 1 And stavka_tarakan <= 6)
stavka_tarakan = CInt(InputBox("Which tarakan (1-6)?"))
Loop
lbTarakan(stavka_tarakan).ForeColor = vbRed
cmdStart.Enabled = False
cmdStop.Enabled = True
tmTimer.Enabled = True
tmTimer.Interval = 100
End Sub
Private Sub cmdStop_Click()
Dim i As Integer
tmTimer.Enabled = False
tmTimer.Interval = 0
For i = 0 To cnt_tarakany
lbTarakan(i).Left = 8
lbTarakan(i).ForeColor = vbBlack
Next i
stavka_tarakan = 0
End Sub
Private Sub Form_Load()
Randomize Timer
cmdStart.Enabled = False
cmdStop.Enabled = False
End Sub
Private Sub popupAbout_Click()
MsgBox "Author uscheswoi_82", vbOKOnly + vbInformation
End Sub
Private Sub popupNewGame_Click()
tmTimer.Enabled = False
cmdStart.Enabled = True
cmdStop.Enabled = True
tarakan_stavka = 0
End Sub
Private Sub popupQuit_Click()
Unload Me
End Sub
Private Sub tmTimer_Timer()
Dim i As Integer
For i = 0 To cnt_tarakany
Move_Tarakan lbTarakan(i), Int((10 * Rnd()) + 1)
If get_position_tarakan(lbTarakan(i)) >= lbFinish.Left Then
If stavka_tarakan = i Then
tmTimer.Interval = 0
tmTimer.Enabled = False
MsgBox "You Won!"
Exit Sub
Else
tmTimer.Interval = 0
tmTimer.Enabled = False
MsgBox "You Lose!"
Exit Sub
End If
End If
Next i
End Sub
Алгоритм modMain.bas:
Attribute VB_Name = "modMain"
Public Function get_position_tarakan(tarakan_id As Label)
get_position_tarakan = tarakan_id.Left
End Function
Public Sub Move_Tarakan(id As Label, step As Integer)
id.Left = id.Left + step
End Sub
Вуаля! А вот так игра работает:
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
NEW 28.02.25 19:17
в ответ 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
Вот так выглядет проект:
Вуаля! А вот и результат...
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
NEW 01.03.25 07:51
в ответ uscheswoi_82 28.02.25 19:17
Вот так игра работает со звуком https://my.mail.ru/mail/semyon_kulikov/video/_myvideo/72.h..., а это игра тараканы https://my.mail.ru/mail/semyon_kulikov/video/_myvideo/73.h....
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
NEW 01.03.25 08:07
в ответ uscheswoi_82 01.03.25 07:51
Полный код frmgame.frm:
VERSION 4.00
Begin VB.Form frmGame
BorderStyle = 1 'Fixed Single
Caption = "Tarakany 1.0"
ClientHeight = 3600
ClientLeft = 1590
ClientTop = 2955
ClientWidth = 4800
Height = 4335
Icon = "FRMGAME.frx":0000
Left = 1530
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 240
ScaleMode = 3 'Pixel
ScaleWidth = 320
Top = 2280
Width = 4920
Begin VB.Timer tmTimer
Enabled = 0 'False
Left = 3720
Top = 2640
End
Begin VB.Label lbFinish
BackStyle = 0 'Transparent
Height = 1935
Left = 4320
TabIndex = 8
Top = 120
Width = 135
End
Begin Threed.SSCommand cmdStop
Height = 495
Left = 1680
TabIndex = 7
Top = 2280
Width = 1455
_version = 65536
_extentx = 2566
_extenty = 873
_stockprops = 78
caption = "S&top"
End
Begin Threed.SSCommand cmdStart
Height = 495
Left = 120
TabIndex = 6
Top = 2280
Width = 1455
_version = 65536
_extentx = 2566
_extenty = 873
_stockprops = 78
caption = "&Start"
End
Begin VB.Label lbTarakan
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "x"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 300
Index = 5
Left = 120
TabIndex = 5
Top = 1800
Width = 135
End
Begin VB.Label lbTarakan
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "x"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 300
Index = 4
Left = 120
TabIndex = 4
Top = 1380
Width = 135
End
Begin VB.Label lbTarakan
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "x"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 300
Index = 3
Left = 120
TabIndex = 3
Top = 1020
Width = 135
End
Begin VB.Label lbTarakan
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "x"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 300
Index = 2
Left = 120
TabIndex = 2
Top = 690
Width = 135
End
Begin VB.Label lbTarakan
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "x"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 300
Index = 1
Left = 120
TabIndex = 1
Top = 390
Width = 135
End
Begin VB.Label lbTarakan
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "x"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 12
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 300
Index = 0
Left = 120
TabIndex = 0
Top = 105
Width = 135
End
Begin VB.Shape Shape1
BackColor = &H00004080&
BackStyle = 1 'Opaque
BorderStyle = 0 'Transparent
Height = 1935
Left = 120
Top = 120
Width = 4455
End
Begin VB.Menu mnuGame
Caption = "&Game"
Begin VB.Menu popupNewGame
Caption = "&New game"
End
Begin VB.Menu n1
Caption = "-"
End
Begin VB.Menu popupQuit
Caption = "&Quit"
End
End
Begin VB.Menu mnuHelp
Caption = "&Help"
Begin VB.Menu popupRules
Caption = "&Rules"
Shortcut = {F1}
End
Begin VB.Menu N2
Caption = "-"
End
Begin VB.Menu popupAbout
Caption = "&About..."
End
End
End
Attribute VB_Name = "frmGame"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim stavka_tarakan As Integer
Const cnt_tarakany As Integer = 5
Private Sub cmdStart_Click()
On Error Resume Next
Do While Not (stavka_tarakan >= 1 And stavka_tarakan <= 6)
stavka_tarakan = CInt(InputBox("Which tarakan (1-6)?"))
Loop
lbTarakan(stavka_tarakan).ForeColor = vbRed
cmdStart.Enabled = False
cmdStop.Enabled = True
tmTimer.Enabled = True
tmTimer.Interval = 100
End Sub
Private Sub cmdStop_Click()
Dim i As Integer
tmTimer.Enabled = False
tmTimer.Interval = 0
For i = 0 To cnt_tarakany
lbTarakan(i).Left = 8
lbTarakan(i).ForeColor = vbBlack
Next i
stavka_tarakan = 0
End Sub
Private Sub Form_Load()
Randomize Timer
cmdStart.Enabled = False
cmdStop.Enabled = False
End Sub
Private Sub popupAbout_Click()
MsgBox "Author uscheswoi_82", vbOKOnly + vbInformation
End Sub
Private Sub popupNewGame_Click()
tmTimer.Enabled = False
cmdStart.Enabled = True
cmdStop.Enabled = True
tarakan_stavka = 0
End Sub
Private Sub popupQuit_Click()
Unload Me
End Sub
Private Sub tmTimer_Timer()
Dim i As Integer
For i = 0 To cnt_tarakany
Move_Tarakan lbTarakan(i), Int((10 * Rnd()) + 1)
If get_position_tarakan(lbTarakan(i)) >= lbFinish.Left Then
If stavka_tarakan = i Then
tmTimer.Interval = 0
tmTimer.Enabled = False
MsgBox "You Won!"
Exit Sub
Else
tmTimer.Interval = 0
tmTimer.Enabled = False
MsgBox "You Lose!"
Exit Sub
End If
End If
Next i
End Sub
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
назад
список