русский

2D движок на VB 6.0 30.05.2025

30.05.25 23:32
2D движок на VB 6.0 30.05.2025
 
uscheswoi_82 патриот
Zuletzt geändert 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
Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение
 

Sprung zu