Вход на сайт
2D движок на VB 6.0 30.05.2025
684
30.05.25 23:32
Последний раз изменено 30.05.25 23:36 (uscheswoi_82)
Всем привет!
Решил создать 2D движок на VB 6.0, чтобы создавать 2D игры.
Файл ctlSprite.ctl:
VERSION 5.00
Begin VB.UserControl Sprite
AutoRedraw = -1 'True
ClientHeight = 510
ClientLeft = 0
ClientTop = 0
ClientWidth = 495
ScaleHeight = 34
ScaleMode = 3 'Pixel
ScaleWidth = 33
Begin VB.PictureBox picBackground
AutoRedraw = -1 'True
BackColor = &H0000FFFF&
BorderStyle = 0 'None
Height = 495
Left = 3720
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 41
TabIndex = 2
Top = 2040
Visible = 0 'False
Width = 615
End
Begin VB.Timer tmCollisionDetect
Left = 960
Top = 1320
End
Begin VB.PictureBox picSpriteMask
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
Height = 495
Left = 2880
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 33
TabIndex = 1
Top = 2040
Visible = 0 'False
Width = 495
End
Begin VB.PictureBox picSprite
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 495
Left = 1800
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 41
TabIndex = 0
Top = 2040
Visible = 0 'False
Width = 615
End
Begin VB.Image Image1
Height = 480
Left = 0
Picture = "ctlSprite.ctx":0000
Top = 0
Width = 480
End
End
Attribute VB_Name = "Sprite"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private bInitSprite As Boolean 'Инициализация спрайта?
Private bInitBackground As Boolean 'Инициализация фона?
Private strSpriteFilename As String 'Имя файла спрайта
Private strMaskSpriteFilename As String 'Имя файла маски спрайта
Private strBackgroundFilename As String 'Имя файла фона
Private strSoundFileName As String 'Имя файла для проигрывания аудиофайла
Private strBackgroundMusic As String 'Фоновая музыка
Private intSpriteX As Integer 'Горизонтальная позиция спрайта
Private intSpriteY As Integer 'Вертикаальная позиция спрайта
Private intSpriteWidth As Integer 'Ширина спрайта
Private intSpriteHeight As Integer 'Высота спрайта
Private spr As Sprite 'Спрайт для определения колизии
Public Event Collision() 'Событие срабатывает когда произйдёт столкновение спрайтов
'Спрайт
Public Property Get SpriteFileName() As Variant
Attribute SpriteFileName.VB_Description = "Имя файла спрайта."
SpritFileName = strSpriteFilename
End Property
Public Property Let SpriteFileName(ByVal vNewValue As Variant)
strSpriteFilename = vNewValue
End Property
'Маска спрайта
Public Property Get MaskSpriteFileName() As Variant
Attribute MaskSpriteFileName.VB_Description = "Имя файла для маски. Фон маски должен быть чёрным, а то что отображается должно быть белым."
MaskSpritFileName = strMaskSpriteFilename
End Property
Public Property Let MaskSpriteFileName(ByVal vNewValue As Variant)
strMaskSpriteFilename = vNewValue
End Property
'Инициализация
Public Sub Init()
bInitSprite = True
bInitBackground = True
If strSpriteFilename <> "" Then picSprite.Picture = LoadPicture(strSpriteFilename)
If strMaskSpriteFilename <> "" Then picSpriteMask.Picture = LoadPicture(strMaskSpriteFilename)
If strBackgroundFilename <> "" Then picBackground.Picture = LoadPicture(strBackgroundFilename)
Image1.Visible = False
End Sub
'Простая отрисовка спрайта
Public Sub DrawSpriteAt(ByVal hdc As Long, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer)
If bInitSprite = True Then
picSprite.width = width
picSprite.height = height
picSpriteMask.width = width
picSpriteMask.height = height
bInitSprite = False
End If
BitBlt hdc, x, y, width, height, picSpriteMask.hdc, 0, 0, SRCPAINT
BitBlt hdc, x, y, width, height, picSprite.hdc, 0, 0, SRCAND
intX = x
intY = y
End Sub
'Анимированная отрисовка спрайта
Public Sub DrawAnimatedSpriteAt(ByVal hdc As Long, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, _
ByVal height As Integer, ByVal sx As Integer, ByVal sy As Integer)
If bInitSprite = True Then
picSprite.width = width
picSprite.height = height
picSpriteMask.width = width
picSpriteMask.height = height
bInitSprite = False
End If
BitBlt hdc, x, y, width, height, picSpriteMask.hdc, sx, sy, SRCPAINT
BitBlt hdc, x, y, width, height, picSprite.hdc, sx, sy, SRCAND
intX = x
intY = y
End Sub
'Фон
Public Sub DrawBackground(ByVal hdc As Long, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, _
ByVal height As Integer)
If bInitBackground = True Then
picBackground.width = width
picBackground.height = height
picBackground.width = width
picBackground.height = height
bInitBackground = False
End If
BitBlt hdc, x, y, width, height, picBackground.hdc, 0, 0, SRCCOPY
End Sub
Public Sub DrawBackgroundTiled(ByVal hdc As Long, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, _
ByVal height As Integer, ByVal sx As Integer, ByVal sy As Integer)
If bInitBackground = True Then
picBackground.width = width
picBackground.height = height
picBackground.width = width
picBackground.height = height
bInitBackground = False
End If
BitBlt hdc, x, y, width, height, picBackground.hdc, sx, sy, SRCCOPY
End Sub
'Звук
Public Property Get SoundFileName() As Variant
Attribute SoundFileName.VB_Description = "Имя файла для звука."
SoundFileName = strSoundFileName
End Property
Public Property Let SoundFileName(ByVal vNewValue As Variant)
strSoundFileName = vNewValue
End Property
'Проиграть звук
Public Sub PlaySound()
sndPlaySound strSoundFileName, SND_FILENAME Or SND_ASYNC
End Sub
'Столкновение
Public Sub StartCollisionDetection(sp As Sprite)
spr = sp
tmCollisionDetect.Enabled = True
tmCollisionDetect.Interval = 100
End Sub
Public Sub StopCollisionDetection()
tmCollisionDetect.Enabled = False
End Sub
Private Sub tmCollisionDetect_Timer()
MsgBox spr.SpriteX & " " & spr.SpriteY & " " & spr.SpriteWidth & " " & spr.SpriteHeight
RaiseEvent Collision
'Exit Sub
If intSpriteX + intSpriteWidth > spr.SpriteX And _
intSpriteX < spr.SpriteX + spr.SpriteWidth And _
intSpriteX + intSpriteHeight > spr.SpriteY And _
intSpriteY < spr.SpriteY + spr.SpriteHeight Then
RaiseEvent Collision
End If
End Sub
'Инициализация
Private Sub UserControl_Initialize()
tmCollisionDetect.Interval = 0
tmCollisionDetect.Enabled = False
End Sub
'Позиция спрайта
Public Property Get SpriteX() As Variant
Attribute SpriteX.VB_Description = "Горизонтальная позиция спрайта."
SpriteX = intSpriteX
End Property
Public Property Get SpriteY() As Variant
Attribute SpriteY.VB_Description = "Вертикальная позиция спрайта."
SpriteY = intSpriteY
End Property
'Размеры спрайта
Public Property Get SpriteWidth() As Variant
Attribute SpriteWidth.VB_Description = "Ширина спрайта."
SpriteWidth = intSpriteWidth
End Property
Public Property Get SpriteHeight() As Variant
Attribute SpriteHeight.VB_Description = "Высота спрайта."
SpriteHeight = intSpriteHeight
End Property
'Фон
Public Property Get BackgroundFileName() As Variant
BackgroundFileName = strBackgroundFilename
End Property
Public Property Let BackgroundFileName(ByVal vNewValue As Variant)
strBackgroundFilename = vNewValue
End Property
Файл modMain.bas:
Attribute VB_Name = "modMain"
Public Const SRCAND = &H8800C6 ' (DWORD) dest = source AND dest
Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Public Const SRCERASE = &H440328 ' (DWORD) dest = source AND (NOT dest )
Public Const SRCINVERT = &H660046 ' (DWORD) dest = source XOR dest
Public Const SRCPAINT = &HEE0086 ' (DWORD) dest = source OR dest
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Const SND_ASYNC = &H1 ' play asynchronously
Public Const SND_FILENAME = &H20000 ' name is a file name
Public Const SND_LOOP = &H8 ' loop the sound until next sndPlaySound
Public Const SND_MEMORY = &H4 ' lpszSoundName points to a memory file
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
файл frmIcon.frm:
VERSION 5.00 Begin VB.Form frmIcon Caption = "Form1" ClientHeight = 3195 ClientLeft = 60 ClientTop = 345 ClientWidth = 4680 Icon = "frmIcon.frx":0000 LinkTopic = "Form1" ScaleHeight = 3195 ScaleWidth = 4680 StartUpPosition = 3 'Windows Default Visible = 0 'False End Attribute VB_Name = "frmIcon" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False
Файл readme.txt:
Для спрайта Sprite1.SpriteFileName = "sprite.bmp" Sprite1.MaskSpriteFileName = "sprite_mask.bmp" Sprite1.Init Для рисования спрайта Sprite1.DrawSpriteAt Me.hDC, 1, 1, 40, 40 Для рисования анимированного спрайта sprite1.DrawAnimatedSpriteAt Для фона SpriteBackground.Visible = False SpriteBackground.BackgroundFileName = "bg.bmp" SpriteBackground.Init Для отображение фона SpriteBackground.DrawBackground hDC, 0, 0, 640, 480 Для фона tiled SpriteBackground.DrawBackgroundTiled Для проигрывания звука Sprite1.SoundFileName = "gun_shot.wav" Sprite1.Init Sprite1.PlaySound Для очистки экрана нужно использовать Me.Cls
Обработка клавиш нужно делать так:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyLeft:
Debug.Print "Нажали клавишу влево"
Case vbKeyRight:
Debug.Print "Нажали клавишу вправо"
Case vbKeyDown:
Debug.Print "Нажали клавишу вниз"
Case vbKeyUp:
Debug.Print "Нажали клавишу вверх"
Case vbKeyReturn:
Debug.Print "Нажали клавишу Enter"
Case vbKeySpace:
Debug.Print "Нажали клавишу пробел"
End Select
End SubЕсли я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение 
Моя ФЛ Он и Она
Моя ФЛ Он и Она
NEW 30.05.25 23:39
в ответ uscheswoi_82 30.05.25 23:32
Файл GameEngine.vbp:
Type=Control
UserControl=ctlSprite.ctl
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\WINNT\System32\stdole2.tlb#OLE Automation
Form=frmIcon.frm
Module=modMain; modMain.bas
IconForm="frmIcon"
Startup="(None)"
HelpFile=""
Title="GameEngine"
ExeName32="GameEngine.ocx"
Command32=""
Name="GameEngine"
HelpContextID="0"
CompatibleMode="1"
CompatibleEXE32="GameEngine.ocx"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=1
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
ThreadingModel=1
DebugStartupOption=1
DebugStartupComponent=Sprite
[MS Transaction Server]
AutoRefresh=1
Файл GameEngine.vbw:
Sprite = 154, 154, 1378, 644, Z, 32, 22, 1246, 512, C frmIcon = 0, 0, 0, 0, C, 66, 66, 1290, 556, C modMain = 176, 176, 1400, 666,
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение Моя ФЛ Он и Она
Моя ФЛ Он и Она
NEW 30.05.25 23:51
в ответ uscheswoi_82 30.05.25 23:39
Пример
Файл frmMain.frm:
VERSION 5.00
Object = "{117023D9-0FFE-49F3-8203-5B62AA0043FF}#34.0#0"; "GameEngine.ocx"
Begin VB.Form frmMain
Caption = "Form1"
ClientHeight = 3840
ClientLeft = 60
ClientTop = 345
ClientWidth = 5205
LinkTopic = "Form1"
ScaleHeight = 256
ScaleMode = 3 'Pixel
ScaleWidth = 347
StartUpPosition = 3 'Windows Default
Begin VB.Timer tmTimer2
Left = 960
Top = 1800
End
Begin VB.CommandButton cmdGo
Caption = "&Go"
Height = 495
Left = 3960
TabIndex = 1
Top = 3240
Width = 1095
End
Begin VB.Timer tmTimer
Left = 2280
Top = 600
End
Begin GameEngine.Sprite Sprite1
Height = 495
Left = 0
TabIndex = 0
Top = 0
Width = 495
_ExtentX = 873
_ExtentY = 873
End
Begin GameEngine.Sprite Sprite2
Height = 495
Left = 720
TabIndex = 2
Top = 0
Width = 495
_ExtentX = 873
_ExtentY = 873
End
Begin GameEngine.Sprite SpriteBackground
Height = 495
Left = 1320
TabIndex = 3
Top = 0
Width = 495
_ExtentX = 873
_ExtentY = 873
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim x1 As Integer
Private Sub cmdGo_Click()
Me.tmTimer.Enabled = True
Me.tmTimer.Interval = 100
Me.tmTimer2.Enabled = True
Me.tmTimer2.Interval = 1000
x1 = 10
End Sub
Private Sub Form_Load()
Sprite1.Visible = False
Sprite1.SpriteFileName = "C:\GAMEENGINE\TEST\audio.bmp"
Sprite1.MaskSpriteFileName = "C:\GAMEENGINE\TEST\audio_mask2.bmp"
Sprite1.SoundFileName = "C:\GAMEENGINE\TEST\ding.wav"
Sprite1.Init
Sprite2.Visible = False
Sprite2.SpriteFileName = "C:\GAMEENGINE\TEST\audio.bmp"
Sprite2.MaskSpriteFileName = "C:\GAMEENGINE\TEST\audio_mask2.bmp"
Sprite2.SoundFileName = "C:\GAMEENGINE\TEST\ding.wav"
Sprite2.Init
SpriteBackground.Visible = False
SpriteBackground.BackgroundFileName = "C:\GAMEENGINE\TEST\bg.bmp"
SpriteBackground.Init
'Sprite1.StartCollisionDetection Sprite2
End Sub
Private Sub Sprite1_Collision()
Sprite1.StopCollisionDetection
Me.tmTimer.Enabled = False
Me.tmTimer2.Enabled = False
MsgBox "YES!"
End Sub
Private Sub tmTimer_Timer()
x1 = x1 + 1
Me.Cls
SpriteBackground.DrawBackground hDC, 0, 0, 283, 212
Sprite2.DrawSpriteAt Me.hDC, 50, 10, 40, 40
Sprite1.DrawSpriteAt Me.hDC, x1, 10, 40, 40
End Sub
Private Sub tmTimer2_Timer()
Sprite1.PlaySound
End Sub
Файл Test.vbp:
Type=Exe
Form=frmMain.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\WINNT\System32\stdole2.tlb#OLE Automation
Object={117023D9-0FFE-49F3-8203-5B62AA0043FF}#34.0#0; GameEngine.ocx
IconForm="frmMain"
Startup="frmMain"
Command32=""
Name="Test"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1
Файл Test.vbw:
frmMain = 44, 44, 1268, 534, , 154, 154, 1378, 644, C
Результат работы:
Ссылка на видео со звуком как работает 2D движок см. https://my.mail.ru/mail/semyon_kulikov/video/_myvideo/118....
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение Моя ФЛ Он и Она
Моя ФЛ Он и Она
назад
список