Flying Games

' VB.NET Games Source Code

Public Class Form1

Dim g_Engines As KPKEngines
Dim g_Char As KPKCharacters
Dim CharX As Integer
Dim CharY As Integer
Dim BLeft As Boolean
Dim BRight As Boolean
Dim BUp As Boolean
Dim BDown As Boolean

Const CharWidth As Integer = 30
Const CharHeight As Integer = 31

' Background In Games
Dim g_Bkg As KPKCharacters
Dim g_BkgX As Integer = 0
Dim g_BkgY As Integer = 0

Const BkgWidth As Integer = 300
Const BkgHeight As Integer = 225

Private Sub Form1_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
g_Char.ReleaseChar()
g_Bkg.ReleaseChar()
g_Engines.ReleaseEngines()
End Sub

Private Sub InitGames()
CharX = 100
CharY = 20
End Sub

Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
Select Case e.KeyCode
Case Keys.Escape
g_Char.ReleaseChar()
g_Bkg.ReleaseChar()
g_Engines.ReleaseEngines()
End
Case Keys.Left
BLeft = True
Case Keys.Right
BRight = True
Case Keys.Up
BUp = True
Case Keys.Down
BDown = True
End Select
End Sub

Private Sub Form1_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyUp
Select Case e.KeyCode
Case Keys.Left
BLeft = False
Case Keys.Right
BRight = False
Case Keys.Up
BUp = False
Case Keys.Down
BDown = False
End Select
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Me.FormBorderStyle = Windows.Forms.FormBorderStyle.Sizable
Me.MaximizeBox = False
Me.Text = " VB.NET Flying Games "
g_Engines = New KPKEngines
g_Engines.InitEngines(Me.Handle.ToInt32, AreaWidth, AreaHeight)

Call InitGames()

g_Bkg = New KPKCharacters
g_Bkg.SetFileNameNormal("D:\Image Games\Bkg_ButterFly.Bmp")
g_Bkg.SetCharWidth(BkgWidth)
g_Bkg.SetCharHeight(BkgHeight)
g_Bkg.InitCharNormal(g_Engines.GethDCBuffer)

g_Char = New KPKCharacters
g_Char.SetFileNameNormal("D:\Image Games\nButterFly.Bmp")
g_Char.SetFileNameMask("D:\Image Games\mButterFly.Bmp")
g_Char.SetCharWidth(CharWidth)
g_Char.SetCharHeight(CharHeight)
g_Char.InitCharNormal(g_Engines.GethDCBuffer)
g_Char.InitCharMask(g_Engines.GethDCBuffer)

Timer1.Interval = 1
Timer1.Enabled = True
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
g_Engines.BeginEngines()

' Set Bkg Position
g_Bkg.SetCharX(g_BkgX)
g_Bkg.SetCharY(g_BkgY)
' Draw Bkg
g_Bkg.DrawCharactersTransparency()


If BLeft = True Then
CharX = CharX - 5
ElseIf BRight = True Then
CharX = CharX + 5
ElseIf BUp = True Then
CharY = CharY - 5
ElseIf BDown = True Then
CharY = CharY + 5
End If

If BLeft = False And BRight = False _
And BUp = False And BDown = False Then
CharY = CharY + 1
If CharY >= 190 Then
Me.Text = " GAME OVER "
End
End If
End If
' Set Characters Position
g_Char.SetCharX(CharX)
g_Char.SetCharY(CharY)
' Draw Character
g_Char.DrawCharactersTransparency()

g_Engines.EndEngines()
End Sub

End Class

' basMain.vb ( Module )

Module basMain
Public Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hdc As Integer) As Integer
Public Declare Function CreateCompatibleBitmap Lib "gdi32" Alias "CreateCompatibleBitmap" (ByVal hdc As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer
Public Declare Function SelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As Integer, ByVal hObject As Integer) As Integer
Public Declare Function DeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hdc As Integer) As Integer
Public Declare Function DeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Integer) As Integer
Public Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Integer) As Integer
Public Declare Function BitBlt Lib "gdi32" Alias "BitBlt" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal dwRop As Integer) As Integer
Public Const SRCCOPY As Integer = &HCC0020 ' (DWORD) dest = source
Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Integer, ByVal lpsz As String, ByVal un1 As Integer, ByVal n1 As Integer, ByVal n2 As Integer, ByVal un2 As Integer) As Integer

Public Const IMAGE_BITMAP As Integer = 0
Public Const LR_LOADFROMFILE As Integer = &H10
Public Const LR_CREATEDIBSECTION As Integer = &H2000
Public Const SRCAND As Integer = &H8800C6 ' (DWORD) dest = source AND dest
Public Const SRCPAINT As Integer = &HEE0086 ' (DWORD) dest = source OR dest
Public Const MERGEPAINT As Integer = &HBB0226 ' (DWORD) dest = (NOT source) OR dest

Public Const AreaWidth As Integer = 1280
Public Const AreaHeight As Integer = 1024
End Module

' KPKEngines.vb ( Class )

Public Class KPKEngines

Private Structure STR_ENGINES
Dim g_hDC As Integer
Dim g_hDCBuffer As Integer
Dim g_hBitmapsBuffer As Integer
Dim g_hDCBack As Integer
Dim g_hBitmapsBack As Integer
Dim g_AreaWidth As Integer
Dim g_AreaHeight As Integer
End Structure

Dim StrEngines As STR_ENGINES
Dim TmphBuffer As Integer

Public Function GethDCBuffer() As Integer
GethDCBuffer = TmphBuffer
End Function

