' VB.NET Games Source Code
Option Explicit On
Option Strict On
Public Class Form1
Private Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hdc As Integer) As Integer
Private Declare Function CreateCompatibleBitmap Lib "gdi32" Alias "CreateCompatibleBitmap" (ByVal hdc As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer
Private Declare Function SelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As Integer, ByVal hObject As Integer) As Integer
Private Declare Function DeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hdc As Integer) As Integer
Private Declare Function DeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Integer) As Integer
Private Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Integer) As Integer
Private 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
Private 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
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
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 InitGames()
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()
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 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 InitGames()
hImages = LoadBitmaps("D:\MapsTiles01.bmp")
Mps.LoadMaps("D:\Maps\Move Maps 02.MAPS")
CharCols = 5
CharRows = 2
hMaps = CreateDC(hBuffer, Mps.GetMapsWidth * 32, Mps.GetMapsHeight * 32)
Call InitCharacters("D:\Image Games\yBall_Normal.Bmp", "D:\Image Games\yBall_Mask.Bmp")
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)
BitBlt(hBuffer, MapsX, MapsY, Mps.GetMapsWidth * 32, Mps.GetMapsHeight * 32, hMaps, 0, 0, SRCCOPY)
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
' 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
ไม่มีความคิดเห็น:
แสดงความคิดเห็น