Write And Read Text File In VB.NET

' VB.NET File Source Code

Option Explicit On
Option Strict On

Public Class Form1

Dim nFileNum As Integer
Dim Str_Filename As String
Dim KeepNum As Integer

Private Sub Btn_WriteTextFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Btn_WriteTextFile.Click
If IsNumeric(TextBox1.Text) = False Then
MsgBox(" Please Input The Number ", MsgBoxStyle.Question Or MsgBoxStyle.OkOnly, " Write And Read Text File In VB.NET ")
TextBox1.Focus()
TextBox1.Text = ""
Exit Sub
ElseIf IsNumeric(TextBox1.Text) = True Then
WriteTextFile(Str_Filename, CInt(TextBox1.Text))
MsgBox(" Write Text File Completed = " & CInt(TextBox1.Text), MsgBoxStyle.Information Or MsgBoxStyle.OkOnly, " Write And Read Text File In VB.NET ")
End If
End Sub

Private Sub WriteTextFile(ByVal sFilename As String, ByVal nNum As Integer)
nFileNum = FreeFile()
FileOpen(nFileNum, sFilename, OpenMode.Output, OpenAccess.Write)
Write(nFileNum, nNum)
FileClose(nFileNum)
End Sub

Private Function ReadTextFile(ByVal sFilename As String) As Integer
Dim nNum As Integer
nFileNum = FreeFile()
FileOpen(nFileNum, sFilename, OpenMode.Input, OpenAccess.Read)
Input(nFileNum, nNum)
FileClose(nFileNum)
ReadTextFile = nNum
End Function

Private Sub Btn_ReadTextFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Btn_ReadTextFile.Click
KeepNum = ReadTextFile(Str_Filename)
Me.Text = " Read Text File " & KeepNum.ToString
MsgBox(" Read Text File Completed = " & KeepNum, MsgBoxStyle.Information Or MsgBoxStyle.OkOnly, " Write And Read Text File In VB.NET ")
TextBox1.Focus()
TextBox1.Text = ""
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.FixedToolWindow
Str_Filename = "C:\txt01.txt"
Me.Text = " Write And Read Text File In VB.NET "
Me.BackColor = Color.Aquamarine
TextBox1.Text = ""
TextBox1.BackColor = Color.Yellow
TextBox1.ForeColor = Color.Blue
Btn_WriteTextFile.Text = " Write Text File "
Btn_WriteTextFile.BackColor = Color.Black
Btn_WriteTextFile.ForeColor = Color.White
Btn_ReadTextFile.Text = " Read Text File "
Btn_ReadTextFile.BackColor = Color.Black
Btn_ReadTextFile.ForeColor = Color.White
End Sub
End Class

' Design VB.NET Source Code Games By Fernando Firaht

Ball Block Games

' VB.NET Ball Block Game Source Code

Option Explicit On
Option Strict On

Public Class Form1


Dim Rows As Integer
Dim Cols As Integer

' Engines Class
Dim g_Engines As New KPKEngines

' Maps
Dim hImages As Integer
Dim Mps As New KPKMaps
Dim hMaps As Integer
Dim MapsX As Integer
Dim MapsY As Integer

' Character Ball Green
Dim Ball_Green As New KPKCharacters
Dim Ball_Green_Cols As Integer
Dim Ball_Green_Rows As Integer
Dim Ball_Green_X As Integer
Dim Ball_Green_Y As Integer

Const Ball_Green_Width As Integer = 32
Const Ball_Green_Height As Integer = 32


' Character Ball Green
Const MAXBALLPINK As Integer = 2
Dim Ball_Pink(MAXBALLPINK) As KPKCharacters
Dim Ball_Pink_Cols(MAXBALLPINK) As Integer
Dim Ball_Pink_Rows(MAXBALLPINK) As Integer
Dim Ball_Pink_X(MAXBALLPINK) As Integer
Dim Ball_Pink_Y(MAXBALLPINK) As Integer
Dim Ball_Pink_Show(MAXBALLPINK) As Boolean

Const Ball_Pink_Width As Integer = 32
Const Ball_Pink_Height As Integer = 32

Dim CColumns() As Integer
Dim CRows() As Integer

Dim bBallBlock1 As Boolean
Dim bBallBlock2 As Boolean
Dim bBallBlock3 As Boolean
Dim i As Integer

Dim NumBall As Integer

