welcome to faisol cakep.blogspot

Type=Exe
Form=SimpleSnake.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\WINDOWS\system32\stdole2.tlb#OLE Automation
Startup="Form1"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="."
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

[MS Transaction Server]
AutoRefresh=1

Type=Exe
Form=SimpleSnake.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\WINDOWS\system32\stdole2.tlb#OLE Automation
Startup="Form1"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="."
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

[MS Transaction Server]
AutoRefresh=1

VERSION 5.00
Begin VB.Form Form1
Caption = "SimpleSnake"
ClientHeight = 3090
ClientLeft = 60
ClientTop = 450
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3090
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
WindowState = 2 'Maximized
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
Height = 7935
Left = 0
ScaleHeight = 7875
ScaleWidth = 9795
TabIndex = 0
Top = 0
Width = 9855
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetTickCount Lib "kernel32" () As Long 'this function lets us not use timer
'timers are bad :)

'main body... each part of the snake has X and Y
Private Type Part
X As Integer
Y As Integer
End Type

'Dynamic array to store part coordinates
Dim Part() As Part

'Velocity in X and Y direction of the snake
Dim vX As Integer, vY As Integer
Dim i As Integer 'for loops
Dim CS As Single 'cell size

Dim FX As Integer, FY As Integer 'food coordinates
Dim X As Integer, Y As Integer

Dim bRunning As Boolean, died As Boolean

Private Sub Form_Load()
Randomize 'random generation

'Initialize controls******************
Picture1.BackColor = vbWhite
Picture1.ScaleMode = 3 'pixels

CS = 20 'cell size in pixels
X = Int(Picture1.ScaleWidth / CS)
Y = Int(Picture1.ScaleHeight / CS)

Picture1.AutoRedraw = True
Picture1.ScaleWidth = X * CS
Picture1.ScaleHeight = Y * CS

Me.WindowState = 2
Me.Show

DrawGrid Picture1, CS
'*************************************

died = False
'set up the game
ReDim Part(0)
Part(0).X = 0
Part(0).Y = 0

FX = Int(Rnd * X)
FY = Int(Rnd * Y)
'go to main loop
bRunning = True
MainLoop
End Sub

Sub MainLoop()
Do While bRunning = True
Update
Draw
WAIT (50) 'increasing this number makes game slower
Loop

Unload Me
End Sub

Sub Update()
'MOVE PARTS
For i = UBound(Part) To 1 Step -1
Part(i).X = Part(i - 1).X
Part(i).Y = Part(i - 1).Y
Next i

'MOVE HEAD
Part(0).X = Part(0).X + vX
Part(0).Y = Part(0).Y + vY

'HAS HE GONE OUT OF BOUNDS ?
If Part(0).X <>= X Or Part(0).Y <>= Y Then
died = True
End If

'HAS HE CRASHED INTO HIMSELF ?
For i = 1 To UBound(Part)
If Part(i).X = Part(0).X And Part(i).Y = Part(0).Y Then
died = True
End If
Next i

'DID HE EAT FOOD ?
If Part(0).X = FX And Part(0).Y = FY Then
ReDim Preserve Part(UBound(Part) + 1)
Part(UBound(Part)).X = -CS
Part(UBound(Part)).Y = -CS
FX = Int(Rnd * X)
FY = Int(Rnd * Y)

Form1.Caption = "Parts: " & UBound(Part)
End If

'IS HE DEAD ?
If died = True Then NewGame
End Sub

Sub Draw()
'DRAW WHITENESS
Rectangle 0, 0, X * CS, Y * CS, vbWhite
'DRAW SNAKE. PARTS IN BLUE, HEAD IN GREEN
For i = 1 To UBound(Part)
Rectangle Part(i).X * CS, Part(i).Y * CS, Part(i).X * CS + CS, Part(i).Y * CS + CS, vbBlue
Next i
Rectangle Part(0).X * CS, Part(0).Y * CS, Part(0).X * CS + CS, Part(0).Y * CS + CS, vbGreen
'DRAW FOOD
Rectangle FX * CS, FY * CS, FX * CS + CS, FY * CS + CS, vbRed

DrawGrid Picture1, CS
End Sub

Sub Rectangle(X1 As Integer, Y1 As Integer, X2 As Integer, Y2 As Integer, color As Long)
Picture1.Line (X1, Y1)-(X2, Y2), color, BF
End Sub

