Kod:
'Bilardo 'TheMahkeme ------------------------------- ' | ' | ' | ' V ' www.turkhackteam.org ' --------------------- ' 'http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=56134&lngWId=1 'Adresindeki ornek 3 top bilardo oyununa cevrilmistir... ' 'Nesneler: 'Timer1 adını tmrBrain olarak değiştirin 'Line1 'HScroll1 Option Explicit Private Type Ball CX As Single CY As Single vx As Single vy As Single End Type Const NUMBALLS As Integer = 3 'Top sayısı Const PI As Single = 3.14159 Const IMPACT As Single = 4 Const FRICTION As Single = 0.95 Const RADIUS As Integer = 10 Const TRAILDIST As Integer = 20 Dim TableBalls(0 To NUMBALLS - 1) As Ball Dim sari, kirmizi, efekt, t1, t2, t3, puan Private Sub Form_Load() Dim i As Integer Dim X As Integer TableBalls(0).CX = 0.75 * Me.ScaleWidth '0 is cueball TableBalls(0).CY = Me.ScaleHeight \ 2 Randomize (Rnd * Timer) X = Rnd * 0.5 * Me.ScaleWidth For i = 1 To NUMBALLS - 1 With TableBalls(i) .CX = X .CY = (0.5 * TableBalls(0).CY) + (i * (RADIUS * 2)) End With Next TableBalls(1).CX = 90 TableBalls(1).CY = 63 TableBalls(2).CX = 90 TableBalls(2).CY = 137 TableBalls(0).CX = 332 TableBalls(0).CY = 97 Form1.Caption = "BİLARDO" Form1.MousePointer = 2 Form1.BackColor = &H8000& Form1.Width = 5895 Form1.Height = 3555 HScroll1.Left = 8 HScroll1.Top = 200 HScroll1.Width = 113 HScroll1.Height = 9 HScroll1.Max = 200 HScroll1.Min = 20 HScroll1.Value = 20 Line1.BorderColor = &HFF00& Line1.BorderWidth = 1 tmrBrain.Interval = 10 tmrBrain.Enabled = True End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Line1.Visible = False Then Exit Sub If Button = 1 Then 'Sol tuşa bastıysa... sari = 0 kirmizi = 0 efekt = 0 t1 = 0 t2 = 1 t3 = 1 Line1.Visible = False HScroll1.Visible = False Dim R As Single Dim ang As Single With TableBalls(0) R = Sqr((X - .CX) ^ 2 + (Y - .CY) ^ 2) If R > TRAILDIST Then R = TRAILDIST End If If Not ((X - .CX) = 0) Then ang = Atn((Y - .CY) / (X - .CX)) Else If Y > .CY Then ang = PI / 2 Else ang = -PI / 2 End If End If If X < .CX Then ang = ang + PI End If 'Me.Caption = R & " - " & (ang * 180 / PI) Me.Caption = "ATIŞ..." R = HScroll1.Value .vx = R * Cos(ang) .vy = R * Sin(ang) End With Else 'soldan başka bir tuşa bastıysa efekti iptal et efekt = 0 End If End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim ang As Single Dim dx As Single Dim dy As Single With TableBalls(0) 'Me.Line (.CX, .CY)-(X, Y), vbGreen Line1.X1 = .CX Line1.X2 = X Line1.Y1 = .CY Line1.Y2 = Y End With End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub tmrBrain_Timer() Dim ColDist As Single Dim i As Integer Dim j As Integer Dim ang As Single Dim R As Single Dim dx As Single Dim dy As Single If efekt = 0 Then Me.Picture = Nothing End If For i = 0 To NUMBALLS - 1 With TableBalls(i) .CX = .CX + .vx .CY = .CY + .vy .vx = .vx * FRICTION .vy = .vy * FRICTION If (.CX < RADIUS) Then .vx = -.vx .CX = RADIUS ElseIf (.CX > (Me.ScaleWidth - 1 - RADIUS)) Then .vx = -.vx .CX = Me.ScaleWidth - 1 - RADIUS End If If (.CY < RADIUS) Then .vy = -.vy .CY = RADIUS ElseIf (.CY > (Me.ScaleHeight - 1 - RADIUS)) Then .vy = -.vy .CY = Me.ScaleHeight - 1 - RADIUS End If For j = 0 To NUMBALLS - 1 ColDist = Sqr((TableBalls(j).CX - .CX) ^ 2 + (TableBalls(j).CY - .CY) ^ 2) If ColDist .CY Then ang = PI / 2 Else ang = -PI / 2 End If End If 'Make sure it is the correct angle 'atn() only gives us a value from -90 to +90[pi/2] If TableBalls(j).CX < .CX Then ang = ang + PI End If 'If a ball is on or inside the other, push it to just outside dx = -2.1 * RADIUS * Cos(ang) dy = -2.1 * RADIUS * Sin(ang) .CX = dx + TableBalls(j).CX .CY = dy + TableBalls(j).CY 'There is probably a better way to do this but 'this will get the corrected angle(from point of contact) If Not ((TableBalls(j).CX - .CX) = 0) Then ang = Atn((TableBalls(j).CY - .CY) / (TableBalls(j).CX - .CX)) Else If TableBalls(j).CY > .CY Then ang = PI / 2 Else ang = -PI / 2 End If End If If TableBalls(j).CX < .CX Then ang = ang + PI End If '================================================= == '======================================== 'Figure reflection angle 'normalize angle to 0 to 2PI If ang > (2 * PI) Then ang = (2 * PI) - ang ElseIf ang < 0 Then ang = ang + (2 * PI) End If R = Sqr(.vx * .vx + .vy * .vy) dx = R * Cos(ang) dy = R * Sin(ang) '======================================== 'Put the velocity of the 'attacking' ball into the target TableBalls(j).vx = dx TableBalls(j).vy = dy 'Decrease velocity from the attacker .vx = 0.2 * .vx .vy = 0.2 * .vy End If Next 'top renkleri Select Case i Case 0: Me.FillColor = vbWhite Me.Circle (.CX, .CY), RADIUS, vbWhite Case 1: Me.FillColor = vbYellow Me.Circle (.CX, .CY), RADIUS, vbYellow Case 2: Me.FillColor = vbRed Me.Circle (.CX, .CY), RADIUS, vbRed End Select End With Next If sari = 1 And kirmizi = 1 Then puan = Val(puan) + 1 Me.Caption = "SAYI !! Toplam Puan : " & puan efekt = 1 sari = 0 kirmizi = 0 End If If Val(TableBalls(0).vx) = 0 Then t1 = 1 If Val(TableBalls(1).vx) = 0 Then t2 = 1 If Val(TableBalls(2).vx) = 0 Then t3 = 1 If t1 = 1 And t2 = 1 And t3 = 1 Then Line1.Visible = True HScroll1.Visible = True End If Me.Refresh End Sub

__________________