Private Function LoadBitmaps(ByVal hDCDest As Integer, ByVal sFilename As String) As Integer
Dim tmphDC As Integer
Dim tmphBitmaps As Integer
tmphDC = CreateCompatibleDC(hDCDest)
tmphBitmaps = LoadImage(0, sFilename, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
SelectObject(tmphDC, tmphBitmaps)
DeleteObject(tmphBitmaps)
LoadBitmaps = tmphDC
End Function

Private Sub ReleaseGames()
Ball_Green.ReleaseChar()

For i = 0 To MAXBALLPINK
Ball_Pink(i).ReleaseChar()
Next i
DeleteDC(hMaps)
DeleteDC(hImages)
g_Engines.ReleaseEngines()
End Sub

Private Sub Form1_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
Call ReleaseGames()
End Sub


Private Sub InitGames()

NumBall = 0
Ball_Green_Cols = 2
Ball_Green_Rows = 2

For i = 0 To MAXBALLPINK
Ball_Pink_Show(i) = True
Next i

Ball_Pink_Cols(0) = 3
Ball_Pink_Rows(0) = 3

Ball_Pink_Cols(1) = 4
Ball_Pink_Rows(1) = 7

Ball_Pink_Cols(2) = 8
Ball_Pink_Rows(2) = 7
End Sub

Private Sub Form1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.DoubleClick
If MsgBox(" Do you want to New Game? ", MsgBoxStyle.Question Or MsgBoxStyle.YesNo, " VB.NET Ball Block Game ") = MsgBoxResult.Yes Then
Call InitGames()
End If
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
If MsgBox(" Do you want to Close Ball Block Game? ", MsgBoxStyle.Question Or MsgBoxStyle.YesNo, " VB.NET Ball Block Game ") = MsgBoxResult.Yes Then
Call ReleaseGames()
End
End If
Case Keys.Right
If Mps.GetTileMoveState(Ball_Green_Cols + 1, Ball_Green_Rows) = 1 Then
For i = 0 To MAXBALLPINK
If Ball_Green_Cols = Ball_Pink_Cols(i) - 1 And Ball_Green_Rows = Ball_Pink_Rows(i) Then
If Mps.GetTileMoveState(Ball_Pink_Cols(i) + 1, Ball_Pink_Rows(i)) = 1 Then
Ball_Pink_Cols(i) = Ball_Pink_Cols(i) + 1
End If
End If
Next i
Ball_Green_Cols = Ball_Green_Cols + 1
End If
Case Keys.Left
If Mps.GetTileMoveState(Ball_Green_Cols - 1, Ball_Green_Rows) = 1 Then
For i = 0 To MAXBALLPINK
If Ball_Green_Cols = Ball_Pink_Cols(i) + 1 And Ball_Green_Rows = Ball_Pink_Rows(i) Then
If Mps.GetTileMoveState(Ball_Pink_Cols(i) - 1, Ball_Pink_Rows(i)) = 1 Then
Ball_Pink_Cols(i) = Ball_Pink_Cols(i) - 1
End If
End If
Next i
Ball_Green_Cols = Ball_Green_Cols - 1
End If
Case Keys.Up
If Mps.GetTileMoveState(Ball_Green_Cols, Ball_Green_Rows - 1) = 1 Then
For i = 0 To MAXBALLPINK
If Ball_Green_Cols = Ball_Pink_Cols(i) And Ball_Green_Rows = Ball_Pink_Rows(i) + 1 Then
If Mps.GetTileMoveState(Ball_Pink_Cols(i), Ball_Pink_Rows(i) - 1) = 1 Then
Ball_Pink_Rows(i) = Ball_Pink_Rows(i) - 1
End If
End If
Next i
Ball_Green_Rows = Ball_Green_Rows - 1
End If
Case Keys.Down
If Mps.GetTileMoveState(Ball_Green_Cols, Ball_Green_Rows + 1) = 1 Then
For i = 0 To MAXBALLPINK
If Ball_Green_Cols = Ball_Pink_Cols(i) And Ball_Green_Rows = Ball_Pink_Rows(i) - 1 Then
If Mps.GetTileMoveState(Ball_Pink_Cols(i), Ball_Pink_Rows(i) + 1) = 1 Then
Ball_Pink_Rows(i) = Ball_Pink_Rows(i) + 1
End If
End If
Next i
Ball_Green_Rows = Ball_Green_Rows + 1
End If
End Select
End Sub

Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.FixedToolWindow
Me.Text = " The Gun Balls Games In VB.NET "
Me.Width = 400
Me.Height = 400

g_Engines.InitEngines(Me.Handle.ToInt32, 800, 600)
Timer1.Interval = 1
Timer1.Enabled = True

hImages = LoadBitmaps(g_Engines.GethDCBuffer, "D:\Image Games\Ball_Block_Maps_02.bmp")
Mps.LoadMaps("D:\Maps\VB.NET_Ball_Block_01.MAPS")

ReDim CColumns(Mps.GetMapsWidth)
ReDim CRows(Mps.GetMapsHeight)

Call InitGames()

' Ball Green
Ball_Green.SetFileNameNormal("D:\Image Games\Ball_Block_Green_Normal_01.Bmp")
Ball_Green.SetFileNameMask("D:\Image Games\Ball_Block_Green_Mask_01.Bmp")
Ball_Green.SetCharWidth(Ball_Green_Width)
Ball_Green.SetCharHeight(Ball_Green_Height)
Ball_Green.InitCharNormal(g_Engines.GethDCBuffer)
Ball_Green.InitCharMask(g_Engines.GethDCBuffer)

' Ball Pink

For i = 0 To MAXBALLPINK
Ball_Pink(i) = New KPKCharacters
Ball_Pink(i).SetFileNameNormal("D:\Image Games\Ball_Block_Pink_Normal_01.Bmp")
Ball_Pink(i).SetFileNameMask("D:\Image Games\Ball_Block_Pink_Mask_01.Bmp")
Ball_Pink(i).SetCharWidth(Ball_Pink_Width)
Ball_Pink(i).SetCharHeight(Ball_Pink_Height)
Ball_Pink(i).InitCharNormal(g_Engines.GethDCBuffer)
Ball_Pink(i).InitCharMask(g_Engines.GethDCBuffer)
Next i
End Sub

Private Sub DrawMaps()
For Rows = 1 To Mps.GetMapsHeight
For Cols = 1 To Mps.GetMapsWidth
BitBlt(g_Engines.GethDCBuffer, Mps.GetTilePosX(Cols, Rows), _
Mps.GetTilePosY(Cols, Rows), Mps.GetTileWidth(Cols, Rows), _
Mps.GetTileHeight(Cols, Rows), hImages, Mps.GetTileX(Cols, Rows), _
Mps.GetTileY(Cols, Rows), SRCCOPY)
Next
Next
End Sub

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

'Draw Maps In Games
Call DrawMaps()

' Calculation Columns And Rows
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

' Check Games Loop

For i = 0 To MAXBALLPINK
If Ball_Pink_Cols(i) = 3 And Ball_Pink_Rows(i) = 2 Then
bBallBlock1 = True
Ball_Pink_Cols(i) = 3
Ball_Pink_Rows(i) = 2
End If
If Ball_Pink_Cols(i) = 4 And Ball_Pink_Rows(i) = 6 Then
bBallBlock2 = True
Ball_Pink_Cols(i) = 4
Ball_Pink_Rows(i) = 6
End If
If Ball_Pink_Cols(i) = 7 And Ball_Pink_Rows(i) = 8 Then
bBallBlock3 = True
Ball_Pink_Cols(i) = 7
Ball_Pink_Rows(i) = 8
End If

If Bballblock1 = True And bballblock2 = True And bballblock3 = True Then
Me.Text = " You Win : The Gun Balls Games In VB.NET "
Call InitGames()
End If
Next i

For i = 0 To MAXBALLPINK
If Ball_Pink_Show(i) = True Then
' Set Position Ball Pink
Ball_Pink_X(i) = CColumns(Ball_Pink_Cols(i))
Ball_Pink_Y(i) = CRows(Ball_Pink_Rows(i))

' Draw Character Ball Pink
Ball_Pink(i).SetCharX(Ball_Pink_X(i))
Ball_Pink(i).SetCharY(Ball_Pink_Y(i))
Ball_Pink(i).DrawCharactersTransparency()
End If
Next i

' Set Position Ball Green
Ball_Green_X = CColumns(Ball_Green_Cols)
Ball_Green_Y = CRows(Ball_Green_Rows)

' Draw Character
Ball_Green.SetCharX(Ball_Green_X)
Ball_Green.SetCharY(Ball_Green_Y)
Ball_Green.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

' 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

' 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

' 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

' Design VB.NET Source Code Games By Fernando Firaht

Pacman Games

' VB.NET Games Source Code

Option Explicit On
Option Strict On

Public Class Form1
Dim hBuffer As Integer
Dim hBBuffer As Integer
Dim hBack As Integer
Dim hBBack As Integer
Dim vhDC As Integer
Dim hImages As Integer
Dim Cols As Integer
Dim Rows As Integer
Dim Mps As New KPKMaps
Dim hMaps As Integer
Dim MapsX As Integer
Dim MapsY As Integer

' Characters
Dim hCharNormal As Integer
Dim hCharMask As Integer
Dim CharX As Integer
Dim CharY As Integer
Dim CharCols As Integer
Dim CharRows As Integer

Const CharWidth As Integer = 32
Const CharHeight As Integer = 32

Dim CColumns() As Integer
Dim CRows() As Integer


' Book
Const MAXBook As Byte = 6

Dim Book(MAXBook) As KPKCharacters
Dim BookX(MAXBook) As Integer
Dim BookY(MAXBook) As Integer
Dim BookCols(MAXBook) As Integer
Dim BookRows(MAXBook) As Integer
Dim BShowBook(MAXBook) As Boolean
Const BookWidth As Integer = 21
Const BookHeight As Integer = 29

Dim i As Integer
Dim ItemNum As Integer

Private Sub InitCharacters(ByVal StrNormal As String, ByVal StrMask As String)
hCharNormal = LoadBitmaps(StrNormal)
hCharMask = LoadBitmaps(StrMask)
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, 800, 600)
hBack = CreateCompatibleDC(vhDC)
hBBack = CreateCompatibleBitmap(vhDC, 800, 600)
SelectObject(hBuffer, hBBuffer)
SelectObject(hBack, hBBack)
DeleteObject(hBBuffer)
DeleteObject(hBBack)
End Sub