Sub NewGame()
'SET UP NEW GAME
died = False

ReDim Part(0)
Part(0).X = 0
Part(0).Y = 0

vX = 0
vY = 0

FX = Int(Rnd * X)
FY = Int(Rnd * Y)
End Sub

Sub DrawGrid(Pic As Control, CS As Single)
'**************************************************************************
'DRAW GRID
'**************************************************************************
Dim i As Integer, Across As Single, Up As Single

Across = Pic.ScaleWidth / CS
Up = Pic.ScaleHeight / CS

For i = 0 To Across
Pic.Line (i * CS, 0)-(i * CS, Up * CS)
Next i

For i = 0 To Up
Pic.Line (0, i * CS)-(Across * CS, i * CS)
Next i
End Sub

Sub WAIT(Tim As Integer)
'**************************************************************************
'WAIT FUNCTION
'**************************************************************************
Dim LastWait As Long
LastWait = GetTickCount

Do While Tim > GetTickCount - LastWait
DoEvents
Loop
End Sub

Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
'USER KEYPRESSES HANDLED HERE
Select Case KeyCode
Case vbKeyRight
vX = 1
vY = 0
Case vbKeyLeft
vX = -1
vY = 0
Case vbKeyUp
vX = 0
vY = -1
Case vbKeyDown
vX = 0
vY = 1
End Select
End Sub

Private Sub Picture1_KeyPress(KeyAscii As Integer)
'27 is ESC. IF user presses ESC, QUIT
If KeyAscii = 27 Then bRunning = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
'This function can be left out
End
End Sub

KANTOR POLISI

Pada suatu hari Fadli mendapat SMS dari Fani, pacarnya. Di SMS tersebut Fani bilang “Yang, skrng aq sdng d kntr polisi, smua bukti n saksi tlh mengarh kpd q, polisi tlh mengintrogasiku, aq takut, stlh bbrp lm akhrny...”. Tanpa berpikir panjang Fadli mengambil motor di garasinya dan langsung tancap gas menuju kantor polisi.

Sampai di kantor polisi, ternyata gadis pujaannya itu sama sekali tak terlihat batang hidungnya. Karena Fadli adalah anak yang sangat pemalu dan lugu, dia tidak berani bertanya kepada pak polisi yang sedang berjaga di kantor tersebut.

Setelah beberapa lama mondar-mandir di tempat tersebut, akhirnya dia memberanikan diri untuk bertanya kepada pak satpam yang sedang jaga di pintu gerbang. “Pak, boleh numpang tanya!, sejak tadi ada gak cewek yang di tahan di kantor ini?”.

“Waduh... saya gak tau mas, di sini saya hanya bertugas untuk mengatur kendaraan yang keluar masuk dari tempat ini”, jawab pak satpam kepada Fadli.

“Kalau gitu, makasih pak!”, sahut Fadli.

Mendengar jawaban dari pak satpam, Fadli mempunyai inisiatif untuk menelepon pacarnya tersebut. “Hallo... Say, kamu ada dimana?, kucari ke kantor polisi kok gak ada?, gimana keadaan kamu?, katanya kamu ditahan di kantor polisi?”, ucap Fadli dengan sedikit merasa cemas.

Sambil tersenyum dia mencoba menenangkan kekasihnya, “Yang, sekarang aku sedang di rumah, aku baik-baik aja kok!”.

“Terus yang kirim SMS ke aku itu siapa?”, tanya Fadli kepada Fani.

“Oh... SMS itu, kamu pasti belum baca isi semua SMS dariku itu!. baca lagi donk!”, tukas Fani.

Fadli terdiam.

“Udah gitu aja yach... nanti pulsa kamu habis. Udah yach... dah sayaaang...”, Fani kemudian menutup hand phonenya.

Fadli masih bingung!. Lalu dia membuka SMS itu lagi dan membacanya. Beberapa saat kemudian dia tertawa sendiri karena tahu isi lengkap SMS tersebut adalah, “Yang, skrng aq sdng d kntr polisi, smua bukti n saksi tlh mengarh kpd q, polisi tlh mengintrogasiku, aq takut, stlh bbrp lm akhrny aq dpt srt tilang, d srt tu trtls anda dinyatakan bebas krn semua bukti n saksi menyatakan bahwa anda adalah wanita yg cantik menawan hati