' VB.NET Games Source Code
Option Explicit On
Option Strict On
Public Class Form1
Dim Cols As Integer
Dim Rows As Integer
Dim hBuffer As Integer
Dim hBBuffer As Integer
Dim hBack As Integer
Dim hBBack As Integer
Dim vhDC As Integer
' Maps
Dim hImages As Integer
Dim Mps As New KPKMaps
Dim hMaps As Integer
Dim MapsX As Integer
Dim MapsY As Integer
' Enemy
Dim Enemy As New KPKCharacters
Dim EnemyX As Integer
Dim EnemyY As Integer
Dim EnemyCols As Integer
Dim EnemyRows As Integer
Dim bEnemyDead As Boolean
Dim bEnemyRight As Boolean
Dim bEnemyLeft As Boolean
Dim RndShoot As Integer
Dim bEShoot As Boolean
Dim bRnd As Boolean
Const EnemyWidth As Integer = 42
Const EnemyHeight As Integer = 49
' Bullet Enemy
Dim EBullet As New KPKCharacters
Dim EBulletX As Integer
Dim EBulletY As Integer
Dim EBulletCols As Integer
Dim EBulletRows As Integer
Dim bEBulletShow As Boolean
Const EBulletWidth As Integer = 32
Const EBulletHeight As Integer = 32
' Unit
Dim Unit As New KPKCharacters
Dim UnitX As Integer
Dim UnitY As Integer
Dim UnitCols As Integer
Dim UnitRows As Integer
Dim bUnitDead As Boolean
Const UnitWidth As Integer = 42
Const UnitHeight As Integer = 49
Dim CColumns() As Integer
Dim CRows() As Integer
Private Sub InitGames()
' Init Enemy
EnemyCols = 2
EnemyRows = 2
bEnemyDead = False
bEnemyRight = True
bEnemyLeft = False
bEShoot = False
' Bullet Enemy
bEBulletShow = False
EBulletCols = 1
EBulletRows = 1
bRnd = True
' Init Characters
UnitCols = 10
UnitRows = 18
bUnitDead = False
End Sub
Private Function CreateDC(ByVal g_hDCDest As Integer, ByVal g_Width As Integer, ByVal g_Height As Integer) As Integer
Dim g_TmphDC As Integer
Dim g_TmpBitmaps As Integer
g_TmphDC = CreateCompatibleDC(g_hDCDest)
g_TmpBitmaps = CreateCompatibleBitmap(g_hDCDest, g_Width, g_Height)
SelectObject(g_TmphDC, g_TmpBitmaps)
CreateDC = g_TmphDC
DeleteObject(g_TmpBitmaps)
End Function
Private Function LoadBitmaps(ByVal sFilename As String) As Integer
Dim tmphDC As Integer
Dim tmphBitmaps As Integer
tmphDC = CreateCompatibleDC(vhDC)
tmphBitmaps = LoadImage(0, sFilename, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
SelectObject(tmphDC, tmphBitmaps)
DeleteObject(tmphBitmaps)
LoadBitmaps = tmphDC
End Function
Private Sub InitEngine()
vhDC = GetDC(Me.Handle.ToInt32)
hBuffer = CreateCompatibleDC(vhDC)
hBBuffer = CreateCompatibleBitmap(vhDC, AreaWidth, AreaHeight)
hBack = CreateCompatibleDC(vhDC)
hBBack = CreateCompatibleBitmap(vhDC, AreaWidth, AreaHeight)
SelectObject(hBuffer, hBBuffer)
SelectObject(hBack, hBBack)
DeleteObject(hBBuffer)
DeleteObject(hBBack)
End Sub
Private Sub ReleaseGames()
Enemy.ReleaseChar()
EBullet.ReleaseChar()
Unit.ReleaseChar()
DeleteDC(hMaps)
DeleteDC(hImages)
DeleteDC(hBuffer)
DeleteDC(hBack)
End Sub
Private Sub Form1_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
Call ReleaseGames()
Me.Dispose()
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
Call ReleaseGames()
Me.Dispose()
Case Keys.Left
If Mps.GetTileMoveState(UnitCols - 1, UnitRows) = 1 Then
UnitCols = UnitCols - 1
End If
Case Keys.Right
If Mps.GetTileMoveState(UnitCols + 1, UnitRows) = 1 Then
UnitCols = UnitCols + 1
End If
End Select
End Sub
Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Randomize()
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.FixedToolWindow
Me.Text = " The Gun Balls Games In VB.NET "
Me.Width = 1000
Me.Height = 700
Timer1.Interval = 1
Timer1.Enabled = True
Call InitEngine()
hImages = LoadBitmaps("D:\MapsTiles01.bmp")
Mps.LoadMaps("D:\Maps\Shooting Maps01.MAPS")
hMaps = CreateDC(hBuffer, Mps.GetMapsWidth * Mps.GetTileWidth(1, 1), Mps.GetMapsHeight * Mps.GetTileHeight(1, 1))
ReDim CColumns(Mps.GetMapsWidth)
ReDim CRows(Mps.GetMapsHeight)
Call InitGames()
' Set Detail Enemy
Enemy.SetFileNameNormal("D:\Image Games\Enemy_Down.Bmp")
Enemy.SetFileNameMask("D:\Image Games\Enemy_Down.Bmp")
Enemy.InitCharNormal(hBuffer)
Enemy.InitCharMask(hBuffer)
Enemy.SetCharWidth(EnemyWidth)
Enemy.SetCharHeight(EnemyHeight)
' Set Detail Bullet Enemy
EBullet.SetFileNameNormal("D:\Image Games\yBall_Normal.Bmp")
EBullet.SetFileNameMask("D:\Image Games\yBall_Mask.Bmp")
EBullet.InitCharNormal(hBuffer)
EBullet.InitCharMask(hBuffer)
EBullet.SetCharWidth(EBulletWidth)
EBullet.SetCharHeight(EBulletHeight)
' Set Detail Unit
Unit.SetFileNameNormal("D:\Image Games\King_Up.Bmp")
Unit.SetFileNameMask("D:\Image Games\King_Up.Bmp")
Unit.InitCharNormal(hBuffer)
Unit.InitCharMask(hBuffer)
Unit.SetCharWidth(UnitWidth)
Unit.SetCharHeight(UnitHeight)
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
BitBlt(hBuffer, 0, 0, AreaWidth, AreaHeight, hBack, 0, 0, SRCCOPY)
For Rows = 1 To Mps.GetMapsHeight
For Cols = 1 To Mps.GetMapsWidth
BitBlt(hMaps, Mps.GetTilePosX(Cols, Rows), Mps.GetTilePosY(Cols, Rows), 32, 32, hImages, Mps.GetTileX(Cols, Rows), Mps.GetTileY(Cols, Rows), SRCCOPY)
Next Cols
Next Rows
BitBlt(hBuffer, MapsX, MapsY, Mps.GetMapsWidth * Mps.GetTileWidth(1, 1), Mps.GetMapsHeight * Mps.GetTileHeight(1, 1), hMaps, 0, 0, SRCCOPY)
For Rows = 1 To Mps.GetMapsHeight
For Cols = 1 To Mps.GetMapsWidth
CColumns(Cols) = MapsX + (Cols - 1) * 32
CRows(Rows) = MapsY + (Rows - 1) * 32
Next Cols
Next Rows
EnemyX = CColumns(EnemyCols)
EnemyY = CRows(EnemyRows)
' Enemy Move
Static tmpEMove As Integer
If bEnemyRight = True Then
If Mps.GetTileMoveState(EnemyCols + 1, EnemyRows) = 1 Then
tmpEMove = tmpEMove + 1
If tmpEMove >= 5 Then
tmpEMove = 0
EnemyCols = EnemyCols + 1
End If
ElseIf Mps.GetTileMoveState(EnemyCols + 1, EnemyRows) = 2 Then
bEnemyRight = False
bEnemyLeft = True
End If
ElseIf bEnemyLeft = True Then
If Mps.GetTileMoveState(EnemyCols - 1, EnemyRows) = 1 Then
tmpEMove = tmpEMove + 1
If tmpEMove >= 5 Then
tmpEMove = 0
EnemyCols = EnemyCols - 1
End If
ElseIf Mps.GetTileMoveState(EnemyCols - 1, EnemyRows) = 2 Then
bEnemyLeft = False
bEnemyRight = True
End If
End If
Enemy.SetCharX(EnemyX)
Enemy.SetCharY(EnemyY)
Enemy.DrawCharMask(EnemyWidth + 1, 0, MERGEPAINT)
Enemy.DrawCharNormal(0, 0, SRCAND)
EBulletX = CColumns(EBulletCols)
EBulletY = CRows(EBulletRows)
If bRnd = True Then
RndShoot = CInt(Rnd() * 10)
If RndShoot = 9 Then
bEShoot = True
bEBulletShow = True
bRnd = False
EBulletCols = EnemyCols
EBulletRows = EnemyRows
ElseIf RndShoot <> 9 Then
RndShoot = CInt(Rnd() * 10)
End If
End If
If bEShoot = True Then
EBulletRows = EBulletRows + 1
If EBulletRows >= Mps.GetMapsHeight Then
bEBulletShow = False
bEShoot = False
bRnd = True
End If
End If
If bEBulletShow = True Then
EBullet.SetCharX(EBulletX)
EBullet.SetCharY(EBulletY)
EBullet.DrawCharactersTransparency()
End If
If EBulletCols = UnitCols And EBulletRows = UnitRows Then
bUnitDead = True
MsgBox(" You Dead ", MsgBoxStyle.Critical Or MsgBoxStyle.OkOnly, " The Gun Balls Games In VB.NET ")
If MsgBox(" Do you want to New Games ? ", MsgBoxStyle.Question Or MsgBoxStyle.YesNo, " The Gun Balls Games In VB.NET ") = MsgBoxResult.Yes Then
Call InitGames()
Else
End
End If
End If
UnitX = CColumns(UnitCols)
UnitY = CRows(UnitRows)
If bUnitDead = False Then
Unit.SetCharX(UnitX)
Unit.SetCharY(UnitY)
Unit.DrawCharMask(UnitWidth - 3, 0, MERGEPAINT)
Unit.DrawCharNormal(0, 0, SRCAND)
End If
BitBlt(vhDC, 0, 0, AreaWidth, AreaHeight, hBuffer, 0, 0, SRCCOPY)
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
' KPKMaps.vb ( Class )
Public Class KPKMaps
Private Structure STR_MAPS
Dim TileX As Integer
Dim TileY As Integer
Dim TileWidth As Integer
Dim TileHeight As Integer
Dim TilePosX As Integer
Dim TilePosY As Integer
Dim TileMoveState As Byte
End Structure
Dim strMaps(,) As STR_MAPS
Dim MapsWidth As Integer
Dim MapsHeight As Integer
Dim TmpRows As Integer
Dim TmpCols As Integer
Public Sub LoadMaps(ByVal sFilename As String)
Dim nFileNum As Integer
nFileNum = FreeFile()
FileOpen(nFileNum, sFilename, OpenMode.Binary, OpenAccess.Read)
FileGet(nFileNum, MapsWidth)
FileGet(nFileNum, MapsHeight)
ReDim strMaps(MapsWidth + 1, MapsHeight + 1)
For TmpRows = 1 To MapsHeight
For TmpCols = 1 To MapsWidth
FileGet(nFileNum, strMaps(TmpCols, TmpRows).TileX)
FileGet(nFileNum, strMaps(TmpCols, TmpRows).TileY)
FileGet(nFileNum, strMaps(TmpCols, TmpRows).TileWidth)
FileGet(nFileNum, strMaps(TmpCols, TmpRows).TileHeight)
FileGet(nFileNum, strMaps(TmpCols, TmpRows).TilePosX)
FileGet(nFileNum, strMaps(TmpCols, TmpRows).TilePosY)
FileGet(nFileNum, strMaps(TmpCols, TmpRows).TileMoveState)
Next TmpCols
Next TmpRows
FileClose(nFileNum)
End Sub
Public Function GetMapsWidth() As Integer
GetMapsWidth = MapsWidth
End Function
Public Function GetMapsHeight() As Integer
GetMapsHeight = MapsHeight
End Function
Public Function GetTileX(Optional ByVal nCols As Integer = 1, Optional ByVal nRows As Integer = 1) As Integer
GetTileX = strMaps(nCols, nRows).TileX
End Function
Public Function GetTileY(ByVal nCols As Integer, ByVal nRows As Integer) As Integer
GetTileY = strMaps(nCols, nRows).TileY
End Function
Public Function GetTileWidth(ByVal nCols As Integer, ByVal nRows As Integer) As Integer
GetTileWidth = strMaps(nCols, nRows).TileWidth
End Function
Public Function GetTileHeight(ByVal nCols As Integer, ByVal nRows As Integer) As Integer
GetTileHeight = strMaps(nCols, nRows).TileHeight
End Function
Public Function GetTilePosX(ByVal nCols As Integer, ByVal nRows As Integer) As Integer
GetTilePosX = strMaps(nCols, nRows).TilePosX
End Function
Public Function GetTilePosY(ByVal nCols As Integer, ByVal nRows As Integer) As Integer
GetTilePosY = strMaps(nCols, nRows).TilePosY
End Function
Public Function GetTileMoveState(ByVal nCols As Integer, ByVal nRows As Integer) As Integer
GetTileMoveState = strMaps(nCols, nRows).TileMoveState
End Function
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
ไม่มีความคิดเห็น:
แสดงความคิดเห็น