Private Sub ReleaseGames()
For i = 0 To MAXBook
Book(i).ReleaseCharacters()
Next i
DeleteDC(hCharNormal)
DeleteDC(hCharMask)
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()
End
Case Keys.Left
If Mps.GetTileMoveState(CharCols - 1, CharRows) = 1 Then
CharCols = CharCols - 1
End If
Case Keys.Right
If Mps.GetTileMoveState(CharCols + 1, CharRows) = 1 Then
CharCols = CharCols + 1
End If
Case Keys.Up
If Mps.GetTileMoveState(CharCols, CharRows - 1) = 1 Then
CharRows = CharRows - 1
End If
Case Keys.Down
If Mps.GetTileMoveState(CharCols, CharRows + 1) = 1 Then
CharRows = CharRows + 1
End If
End Select
End Sub

Private Sub InitGames()
CharCols = 5
CharRows = 2

BookCols(0) = 2
BookRows(0) = 2

BookCols(1) = 12
BookRows(1) = 7

BookCols(2) = 4
BookRows(2) = 6

BookCols(3) = 9
BookRows(3) = 10

BookCols(4) = 8
BookRows(4) = 13

BookCols(5) = 14
BookRows(5) = 13

BookCols(6) = 5
BookRows(6) = 14

For i = 0 To MAXBook
BShowBook(i) = True
Next i
End Sub

Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.FixedToolWindow
Me.Text = " Move Maps In Games With VB.NET "
Timer1.Interval = 1
Timer1.Enabled = True
Call InitEngine()
Call InitGames()

