วันศุกร์ที่ 16 มกราคม พ.ศ. 2552

Play Sound In Games With VB.NET





' VB.NET PlaySound Source Code

Option Explicit On
Option Strict On

Public Class Form1

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Integer) As Integer
Private Const SND_ASYNC As Integer = &H1 ' play asynchronously

Dim sFileName As String

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
End
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.SizableToolWindow
Me.Text = " Play Sound In Games With VB.NET "
Me.BackColor = Color.Red
Me.KeyPreview = True
BtnPlaySound.Text = " Play Sond "
BtnPlaySound.BackColor = Color.YellowGreen
BtnPlaySound.ForeColor = Color.Blue
sFileName = "D:\Bullet_1.wav"
End Sub

Private Sub BtnPlaySound_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnPlaySound.Click
sndPlaySound(sFileName, SND_ASYNC)
End Sub

End Class

' Design VB.NET Source Code Games By Fernando Firaht

Overload Function In VB.NET




' VB.NET Overloads Function Sum Source Code

Option Explicit On
Option Strict On

Public Class Form1

Private Overloads Function Sum(ByVal A As Integer, ByVal B As Integer) As Integer
Sum = A + B
End Function

Private Overloads Function Sum(ByVal T As Single, ByVal U As Single) As Single
If T <= 0 Or U <= 0 Then
T = 1
U = 1
End If
Sum = T + U
End Function

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
End
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.FixedToolWindow
Me.BackColor = Color.Bisque
Me.Width = 200
Me.Height = 50
Me.Text = " Sum : " & Sum(10, 10) & " Sum : " & Sum(15.5, 25.35)
End Sub

End Class

' Design VB.NET Source Code Games By Fernando Firaht

Move Maps In Games With VB.NET





' 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

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

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(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
MapsX = MapsX - 70
Case Keys.Right
MapsX = MapsX + 70
Case Keys.Up
MapsY = MapsY - 70
Case Keys.Down
MapsY = MapsY + 70
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")

hMaps = CreateDC(hBuffer, Mps.GetMapsWidth * 32, Mps.GetMapsHeight * 32)
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
BitBlt(hBuffer, MapsX, MapsY, Mps.GetMapsWidth * 32, Mps.GetMapsHeight * 32, hMaps, 0, 0, SRCCOPY)
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

Load Setting File In Games With VB.NET




' VB.NET Games Source Code

Public Class Form1

Private Sub Btn_LoadSettings_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Btn_LoadSettings.Click
Dim nFile As Integer
Dim nNum1 As Integer
Dim nNum2 As Integer
nFile = FreeFile()
FileOpen(nFile, "C:\Settings.SET", OpenMode.Input, OpenAccess.Read)
Input(nFile, nNum1)
Input(nFile, nNum2)
FileClose(nFile)
Me.Text = " Load Settings File = " & nNum1 & " " & nNum2
MsgBox(" Load Settings File Completed ", MsgBoxStyle.OkOnly, " Load Settings File In Games With VB.NET ")
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.SizableToolWindow
Me.Text = " Load Settings File In Games With VB.NET "
Me.BackColor = Color.Violet
Btn_LoadSettings.Text = " Load Settins File "
Btn_LoadSettings.BackColor = Color.Wheat
End Sub
End Class

' Design VB.NET Source Code Games By Fernando Firaht

Load Maps In Games With VB.NET





' 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

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

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(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_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.DoubleClick
Call ReleaseGames()
Me.Dispose()
End Sub

Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
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
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 = " Load Maps In Games With VB.NET "
Timer1.Interval = 1
Timer1.Enabled = True
Call InitGames()
hImages = LoadBitmaps("D:\MapsTiles01.bmp")
Mps.LoadMaps("D:\Maps\Load Maps In VB.NET 01.MAPS")
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(hBuffer, 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(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

Load Image In Games With VB.NET





' VB.NET Games Source Code

Option Strict On
Option Explicit On

Friend Class Form1
Inherits System.Windows.Forms.Form
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

Dim hBuffer As Integer
Dim hBBuffer As Integer
Dim hBack As Integer
Dim hBBack As Integer
Dim vhDC As Integer
Dim hImages As Integer

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(hImages)
DeleteDC(hBuffer)
DeleteDC(hBack)
End Sub

Private Sub Form1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Click
Call ReleaseGames()
Me.Dispose()
End Sub

Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
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 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 = " Load Images In Games With VB.NET "
Timer1.Interval = 1
Timer1.Enabled = True
Call InitGames()
hImages = LoadBitmaps("D:\cc.bmp")
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)
BitBlt(hBuffer, 0, 0, 200, 200, hImages, 0, 0, SRCCOPY)
BitBlt(vhDC, 0, 0, 800, 600, hBuffer, 0, 0, SRCCOPY)
End Sub
End Class

' Design VB.NET Source Code Games By Fernando Firaht

Using DrawImage Method In VB.NET




' VB.NET DrawImage Source Code

Option Explicit On
Option Strict On

Public Class Form1

Dim vImages As Image
Dim cPoint As Point
Dim vCar2 As Image
Dim CPtCar As Point

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.SizableToolWindow
Me.Text = " DrawImage method In Form With VB.NET "
Me.BackColor = Color.White
vImages = Image.FromFile("D:\Image Games\0000.bmp")
cPoint = New Point(200, 200)
vCar2 = Image.FromFile("D:\Image Games\0000.Bmp")
CPtCar = New Point(400, 200)
End Sub

Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
e.Graphics.DrawImage(vImages, cPoint)
e.Graphics.DrawImage(vCar2, CPtCar)
End Sub

End Class

' Design VB.NET Source Code Games By Fernando Firaht