' 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
ไม่มีความคิดเห็น:
แสดงความคิดเห็น