hImages = LoadBitmaps("D:\MapsTiles01.bmp")
Mps.LoadMaps("D:\Maps\Pacman_Maps_02.MAPS")
hMaps = CreateDC(hBuffer, Mps.GetMapsWidth * 32, Mps.GetMapsHeight * 32)

Call InitCharacters("D:\Image Games\yBall_Normal.Bmp", "D:\Image Games\yBall_Mask.Bmp")

For i = 0 To MAXBook
Book(i) = New KPKCharacters
Book(i).SetFilename("D:\Image Games\Book.Bmp")
Book(i).SetCharactersWidth(BookWidth)
Book(i).SetCharactersHeight(BookHeight)
Book(i).InitCharacters(hBuffer)
Next i

ReDim CColumns(Mps.GetMapsWidth)
ReDim CRows(Mps.GetMapsHeight)
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
BitBlt(hBuffer, 0, 0, 800, 600, 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

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

CharX = CColumns(CharCols)
CharY = CRows(CharRows)

For i = 0 To MAXBook
BookX(i) = CColumns(BookCols(i)) + 5
BookY(i) = CRows(BookRows(i))
Next i

For i = 0 To MAXBook
If CharCols = BookCols(i) And CharRows = BookRows(i) Then
BShowBook(i) = False
ItemNum = ItemNum + 1
BookCols(i) = 1
BookRows(i) = 1
End If
If ItemNum >= MAXBook + 1 Then
Me.Text = " You Win "
Call InitGames()
End If
Next i

BitBlt(hBuffer, MapsX, MapsY, Mps.GetMapsWidth * 32, Mps.GetMapsHeight * 32, hMaps, 0, 0, SRCCOPY)

For i = 0 To MAXBook
Book(i).SetPositionX(BookX(i))
Book(i).SetPositionY(BookY(i))
If BShowBook(i) = True Then
Book(i).DrawCharacters(hBuffer, 0, 0, SRCCOPY)
End If
Next i

BitBlt(hBuffer, CharX, CharY, CharWidth, CharHeight, hCharMask, 0, 0, SRCAND)
BitBlt(hBuffer, CharX, CharY, CharWidth, CharHeight, hCharNormal, 0, 0, SRCPAINT)



BitBlt(vhDC, 0, 0, 800, 600, 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
End Module

' KPKCharacters.vb ( Class )

Public Class KPKCharacters

Private Structure TCHARS
Dim TmpStrFileName As String
Dim TmpCharX As Integer
Dim TmpCharY As Integer
Dim TmpCharWidth As Integer
Dim TmpCharHeight As Integer
Dim ThDCChars As Integer
Dim ThBitmapsChars As Integer
End Structure

Dim g_Chars As TCHARS

Public Sub SetFilename(ByVal sFilename As String)
g_Chars.TmpStrFileName = sFilename
End Sub

Public Sub InitCharacters(ByVal hDest As Integer)
g_Chars.ThDCChars = CreateCompatibleDC(hDest)
g_Chars.ThBitmapsChars = LoadImage(0, g_Chars.TmpStrFileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
SelectObject(g_Chars.ThDCChars, g_Chars.ThBitmapsChars)
End Sub

Public Sub SetPositionX(ByVal ChX As Integer)
g_Chars.TmpCharX = ChX
End Sub

Public Sub SetPositionY(ByVal ChY As Integer)
g_Chars.TmpCharY = ChY
End Sub

Public Function GetPosX() As Integer
GetPosX = g_Chars.TmpCharX
End Function

Public Function GetPosY() As Integer
GetPosY = g_Chars.TmpCharY
End Function

Public Sub SetCharactersWidth(ByVal CWidth As Integer)
g_Chars.TmpCharWidth = CWidth
End Sub

Public Sub SetCharactersHeight(ByVal CHeight As Integer)
g_Chars.TmpCharHeight = CHeight
End Sub

Public Function GetCharWidth() As Integer
getcharwidth = g_Chars.TmpCharWidth
End Function

Public Function GetCharHeight() As Integer
GetCharHeight = g_Chars.TmpCharHeight
End Function

Public Sub DrawCharacters(ByVal hDest As Integer, ByVal SrcX As Integer, ByVal SrcY As Integer, ByVal dwRop As Integer)
BitBlt(hDest, GetPosX(), GetPosY(), _
GetCharWidth(), GetCharHeight(), g_Chars.ThDCChars, SrcX, SrcY, dwRop)
End Sub

Public Sub ReleaseCharacters()
DeleteObject(g_Chars.ThBitmapsChars)
DeleteObject(g_Chars.ThDCChars)
End Sub

End Class

' 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

' Design VB.NET Source Code Games By Fernando Firaht

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

Car Games

' VB.NET Car Games Source Code

Option Explicit On
Option Strict On

Public Class Form1

' Declare KPKEngines Class
Dim g_Engines As New KPKEngines

' KPKMaps Class
Dim Mps As New KPKMaps
Dim hMaps As Integer
Dim MapsX As Integer
Dim MapsY As Integer

Const AreaWidth As Integer = 1280
Const AreaHeight As Integer = 1024

Dim Rows As Integer
Dim Cols As Integer

' Car KPKCharacters Class
Dim Car As New KPKCharacters
Dim CarX As Integer
Dim CarY As Integer
Dim CarCols As Integer
Dim CarRows As Integer
Dim CarMoveEnd As Boolean

' Enemy Car
Dim eCar As New KPKCharacters
Dim eCarX As Integer
Dim eCarY As Integer
Dim eCarCols As Integer
Dim eCarRows As Integer
Dim eCarStart As Boolean
Dim eCarMoveLeft As Boolean
Dim eCarMoveDown As Boolean
Dim eCarMoveRight As Boolean
Dim eCarMoveEnd As Boolean

Const CarWidth As Integer = 32
Const CarHeight As Integer = 18

Dim CColumns() As Integer
Dim CRows() As Integer

Private Function LoadBitmaps(ByVal sFilename As String) As Integer
Dim tmphDC As Integer
Dim tmphBitmaps As Integer
tmphDC = CreateCompatibleDC(g_Engines.GethDCBuffer)
tmphBitmaps = LoadImage(0, sFilename, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
SelectObject(tmphDC, tmphBitmaps)
DeleteObject(tmphBitmaps)
LoadBitmaps = tmphDC
End Function

Private Sub ReleaseGames()
DeleteDC(hMaps)
Car.ReleaseChar()
eCar.ReleaseChar()
g_Engines.ReleaseEngines()
End Sub

Private Sub Form1_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
Call ReleaseGames()
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()
End
Case Keys.Left
eCarStart = True
If Mps.GetTileMoveState(CarCols - 1, CarRows) = 1 Then
CarCols = CarCols - 1
If CarCols = 2 And CarRows = 9 Then
CarMoveEnd = True
End If
End If
End Select
End Sub

Private Sub InitGames()
CarCols = 26
CarRows = 9
CarMoveEnd = False

eCarCols = 26
eCarRows = 5
eCarMoveEnd = False
eCarStart = False
eCarMoveLeft = True
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Randomize()
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.Sizable
Me.MaximizeBox = False
Me.Text = " VB.NET Cars Games "
Me.KeyPreview = True
g_Engines.InitEngines(Me.Handle.ToInt32, AreaWidth, AreaHeight)

hMaps = LoadBitmaps("D:\MapsTiles01.Bmp")
Mps.LoadMaps("D:\Maps\VB.NET_Cars_Game_01.MAPS")

ReDim CColumns(Mps.GetMapsWidth)
ReDim CRows(Mps.GetMapsHeight)

' Init Games
Call InitGames()

' Init Car
Car.SetFileNameNormal("D:\Image Games\Red_Car_Normal_01.Bmp")
Car.SetFileNameMask("D:\Image Games\Red_Car_Mask_01.Bmp")
Car.InitCharNormal(g_Engines.GethDCBuffer)
Car.InitCharMask(g_Engines.GethDCBuffer)
Car.SetCharWidth(CarWidth)
Car.SetCharHeight(CarHeight)

' Init Enemy Car
eCar.SetFileNameNormal("D:\Image Games\Blue_Car_Normal_01.Bmp")
eCar.SetFileNameMask("D:\Image Games\Blue_Car_Mask_01.Bmp")
eCar.InitCharNormal(g_Engines.GethDCBuffer)
eCar.InitCharMask(g_Engines.GethDCBuffer)
eCar.SetCharWidth(CarWidth)
eCar.SetCharHeight(CarHeight)

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

Private Sub DrawMaps()
For Rows = 1 To Mps.GetMapsHeight
For Cols = 1 To Mps.GetMapsWidth
BitBlt(g_Engines.GethDCBuffer, Mps.GetTilePosX(Cols, Rows), _
Mps.GetTilePosY(Cols, Rows), Mps.GetTileWidth(Cols, Rows), _
Mps.GetTileHeight(Cols, Rows), hMaps, Mps.GetTileX(Cols, Rows), _
Mps.GetTileY(Cols, Rows), SRCCOPY)
Next Cols
Next Rows
End Sub

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

' Draw Maps
Call DrawMaps()

' Calculation Columns And Rows
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

' Set Position Car
CarX = CColumns(CarCols)
CarY = CRows(CarRows) + 5

Car.SetCharX(CarX)
Car.SetCharY(CarY)
Car.DrawCharactersTransparency()

If eCarStart = True Then
If eCarMoveLeft = True Then
eCarCols = eCarCols - 1
eCarRows = 5
If eCarCols <= 2 Then
eCarMoveLeft = False
eCarMoveDown = True
End If
End If
If eCarMoveDown = True Then
eCarCols = 2
eCarRows = eCarRows + 1
If eCarRows >= 7 Then
eCarMoveDown = False
eCarMoveRight = True
End If
End If
If eCarMoveRight = True Then
eCarCols = eCarCols + 1
eCarRows = 7
If eCarCols >= 26 Then
eCarCols = 26
eCarRows = 7
eCarMoveRight = False
eCarMoveEnd = True
End If
End If
End If

' Check You Or Enemy Win
If CarMoveEnd = True And eCarMoveEnd = False Then
Me.Text = " You Win "
ElseIf eCarMoveEnd = True And CarMoveEnd = False Then
Me.Text = " Enemy Win "
End If
' Set Position Enemy Car
eCarX = CColumns(eCarCols)
eCarY = CRows(eCarRows) + 5

eCar.SetCharX(eCarX)
eCar.SetCharY(eCarY)
eCar.DrawCharactersTransparency()


g_Engines.EndEngines()
End Sub

End Class

' basMain.vb ( Class )

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

' 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

' 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

' 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

' Design VB.NET Source Code Games By Fernando Firaht

VB.NET Treasure Games

' VB.NET Games Source Code

Option Explicit On
Option Strict On

Public Class Form1

' Declare KPKEngines Class
Dim mKPKEngines As KPKEngines

' Declare KPKMaps Class
Dim mKPKMaps As KPKMaps
Dim hMapsTiles As Integer
Dim mMapsX As Integer
Dim mMapsY As Integer

' Declare KPKCharacters Class
Dim mKPKChar As KPKCharacters
Dim mCharX As Integer
Dim mCharY As Integer
Dim mCharCols As Integer
Dim mCharRows As Integer

Const mCharWidth As Integer = 39
Const mCharHeight As Integer = 47

' Declare KPKCharacters Class
Dim mKPKTreasure As KPKCharacters
Dim mTreasureX As Integer
Dim mTreasureY As Integer
Dim mTreasureCols As Integer
Dim mTreasureRows As Integer
Dim bRndTreasurePos As Boolean
Dim bShowTreasure As Boolean

Const mTreasureWidth As Integer = 31
Const mTreasureHeight As Integer = 32

Dim Rows As Integer
Dim Cols As Integer

Dim CColumns() As Integer
Dim CRows() As Integer

Private Sub InitClass()
mKPKEngines = New KPKEngines
mKPKMaps = New KPKMaps
mKPKChar = New KPKCharacters
mKPKTreasure = New KPKCharacters
End Sub

Private Sub InitMaps()
hMapsTiles = mKPKEngines.LoadBitmaps("D:\MapsTiles_002.Bmp")
mKPKMaps.LoadMaps("D:\Maps\Treasure_Game_01.MAPS")
End Sub

Private Sub ReleaseGames()
DeleteDC(hMapsTiles)
mKPKChar.ReleaseChar()
mKPKTreasure.ReleaseChar()
mKPKEngines.ReleaseEngines()
End Sub

Private Sub InitEngines()
mKPKEngines.InitEngines(Me.Handle.ToInt32, 1280, 1024)
End Sub

Private Sub InitGames()
mCharCols = 2
mCharRows = 2

bRndTreasurePos = True
bShowTreasure = False
End Sub

Private Sub InitChar()
mKPKChar.SetFileNameNormal("D:\Image Games\Treasure_Char_Normal_01.Bmp")
mKPKChar.SetFileNameMask("D:\Image Games\Treasure_Char_Mask_01.Bmp")
mKPKChar.SetCharWidth(mCharWidth)
mKPKChar.SetCharHeight(mCharHeight)
mKPKChar.InitCharNormal(mKPKEngines.GethDCBuffer)
mKPKChar.InitCharMask(mKPKEngines.GethDCBuffer)
End Sub

Private Sub InitTreasure()
mKPKTreasure.SetFileNameNormal("D:\Image Games\Treasure_01.Bmp")
mKPKTreasure.SetCharWidth(mTreasureWidth)
mKPKTreasure.SetCharHeight(mTreasureHeight)
mKPKTreasure.InitCharNormal(mKPKEngines.GethDCBuffer)
End Sub

Private Sub MainLoop()
mKPKEngines.BeginEngines()
Call DrawMaps()

' Calculation Columns And Rows
For Rows = 1 To mKPKMaps.GetMapsHeight
For Cols = 1 To mKPKMaps.GetMapsWidth
CColumns(Cols) = mMapsX + (Cols - 1) * 32
CRows(Rows) = mMapsY + (Rows - 1) * 32
Next Cols
Next Rows

mTreasureX = CColumns(mTreasureCols)
mTreasureY = CRows(mTreasureRows)

If bRndTreasurePos = True Then
mTreasureCols = CInt(Rnd() * mKPKMaps.GetMapsWidth)
mTreasureRows = CInt(Rnd() * mKPKMaps.GetMapsHeight)
If mTreasureCols <= 0 Then
mTreasureCols = 1
End If
If mTreasureRows <= 0 Then
mTreasureRows = 1
End If
If mKPKMaps.GetTileMoveState(mTreasureCols, mTreasureRows) = 1 Then
bRndTreasurePos = False
End If
End If
Me.Text = " Treasure Cols = " & mTreasureCols & " Treasure Rows = " & mTreasureRows
' Draw Treasure
If bShowTreasure = True Then
mKPKTreasure.SetCharX(mTreasureX)
mKPKTreasure.SetCharY(mTreasureY)
mKPKTreasure.DrawCharacters()
End If

mCharX = CColumns(mCharCols) - 2
mCharY = CRows(mCharRows) - 10
' Draw Char
mKPKChar.SetCharX(mCharX)
mKPKChar.SetCharY(mCharY)
mKPKChar.DrawCharactersTransparency()

mKPKEngines.EndEngines()
End Sub

Private Sub DrawMaps()
mKPKMaps.DrawMaps(mKPKEngines.GethDCBuffer, hMapsTiles)
End Sub

Private Sub Form1_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
Call ReleaseGames()
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()
End
Case Keys.Right
If mKPKMaps.GetTileMoveState(mCharCols + 1, mCharRows) = 1 Then
mCharCols = mCharCols + 1
End If
Case Keys.Left
If mKPKMaps.GetTileMoveState(mCharCols - 1, mCharRows) = 1 Then
mCharCols = mCharCols - 1
End If
Case Keys.Up
If mKPKMaps.GetTileMoveState(mCharCols, mCharRows - 1) = 1 Then
mCharRows = mCharRows - 1
End If
Case Keys.Down
If mKPKMaps.GetTileMoveState(mCharCols, mCharRows + 1) = 1 Then
mCharRows = mCharRows + 1
End If
Case Keys.Enter
If mCharCols <> mTreasureCols Or mCharRows <> mTreasureRows Then
bShowTreasure = False
MsgBox(" Can't Find Treasure ", MsgBoxStyle.Critical Or MsgBoxStyle.OkOnly, " VB.NET Treasure Games ")
End If
If mCharCols = mTreasureCols And mCharRows = mTreasureRows Then
bShowTreasure = True
MsgBox(" You Find Treasure ", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly, " VB.NET Treasure Games ")
End If
End Select
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Randomize()
Call InitClass()
Call InitEngines()
Call InitMaps()
ReDim CColumns(mKPKMaps.GetMapsWidth)
ReDim CRows(mKPKMaps.GetMapsHeight)
Call InitGames()
Call InitChar()
Call InitTreasure()
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
Call MainLoop()
End Sub

Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
Select Case e.Button
Case Windows.Forms.MouseButtons.Right
If MsgBox(" Do you want to New Treasure Games? ", MsgBoxStyle.Question Or MsgBoxStyle.YesNo, " VB.NET Treasure Games ") = MsgBoxResult.Yes Then
Call InitGames()
End If
End Select
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 Overloads Function LoadBitmaps(ByVal hDCDest As Integer, ByVal sFilename As String) As Integer
Dim tmphDC As Integer
Dim tmphBitmaps As Integer
tmphDC = CreateCompatibleDC(hDCDest)
tmphBitmaps = LoadImage(0, sFilename, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
SelectObject(tmphDC, tmphBitmaps)
DeleteObject(tmphBitmaps)
LoadBitmaps = tmphDC
End Function

Public Overloads Function LoadBitmaps(ByVal sFilename As String) As Integer
Dim tmphDC As Integer
Dim tmphBitmaps As Integer
tmphDC = CreateCompatibleDC(TmphBuffer)
tmphBitmaps = LoadImage(0, sFilename, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
SelectObject(tmphDC, tmphBitmaps)
DeleteObject(tmphBitmaps)
LoadBitmaps = tmphDC
End Function

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

' 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 Sub DrawMaps(ByVal hDest As Integer, ByVal hSrc As Integer)
For TmpRows = 1 To MapsHeight
For TmpCols = 1 To MapsWidth
BitBlt(hDest, strMaps(TmpCols, TmpRows).TilePosX, strMaps(TmpCols, TmpRows).TilePosY, _
strMaps(TmpCols, TmpRows).TileWidth, strMaps(TmpCols, TmpRows).TileHeight, _
hSrc, strMaps(TmpCols, TmpRows).TileX, strMaps(TmpCols, TmpRows).TileY, SRCCOPY)
Next TmpCols
Next TmpRows
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

' Design VB.NET Source Code Games By Fernando Firaht

The Gun Balls Games

' 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