Public Function InitEngines(ByVal hWnd As Integer, ByVal AreaWidth As Integer, ByVal AreaHeight As Integer) As Integer
StrEngines.g_hDC = GetDC(hWnd)
StrEngines.g_hDCBuffer = CreateCompatibleDC(StrEngines.g_hDC)
StrEngines.g_hBitmapsBuffer = CreateCompatibleBitmap(StrEngines.g_hDC, AreaWidth, AreaHeight)
StrEngines.g_hDCBack = CreateCompatibleDC(StrEngines.g_hDC)
StrEngines.g_hBitmapsBack = CreateCompatibleBitmap(StrEngines.g_hDC, AreaWidth, AreaHeight)
SelectObject(StrEngines.g_hDCBuffer, StrEngines.g_hBitmapsBuffer)
SelectObject(StrEngines.g_hDCBack, StrEngines.g_hBitmapsBack)
StrEngines.g_AreaWidth = AreaWidth
StrEngines.g_AreaHeight = AreaHeight
TmphBuffer = StrEngines.g_hDCBuffer
End Function

Public Sub BeginEngines()
BitBlt(StrEngines.g_hDCBuffer, 0, 0, StrEngines.g_AreaWidth, StrEngines.g_AreaHeight, StrEngines.g_hDCBack, 0, 0, SRCCOPY)
End Sub

Public Sub EndEngines()
BitBlt(StrEngines.g_hDC, 0, 0, StrEngines.g_AreaWidth, StrEngines.g_AreaHeight, StrEngines.g_hDCBuffer, 0, 0, SRCCOPY)
End Sub

Public Sub ReleaseEngines()
DeleteObject(StrEngines.g_hBitmapsBack)
DeleteObject(StrEngines.g_hBitmapsBuffer)
DeleteDC(StrEngines.g_hDCBack)
DeleteDC(StrEngines.g_hDCBuffer)
DeleteDC(StrEngines.g_hDC)
End Sub

End Class

' KPKCharacters.vb ( Class )

Public Class KPKCharacters

Private Structure TCHARS
Dim vStrFileNameNormal As String
Dim vStrFileNameMask As String
Dim vCharX As Integer
Dim vCharY As Integer
Dim vCharWidth As Integer
Dim vCharHeight As Integer
Dim vhDCNormal As Integer
Dim vhBitmapsNormal As Integer
Dim vhDCMask As Integer
Dim vhBitmapsMask As Integer
End Structure

Dim tmphDCDest As Integer

Dim g_Chars As TCHARS

Public Sub SetFileNameNormal(ByVal sFileName As String)
g_Chars.vStrFileNameNormal = sFileName
End Sub

Public Sub SetFileNameMask(ByVal sFileName As String)
g_Chars.vStrFileNameMask = sFileName
End Sub

Public Sub InitCharNormal(ByVal hDest As Integer)
g_Chars.vhDCNormal = CreateCompatibleDC(hDest)
g_Chars.vhBitmapsNormal = LoadImage(0, g_Chars.vStrFileNameNormal, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
SelectObject(g_Chars.vhDCNormal, g_Chars.vhBitmapsNormal)
tmphDCDest = hDest
End Sub

Public Sub InitCharMask(ByVal hDest As Integer)
g_Chars.vhDCMask = CreateCompatibleDC(hDest)
g_Chars.vhBitmapsMask = LoadImage(0, g_Chars.vStrFileNameMask, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
SelectObject(g_Chars.vhDCMask, g_Chars.vhBitmapsMask)
tmphDCDest = hDest
End Sub

Public Sub SetCharX(ByVal CharX As Integer)
g_Chars.vCharX = CharX
End Sub

Public Sub SetCharY(ByVal CharY As Integer)
g_Chars.vCharY = CharY
End Sub

Public Sub SetCharWidth(ByVal CharWidth As Integer)
g_Chars.vCharWidth = CharWidth
End Sub

Public Sub SetCharHeight(ByVal CharHeight As Integer)
g_Chars.vCharHeight = CharHeight
End Sub

Public Sub DrawCharacters()
BitBlt(tmphDCDest, g_Chars.vCharX, g_Chars.vCharY, g_Chars.vCharWidth, g_Chars.vCharHeight, g_Chars.vhDCNormal, 0, 0, SRCCOPY)
End Sub

Public Sub DrawCharNormal(ByVal SrcX As Integer, ByVal SrcY As Integer, ByVal vDwRop As Integer)
BitBlt(tmphDCDest, g_Chars.vCharX, g_Chars.vCharY, g_Chars.vCharWidth, g_Chars.vCharHeight, g_Chars.vhDCNormal, SrcX, SrcY, vDwRop)
End Sub

Public Sub DrawCharMask(ByVal SrcX As Integer, ByVal SrcY As Integer, ByVal vDwRop As Integer)
BitBlt(tmphDCDest, g_Chars.vCharX, g_Chars.vCharY, g_Chars.vCharWidth, g_Chars.vCharHeight, g_Chars.vhDCMask, SrcX, SrcY, vDwRop)
End Sub

Public Sub DrawCharactersTransparency()
BitBlt(tmphDCDest, g_Chars.vCharX, g_Chars.vCharY, g_Chars.vCharWidth, g_Chars.vCharHeight, g_Chars.vhDCMask, 0, 0, SRCAND)
BitBlt(tmphDCDest, g_Chars.vCharX, g_Chars.vCharY, g_Chars.vCharWidth, g_Chars.vCharHeight, g_Chars.vhDCNormal, 0, 0, SRCPAINT)
End Sub

Public Sub ReleaseChar()
DeleteObject(g_Chars.vhBitmapsMask)
DeleteObject(g_Chars.vhBitmapsNormal)
DeleteObject(g_Chars.vhDCMask)
DeleteObject(g_Chars.vhDCNormal)
DeleteObject(tmphDCDest)
End Sub
End Class

' Design VB.NET Source Code Games By Fernando Firaht