| Other things |
| Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Duis ligula lorem, consequat eget, tristique nec, auctor quis, purus. Vivamus ut sem. Fusce aliquam nunc vitae purus. |
| Other things |
| Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Duis ligula lorem, consequat eget, tristique nec, auctor quis, purus. Vivamus ut sem. Fusce aliquam nunc vitae purus. |
| Other things |
| Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Duis ligula lorem, consequat eget, tristique nec, auctor quis, purus. Vivamus ut sem. Fusce aliquam nunc vitae purus. |
| Other things |
| Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Duis ligula lorem, consequat eget, tristique nec, auctor quis, purus. Vivamus ut sem. Fusce aliquam nunc vitae purus. |
| Other things |
| Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Duis ligula lorem, consequat eget, tristique nec, auctor quis, purus. Vivamus ut sem. Fusce aliquam nunc vitae purus. |
|
| VB 5 Aqyuw |
| Rabu, Maret 25, 2009 |
 
Nie yang ke-5. Huh jadi juga. Hehehehe...........
Oh ya aq lupa. klo ingin lebih tau yg namanya "VB" dapat jga buka alamat ini: planetsourcecode.com
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 YPrivate Type PartX As IntegerY As IntegerEnd Type 'Dynamic array to store part coordinatesDim Part() As Part 'Velocity in X and Y direction of the snakeDim vX As Integer, vY As IntegerDim i As Integer 'for loopsDim CS As Single 'cell size Dim FX As Integer, FY As Integer 'food coordinatesDim X As Integer, Y As Integer Dim bRunning As Boolean, died As Boolean Private Sub Form_Load()Randomize 'random generation 'Initialize controls******************Picture1.BackColor = vbWhitePicture1.ScaleMode = 3 'pixels CS = 20 'cell size in pixelsX = Int(Picture1.ScaleWidth / CS)Y = Int(Picture1.ScaleHeight / CS) Picture1.AutoRedraw = TruePicture1.ScaleWidth = X * CSPicture1.ScaleHeight = Y * CS Me.WindowState = 2Me.Show DrawGrid Picture1, CS'************************************* died = False'set up the gameReDim Part(0)Part(0).X = 0Part(0).Y = 0 FX = Int(Rnd * X)FY = Int(Rnd * Y)'go to main loopbRunning = TrueMainLoopEnd Sub Sub MainLoop()Do While bRunning = True Update Draw WAIT (50) 'increasing this number makes game slowerLoop Unload MeEnd Sub Sub Update()'MOVE PARTSFor i = UBound(Part) To 1 Step -1 Part(i).X = Part(i - 1).X Part(i).Y = Part(i - 1).YNext i 'MOVE HEADPart(0).X = Part(0).X + vXPart(0).Y = Part(0).Y + vY 'HAS HE GONE OUT OF BOUNDS ?If Part(0).X <>= X Or Part(0).Y <>= Y Thendied = TrueEnd 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 Thendied = TrueEnd IfNext 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 NewGameEnd 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, CSEnd 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, BFEnd Sub Sub NewGame()'SET UP NEW GAMEdied = False ReDim Part(0)Part(0).X = 0Part(0).Y = 0 vX = 0vY = 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 iEnd Sub Sub WAIT(Tim As Integer) '************************************************************************** 'WAIT FUNCTION '************************************************************************** Dim LastWait As Long LastWait = GetTickCount Do While Tim > GetTickCount - LastWait DoEvents LoopEnd Sub Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)'USER KEYPRESSES HANDLED HERESelect Case KeyCodeCase vbKeyRightvX = 1vY = 0Case vbKeyLeftvX = -1vY = 0Case vbKeyUpvX = 0vY = -1Case vbKeyDownvX = 0vY = 1End SelectEnd Sub Private Sub Picture1_KeyPress(KeyAscii As Integer)'27 is ESC. IF user presses ESC, QUITIf KeyAscii = 27 Then bRunning = FalseEnd Sub Private Sub Form_Unload(Cancel As Integer)'This function can be left outEndEnd Sub
|
posted by Winn_Doeell @ 4:42:00 AM   |
|
|
|
| VB 4 Aqyuew |
|
Lah nie baru yang ke-4. Wow akhirnya. Hehehehehe........
Option ExplicitDim days As Long '<-Stores the number of days elapsed from 1/1/1900 to current month and yearDim i As Integer Private Sub cmdGenerate_Click()On Error GoTo Error_handle 'On error, goto to end of functiondays = 0For i = 0 To 34 Label1(i).Caption = "" 'Clear all the labelsNext i For i = 1900 To txtYear.Text - 1 If i Mod 4 = 0 Then 'If leap year then count 366 days days = days + 366 Else 'else 365 days days = days + 365 End IfNext i For i = 1 To txtMonth.Text - 1 If i = 1 Or i = 3 Or i = 5 Or i = 7 Or i = 8 Or i = 10 Or i = 12 Then 'For January,March,May....,December count 31 days days = days + 31 ElseIf (i = 4 Or i = 6 Or i = 9 Or i = 11) Then 'For April,June,September,November count 30 days days = days + 30 ElseIf (i = 2 And txtYear.Text Mod 4 = 0) Then 'If month is February and year is leap year count 29 days days = days + 29 Else 'If month is February and year is not a leap year, count 28 days days = days + 28 End If Next i If (i = 1 Or i = 3 Or i = 5 Or i = 7 Or i = 8 Or i = 10 Or i = 12) Then show_calender 31 'Show calender with 31 days ElseIf (i = 4 Or i = 6 Or i = 9 Or i = 11) Then show_calender 30 'Show calender with 30 days ElseIf (i = 2 And txtYear.Text Mod 4 = 0) Then show_calender 29 'Show calender with 29 days Else show_calender 28 'Show calender with 28 days End IfError_handle:End Sub Private Function show_calender(n As Integer) '//<- n stores the number of days to displayDim i, k As Integerk = days Mod 7 'Divide days with 7, the remainder give the current dayFor i = 1 To n Label1(k).Caption = i 'Display the number in calender format k = k + 1 If k = 35 Then k = 0Next iEnd Function |
| posted by Winn_Doeell @ 4:35:00 AM |
|
|
|
| VB 3 Qyuuw |
|
Lah nie baru tugas ke-3 Aqy. Huh akhirnya.......
Nie Script-nya!!!
Option Explicit Private Hasil As Double Private Const opNol = 0 Private Const opTambah = 1 Private Const opKurang = 2 Private Const opKali = 3 Private Const opBagi = 4 Private Operator As Integer Private NilaiBaru As Boolean ' untuk menghapus karakter terakhir Private Sub Hapus() Dim txt As String Dim min_len As Integer txt = txtDisplay.Text If Left$(txt, 1) = "-" Then min_len = 2 Else min_len = 1 End If If Len(txt) > min_len Then txtDisplay.Text = Left$(txt, Len(txt) - 1) Else txtDisplay.Text = "0" End If End Sub ' hapus angka, hasil terakhir dan operator Private Sub cmdClear_Click() cmdClearEntry_Click Hasil = 0 Operator = opNol End Sub ' hapus angka Private Sub cmdClearEntry_Click() txtDisplay.Text = "" End Sub ' menambahkan koma (desimal) Private Sub cmdKoma_Click() If InStr(txtDisplay.Text, ".") Then Beep Else If NilaiBaru Then txtDisplay.Text = "." " NilaiBaru = False Else txtDisplay.Text = txtDisplay.Text & "." End If End If End Sub ' Menghitung Private Sub cmdSamaDengan_Click() Dim HasilBaru As Double If txtDisplay.Text = "" Then HasilBaru = 0 Else HasilBaru = CDbl(txtDisplay.Text) End If Select Case Operator Case opNol Hasil = HasilBaru Case opTambah Hasil = Hasil + HasilBaru Case opKurang Hasil = Hasil - HasilBaru Case opKali Hasil = Hasil * HasilBaru Case opBagi 'Tidak bisa dibagi nol If HasilBaru = 0 Then MsgBox "Tidak bisa dibagi 0", vbOKOnly + vbCritical, "Kalku ERROR" Call cmdClear_Click Else Hasil = Hasil / HasilBaru End If End Select Operator = opNol NilaiBaru = True txtDisplay.Text = Format$(Hasil) End Sub ' menuliskan angka Private Sub cmdAngka_Click(Index As Integer) If NilaiBaru Then txtDisplay.Text = Format$(Index) NilaiBaru = False Else txtDisplay.Text = _ txtDisplay.Text & Format$(Index) End If End Sub ' tombol tambah/kurang/bagi/kali Private Sub cmdOperator_Click(Index As Integer) cmdSamaDengan_Click Operator = Index NilaiBaru = True End Sub ' merubah tanda +/- Private Sub cmdPlusMinus_Click() If NilaiBaru Then txtDisplay.Text = "-" ElseIf Left$(txtDisplay.Text, 1) = "-" Then txtDisplay.Text = Right$(txtDisplay.Text, 2) Else Artikel Populer IlmuKomputer.Com Copyright © 2005 IlmuKomputer.Com txtDisplay.Text = "-" & txtDisplay.Text End If End Sub ' filter untuk angka saja yg dapat diketikkan Private Sub Form_KeyPress(KeyAscii As Integer) txtDisplay_KeyPress KeyAscii End Sub Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) txtDisplay_KeyUp KeyCode, Shift End Sub ' supaya kursor tetap di kanan Private Sub txtDisplay_Change() txtDisplay.SelStart = Len(txtDisplay.Text) End Sub Private Sub txtDisplay_GotFocus() txtDisplay_Change End Sub ' untuk mengetikkan angka di keyboard Private Sub txtDisplay_KeyPress(KeyAscii As Integer) Dim ch As String ch = Chr$(KeyAscii) Select Case ch Case "0" cmdAngka_Click 0 Case "1" cmdAngka_Click 1 Case "2" cmdAngka_Click 2 Case "3" cmdAngka_Click 3 Case "4" cmdAngka_Click 4 Case "5" cmdAngka_Click 5 Case "6" cmdAngka_Click 6 Case "7" cmdAngka_Click 7 Case "8" cmdAngka_Click 8 Case "9" cmdAngka_Click 9 Case "*", "x", "X" cmdOperator_Click opKali Case "+" " cmdOperator_Click opTambah Case vbCrLf, vbCr, "=" " cmdSamaDengan_Click Case "-" " cmdOperator_Click opKurang Case "." " cmdKoma_Click Case "/" " cmdOperator_Click opBagi Case "C", "c" cmdClearEntry_Click End Select KeyAscii = 0 End Sub ' untuk ketikan angka di numpad Private Sub txtDisplay_KeyUp(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case vbKeyNumpad0 cmdAngka_Click 0 Case vbKeyNumpad1 cmdAngka_Click 1 Case vbKeyNumpad2 cmdAngka_Click 2 Case vbKeyNumpad3 cmdAngka_Click 3 Case vbKeyNumpad4 cmdAngka_Click 4 Case vbKeyNumpad5 cmdAngka_Click 5 Case vbKeyNumpad6 cmdAngka_Click 6 Case vbKeyNumpad7 cmdAngka_Click 7 Case vbKeyNumpad8 cmdAngka_Click 8 Case vbKeyNumpad9 cmdAngka_Click 9 Case vbKeyMultiply cmdOperator_Click opKali Case vbKeyAdd cmdOperator_Click opTambah Case vbKeySeparator cmdSamaDengan_Click Case vbKeySubtract cmdOperator_Click opKurang Case vbKeyDivide cmdOperator_Click opBagi Case vbKeyDecimal cmdKoma_Click Case vbKeyBack, vbKeyDelete Hapus End Select KeyCode = 0 End Sub Private Sub Text1_Change() End Sub
|
| posted by Winn_Doeell @ 4:15:00 AM |
|
|
|
| VB 2 Qyuuw |
|
Nie tugas ke-2 Aqyu dari P.Willy meskipun Aq dapat banyak rintangan jadi juga akhirnya.
Hehehehehe..............
|
| posted by Winn_Doeell @ 4:10:00 AM |
|
|
|
| VB 1Qyu |
| Kamis, Maret 05, 2009 |
Nie adalah tugas ke-1 Aqyuw dari P.Willy |
| posted by Winn_Doeell @ 4:36:00 AM |
|
|
|
|
| About Me |
|
Name: Winn_Doeell
Home: Malang, Jatim, Indonesia
About Me: Nama Q Windoel. hehehe Q pemlu tapi Q cew yang ceria. Q sebenarnya gk suka dapet masalah. Mbenceknoo.............. hahahahahah............... Q sayang ma orang2 di sekitar Q. Q kan membahagiakan ortu Q. hahahaha...........
See my complete profile
|
| Previous Post |
|
| Archives |
|
|
| Links |
|
|
| Powered by |
 |
|
