Key arrow

Source Code :
Private Sub cmd_start_Click()
cmd_start.Visible = 0
keyOn = 1
Label1.Visible = 1
End Sub

Private Sub Timer1_Timer()
Call movea
End Sub



Module Code :
Option Explicit
Public keyOn As Boolean
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer


Sub movea()
If keyOn Then

If GetAsyncKeyState(vbKeyUp) Then
Form1.Shape1.BackColor = vbBlue
End If

If GetAsyncKeyState(vbKeyDown) Then
Form1.Shape1.BackColor = vbRed
End If

If GetAsyncKeyState(vbKeyRight) Then
Form1.Shape1.BackColor = vbYellow
End If

If GetAsyncKeyState(vbKeyLeft) Then
Form1.Shape1.BackColor = vbGreen
End If

If GetAsyncKeyState(vbKeyEscape) Then
keyOn = False
Form1.Label1.Visible = 0
Form1.cmd_start.Visible = 1
End If

End If
End Sub

Link Download :
http://www.4shared.com/file/209540512/3b1868b0/Contoh_GetAsyncKeyStatedfd.html

Check Support Resolution Monitor

Source Code :

Private Sub Command1_Click()
If Screen.Width >= 19200 And Screen.Height >= 12000 Then
Label1.Caption = "1280 x 800"
Label3.Caption = Screen.Width
Label4.Caption = Screen.Height
GoTo ResSup
Else
If (Screen.Width >= 15360 Or Screen.Width <>= 11520 Then
Label1.Caption = "1024 x 768"
Label3.Caption = Screen.Width
Label4.Caption = Screen.Height
GoTo ResSup
Else
If (Screen.Width >= 12000 Or Screen.Width <> 9000 Then
Label1.Caption = "800 x 600"
Label3.Caption = Screen.Width
Label4.Caption = Screen.Height
GoTo ResNotSup
Else
GoTo ResNotSup
End If
End If
End If

ResSup: MsgBox "Resolution support!", vbOKOnly: Exit Sub
ResNotSup: MsgBox "Resolution does not support!", vbExclamation

End Sub



Private Sub Form_Load()
'19200 for Res 1280 x 800 '15360 for Res 1024 x 768 '12000 for Res 800 x 600
With Command1
If Screen.Width >= 19200 Then 'untuk Res 1280 x 800
.BackColor = vbGreen
Else
If Screen.Width = 15360 Then
.BackColor = vbBlue
Else
.BackColor = vbYellow
End If
End If
End With

End Sub

Download :
http://www.4shared.com/file/209503069/275ec3a/Contoh_Er_Resolution.html

Sprite Image

Contoh membuat background object menjadi transparant!
Langkah 1: Buat 2 buah gambar 1 dengan backgound hitam dan satunya background putih dengan warna object hitam dan ukuran yang sama. seperti dibawah ini! dibawah ini conntoh ukuran 297 x 295






Langkah 2: Masuk ke VB. Buat project baru dan tambahkan komponen picture1 dan picture2 isi dengan dua buah gambar tersebut! kemudian tambahkan timer1 dengan interval = 10. Isi form dengan gambar supaya dapat diketahui bahwa background image sudah berhasil di transparankan.



Langkah 3: Tambahkan code dibawah ini!

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, _
ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Dim xx, yy, jml
Dim Rest As Long
Dim s As Long

Private Sub Form_Load()
xx = Me.ScaleWidth - 100
yy = (ScaleHeight - 296) \ 2
End Sub

Private Sub Timer1_Timer()
Static s As Long
Me.Cls
Rest = BitBlt(hDC, xx - s, yy, 297, 294, Picture2.hDC, 0, 0, vbSrcAnd)
Rest = BitBlt(hDC, xx - s, yy, 297, 294, Picture1.hDC, 0, 0, vbSrcPaint)
jml = xx - s

s = s + 32
Me.Refresh
If jml <= (Me.ScaleWidth - 297) / 2 Then Timer1.Enabled = False End Sub

Game Kujur Silang

Kujur Silang dengan AI
Created by Ahmad wahyudi@2010

Download
http://www.4shared.com/file/189501865/45b11e52/MGKS_Setup.html

Source Code
http://www.4shared.com/file/189512009/3b9b2219/MGKS_with_AI_SCode_.html