Last active
January 23, 2023 08:32
-
-
Save klaszlo8207/a5c3f15c43648346558737ce1064c67b to your computer and use it in GitHub Desktop.
Engine.bas 2003 körüli Visual Basic 6.0 szakdolgozat kódom egy része
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Attribute VB_Name = "mEngine" | |
| '---------------------------------------------------_ | |
| ' Billiard 3GL : the ENGINE, created it in Opengl 1.2 | |
| '---------------------------------- ----------- --_ | |
| ' I / \/ \ I | |
| '\____/--------------\______/--- I/\__/\_/\I | |
| ' created by: /(o)(o)\ - | |
| '\____/--------------\______/---\___/--\__O_O_/ _/- | |
| ' KOZaRI / /LLI\ \_/_-- | |
| ' LaSZLO(Laca) in 2003.02.-08 / / \--/ - | |
| '------___________-------_______----_-\__--\__/______ | |
| 'BBBBB II LL LL II AAA RRRRRR DDDDDD | |
| 'BB BB II LL LL II AAAA RR RR DD DD | |
| 'BBBBB II LL LL II AA AA RRRRRR DD DD | |
| 'BB BB II LL LL II AAAAAA RR RR DD DD | |
| 'BB BB II LL LL II AA AA RR RR DD DD | |
| 'BBBBB II LLLLLL LLLLLL II AA AA RR RR DDDDDD | |
| '--------------------------------------------- | |
| '-KOMMENT- | |
| 'A "Motorba" raktam a lényegesebb dolgokat, a többi | |
| 'globális változót a VARIABLES Nameű Modulban helyeztem | |
| 'el, így egy kicsit (szerintem) áttekinthetőbb. | |
| 'Itt tulajdonképpen a játék fizikájával kapcsolatos | |
| 'konstansok, illetve típusok, változók vannak... | |
| 'A VARIABLES modulban az API hívások, valamint a | |
| 'képernyőkezelés, OPENGL-es változók, textúrakezelés | |
| 'változói vannak, és néhány egyéb cuccos is... | |
| '--------------------------------------------- | |
| '--------------------------------------------- | |
| 'Public Konstansok | |
| '--------------------------------------------- | |
| Public Const N As Byte = 15 'labdák száma N+1 | |
| Public Const MU As Single = 0.002 '/mű/x | |
| Public Const BALL_WEIGHT As Single = 0.0015 '1 golyo BALL_WEIGHTe sacc/kb | |
| Public Const GRAVITATION As Single = 9.81 '9.81 helyett a gravitáció | |
| '--------------------------------------------- | |
| 'A golyó Típus | |
| '--------------------------------------------- | |
| Type objectBall | |
| x As Double 'X,Y | |
| y As Double | |
| z As Double 'Z alap érték... | |
| VelX As Double 'SebességX,Y,mivel sik | |
| VelY As Double | |
| VelZ As Double | |
| Velocity As Double | |
| Rotation As Double | |
| OldRot As Double | |
| OldRotXYZ As Vect3 | |
| Rad As Double 'Radiusz | |
| name As String 'pl.fekete8 | |
| Type As String 'pl.teli | |
| OnTable As Boolean 'Legurult-e vagy se? | |
| RolledDownInRound As Integer 'Melyik körben ment le, ha lement _ | |
| Ha 0 akkor még fenn van... | |
| End Type | |
| '--------------------------------------------- | |
| 'Globális Változók | |
| '--------------------------------------------- | |
| Public Balls(N) As objectBall 'N+1 db golyó 15+1 | |
| Public Round As Integer 'hányadik kör | |
| Public NotOnTable As Byte 'legurultak... | |
| Public Sub FirstRun() | |
| '--------------------------------------------- | |
| 'First Run modul | |
| '--------------------------------------------- | |
| NotOnTable = 0 | |
| RunGame = True | |
| CueAnim = True | |
| '--------------------------------------------- | |
| 'RADIUS adása, golyók értékeinek, Nameeinek adása stb.. | |
| '--------------------------------------------- | |
| For i = 0 To N | |
| '--------------------------------------------- | |
| With Balls(i) | |
| .OnTable = True 'nem ment le | |
| .VelX = 0 'x,y kezdősebesség | |
| .VelY = 0 ' -""- | |
| .z = -2.2 'alap Z | |
| .Rad = 0.036 'Balls nagysága | |
| .RolledDownInRound = 0 'Mindegyik fenn van | |
| End With | |
| '--------------------------------------------- | |
| 'Golyók felállítása... | |
| 'Kezdő X értékek | |
| START_X0 = (i / 15.1) - 0.63 + CAMERA_X | |
| START_X1 = (i / 15.1) + CAMERA_X + 0.1 | |
| START_X2 = ((i - 4) / 15.1) + CAMERA_X + 0.1 | |
| START_X3 = ((i - 7) / 15.1) + CAMERA_X + 0.1 | |
| START_X4 = ((i - 9) / 15.1) + CAMERA_X + 0.1 | |
| START_X5 = ((i - 10) / 15.1) + CAMERA_X + 0.1 | |
| '--------------------------------------------- | |
| 'Kezdő Y értékek | |
| vy = -0.07 '91 | |
| START_Y0 = (1 / 15.1) + vy + CAMERA_Y | |
| START_Y1 = (i / 15.1) + vy + CAMERA_Y | |
| START_Y2 = ((i - 4) / 15.1) - (2 / 15.1) + vy + CAMERA_Y | |
| START_Y3 = ((i - 4) / 15.1) - (7 / 15.1) + vy + CAMERA_Y | |
| START_Y4 = ((i - 4) / 15.1) - (11 / 15.1) + vy + CAMERA_Y | |
| START_Y5 = ((i - 4) / 15.1) - (14 / 15.1) + vy + CAMERA_Y | |
| Select Case i | |
| '--------------------------------------------- | |
| 'A fehér golyó... | |
| Case 0: | |
| Balls(i).x = START_X0 | |
| Balls(i).y = START_Y0 | |
| Balls(i).VelX = 0 | |
| Balls(i).VelY = 0 | |
| Balls(i).name = "feher0" | |
| Balls(i).Type = "feher" | |
| 'A többi golyó... | |
| '--------------------------------------------- | |
| '1.sor | |
| Case 1: | |
| Balls(i).x = START_X1 | |
| Balls(i).y = START_Y1 | |
| Balls(i).name = "sarga1" | |
| Balls(i).Type = "teli" | |
| Case 2: | |
| Balls(i).x = START_X1 | |
| Balls(i).y = START_Y1 - 0.03 | |
| Balls(i).name = "lila4" | |
| Balls(i).Type = "teli" | |
| Case 3: ' | |
| Balls(i).x = START_X1 | |
| Balls(i).y = START_Y1 - (0.03 * 2) | |
| Balls(i).name = "piros11" | |
| Balls(i).Type = "csikos" | |
| Case 4: | |
| Balls(i).x = START_X1 | |
| Balls(i).y = START_Y1 - (0.03 * 3) | |
| Balls(i).name = "barna15" | |
| Balls(i).Type = "csikos" | |
| Case 5: | |
| Balls(i).x = START_X1 | |
| Balls(i).y = START_Y1 - (0.03 * 4) | |
| Balls(i).name = "barna7" | |
| Balls(i).Type = "teli" | |
| '--------------------------------------------- | |
| '2.sor | |
| Case 6: | |
| Balls(i).x = START_X2 | |
| Balls(i).y = START_Y2 + 0.03 | |
| Balls(i).name = "kek10" | |
| Balls(i).Type = "csikos" | |
| Case 7: | |
| Balls(i).x = START_X2 | |
| Balls(i).y = START_Y2 | |
| Balls(i).name = "fekete8" | |
| Balls(i).Type = "fekete" | |
| Case 8: | |
| Balls(i).x = START_X2 | |
| Balls(i).y = START_Y2 - 0.03 | |
| Balls(i).name = "zold14" | |
| Balls(i).Type = "csikos" | |
| Case 9: | |
| Balls(i).x = START_X2 | |
| Balls(i).y = START_Y2 - (0.03 * 2) | |
| Balls(i).name = "narancs13" | |
| Balls(i).Type = "csikos" | |
| '--------------------------------------------- | |
| '3.sor | |
| Case 10: | |
| Balls(i).x = START_X3 | |
| Balls(i).y = START_Y3 + (0.03 * 2) | |
| Balls(i).name = "kek2" | |
| Balls(i).Type = "teli" | |
| Case 11: | |
| Balls(i).x = START_X3 | |
| Balls(i).y = START_Y3 + 0.03 | |
| Balls(i).name = "piros3" | |
| Balls(i).Type = "teli" | |
| Case 12: | |
| Balls(i).x = START_X3 | |
| Balls(i).y = START_Y3 | |
| Balls(i).name = "zold6" | |
| Balls(i).Type = "teli" | |
| '--------------------------------------------- | |
| '4.sor | |
| Case 13: | |
| Balls(i).x = START_X4 | |
| Balls(i).y = START_Y4 + (0.03 * 3) | |
| Balls(i).name = "sarga9" | |
| Balls(i).Type = "csikos" | |
| Case 14: | |
| Balls(i).x = START_X4 | |
| Balls(i).y = START_Y4 + (0.03 * 2) | |
| Balls(i).name = "lila12" | |
| Balls(i).Type = "csikos" | |
| '--------------------------------------------- | |
| '5.sor-utolso | |
| Case 15: | |
| Balls(i).x = START_X5 | |
| Balls(i).y = START_Y5 + (0.03 * 4) | |
| Balls(i).name = "narancs5" | |
| Balls(i).Type = "teli" | |
| End Select | |
| Next i | |
| '--------------------------------------------- | |
| End Sub | |
| Public Sub Modelling() | |
| '--------------------------------------------- | |
| 'A tényleges ModellingÉS itt kezdődik, _ | |
| ez az a Procedura/Sub, amelyben benne _ | |
| vannak a surlodások, visszapattanások, stb... _ | |
| VAGYIS A TÉNYLEGES biLLiaRd FIZIKAi MODELL | |
| '--------------------------------------------- | |
| Dim i As Byte | |
| Dim cfreq As Currency | |
| Dim cuStart As Currency | |
| Dim cuStop As Currency | |
| Dim stop1 As Currency | |
| Dim start1 As Currency | |
| Dim sFPS As Single | |
| '--------------------------------------------- | |
| deltaT = 1 | |
| QueryPerformanceFrequency cfreq | |
| Do While RunGame | |
| 'FPS számolása | |
| QueryPerformanceCounter cuStart | |
| 'Rezet Velocity változó | |
| Velocity = 0 | |
| 'Kurzorok----------------- | |
| Call Main.ChangeCursor | |
| Call drawOtherCue | |
| 'FPS kirakása x időközönként | |
| If GetTickCount - Elapsed9 >= 400 Then | |
| Fps_Now = sFPS | |
| Elapsed9 = GetTickCount | |
| End If | |
| 'Tick count | |
| 'Vagyis midnen gépen egy sebességgel fut már.. | |
| If GetTickCount - Elapsed8 >= deltaT Then | |
| start1 = GetTickCount() | |
| '============== | |
| If mdown Then Call mGame.CueShot | |
| Call AutomaticStrength | |
| For i = 0 To N 'N+1 golyoval // fehér+15 | |
| If Balls(i).OnTable Then | |
| Call SearchMaxVelocity | |
| 'X,Y súrlódás | |
| Call Friction(i) | |
| 'Visszapattanások | |
| Call CollisionWithTable(i) | |
| 'Ütközések figyelése... | |
| Call CollisionWithBall(i) | |
| If Not Balls(0).VelX = 0 And _ | |
| Not Balls(0).VelY = 0 Then Mistake = False | |
| End If | |
| Next i | |
| '--------------------------------------------- | |
| If AllVelocity0 Then MouseDowned = False | |
| stop1 = GetTickCount() | |
| deltaT = stop1 - start1 | |
| 'Kirajzolja a golyók fizikáját.Renderel. | |
| Call RenderIt.RenderAll 'A golyók "szédelegnek" még | |
| Elapsed8 = GetTickCount() | |
| End If | |
| 'FPS számolása | |
| QueryPerformanceCounter cuStop | |
| sFPS = 1 / ((cuStop - cuStart) / cfreq) | |
| DoEvents | |
| '========== | |
| Loop | |
| '--------------------------------------------- | |
| End Sub | |
| Public Sub Friction(i As Byte) | |
| '--------------------------------------------- | |
| 'Golyók súrlódásának a számítása az alapképlet _ | |
| alapján: _ | |
| sF=Fs súrlódási erő _ | |
| sF = MU * BALL_WEIGHT * GRAVITATION | |
| '--------------------------------------------- | |
| Dim FrictionX As Double | |
| Dim FrictionY As Double | |
| Dim SPF As Double | |
| sF = (MU * BALL_WEIGHT * GRAVITATION) | |
| '--------------------------------------------- | |
| 'Ha a sebesség 0-hoz közeli érték... | |
| '--------------------------------------------- | |
| Velocity = Sqr(Balls(i).VelX ^ 2 + Balls(i).VelY ^ 2) | |
| If Velocity <= 0.01 / 100 Then | |
| Balls(i).VelX = 0 | |
| Balls(i).VelY = 0 | |
| Exit Sub | |
| End If | |
| '--------------------------------------------- | |
| 'sF=Fs súrlódási erő | |
| '--------------------------------------------- | |
| If Balls(i).VelX = 0 Then angle = 0 Else: angle = Atn(Balls(i).VelY / Balls(i).VelX) | |
| FrictionX = Abs(sF * Cos(angle)) | |
| FrictionY = Abs(sF * Sin(angle)) | |
| If Balls(i).VelX > 0 Then FrictionX = -FrictionX | |
| If Balls(i).VelY > 0 Then FrictionY = -FrictionY | |
| Balls(i).VelX = Balls(i).VelX + FrictionX | |
| Balls(i).VelY = Balls(i).VelY + FrictionY | |
| Balls(i).Velocity = Sqr(Balls(i).VelX ^ 2 + Balls(i).VelY ^ 2) | |
| '--------------------------------------------- | |
| End Sub | |
| Public Function CollisionWithTable(i As Byte) As Boolean | |
| '--------------------------------------------- | |
| 'X-Y visszapatableTopanások a falakról... | |
| '"Szédelgés"... | |
| '--------------------------------------------- | |
| 'OPENGL asztalméret 800*600-ban. | |
| '--------------------------------------------- | |
| CollisionWithTable = False | |
| tableLeft = TABLE_LEFT + CAMERA_X | |
| tableRight = TABLE_RIGHT + CAMERA_X | |
| tableTop = TABLE_TOP + CAMERA_Y | |
| tableBottom = TABLE_BOTTOM + CAMERA_Y | |
| backRollDistance = (Balls(i).Rad / 200) | |
| '--------------------------------------------- | |
| If RolledDownBall(tableLeft, tableRight, tableTop, tableBottom, backRollDistance, i) = True Then | |
| If SoundIn Then PlayTheSound 3 | |
| Exit Function | |
| End If | |
| '--------------------------------------------- | |
| 'X visszapatableTopanások | |
| If (Balls(i).x - backRollDistance <= tableLeft) Then | |
| Balls(i).VelX = -Balls(i).VelX | |
| Balls(i).x = tableLeft + backRollDistance | |
| CollisionWithTable = True | |
| End If | |
| If (Balls(i).x + backRollDistance >= tableRight) Then | |
| Balls(i).VelX = -Balls(i).VelX | |
| Balls(i).x = tableRight - backRollDistance | |
| CollisionWithTable = True | |
| End If | |
| Balls(i).x = Balls(i).x + Balls(i).VelX 'jo | |
| '--------------------------------------------- | |
| 'Y visszapatableTopanások | |
| If (Balls(i).y - backRollDistance <= tableTop) Then | |
| Balls(i).VelY = -Balls(i).VelY | |
| Balls(i).y = tableTop + backRollDistance | |
| CollisionWithTable = True | |
| End If | |
| If (Balls(i).y + backRollDistance >= tableBottom) Then | |
| Balls(i).VelY = -Balls(i).VelY | |
| Balls(i).y = tableBottom - backRollDistance | |
| CollisionWithTable = True | |
| End If | |
| Balls(i).y = Balls(i).y + Balls(i).VelY | |
| Velocity = Sqr(Balls(i).VelX ^ 2 + Balls(i).VelY ^ 2) | |
| If CollisionWithTable And (Velocity > 0) Then | |
| If SoundIn Then PlayTheSound 2 | |
| End If | |
| '--------------------------------------------- | |
| End Function | |
| Public Sub CollisionWithBall(i As Byte) | |
| '--------------------------------------------- | |
| 'Ütközések a golyók között | |
| '--------------------------------------------- | |
| For j = 0 To N | |
| If Balls(i).OnTable And Balls(j).OnTable Then | |
| If i <> j Then ChangeVelocity Balls(j), Balls(i) | |
| End If | |
| Next j | |
| '--------------------------------------------- | |
| End Sub | |
| Public Sub ChangeVelocity(a As objectBall, b As objectBall) | |
| '--------------------------------------------- | |
| 'A TULAJDONKÉPPENI 'MOTOR' | |
| '--------------------------------------------- | |
| Dim X1 As Single, Y1 As Single | |
| Dim X2 As Single, Y2 As Single | |
| Dim dxx As Single, dyy As Single | |
| Dim lll As Single, ggg As Single | |
| Dim deltaX As Single, deltaY As Single | |
| X1 = a.x: X2 = b.x | |
| Y1 = a.y: Y2 = b.y | |
| '--------------------------------------------- | |
| 'a távolság a 2 g. között. | |
| Distance = Sqr((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2) | |
| '--------------------------------------------- | |
| 'Hogyha kisebb a táv köztük, akRound koccannak.. | |
| '--------------------------------------------- | |
| If Distance >= (a.Rad + b.Rad) - 0.005 Then | |
| If Round > 0 And FirstCollision = False Then FirstTouched = "nothing" | |
| Exit Sub | |
| ElseIf Distance < (a.Rad + b.Rad) - 0.005 Then 'Kisebb... | |
| '--------------------------------------------- | |
| 'Az első koccanás vizsgálata... | |
| 'A fehér és vmelyik golyo között. | |
| '--------------------------------------------- | |
| If FirstCollision Then GoTo at: | |
| FirstCollision = True | |
| FirstTouched = a.Type | |
| at: | |
| '--------------------------------------------- | |
| 'Max. X,Y seb. keresése | |
| Call SearchMaxVelocity | |
| '--------------------------------------------- | |
| 'golyók szét... | |
| dxx = (b.x - a.x) 'x y távolság | |
| dyy = (b.y - a.y) | |
| lll = Sqr(dxx ^ 2 + dyy ^ 2) 'tényleges táv | |
| ggg = (a.Rad + b.Rad) - lll | |
| deltaX = (ggg / lll) * dxx | |
| deltaY = (ggg / lll) * dyy | |
| b.x = b.x + deltaX | |
| b.y = b.y + deltaY | |
| 'Elszakadás megtörtént... | |
| '--------------------------------------------- | |
| 'A szög kiszámítása | |
| angle = Atn((Y2 - Y1) / (X2 - X1)) | |
| 'Az ütközés melletti sebességek meghatározása | |
| X1 = a.VelX * Cos(-angle) - a.VelY * Sin(-angle) | |
| Y1 = a.VelX * Sin(-angle) + a.VelY * Cos(-angle) | |
| X2 = b.VelX * Cos(-angle) - b.VelY * Sin(-angle) | |
| Y2 = b.VelX * Sin(-angle) + b.VelY * Cos(-angle) | |
| 'X Sebesség komponens csere | |
| 'Y sebesség ugyanaz marad | |
| 'Majd visszaállítjuk a normál koordinátákat | |
| newX1 = X2 * Cos(angle) - Y1 * Sin(angle) | |
| newY1 = X2 * Sin(angle) + Y1 * Cos(angle) | |
| newX2 = X1 * Cos(angle) - Y2 * Sin(angle) | |
| newY2 = X1 * Sin(angle) + Y2 * Cos(angle) | |
| 'Sebességek vissza... | |
| a.VelX = newX1 | |
| a.VelY = newY1 | |
| b.VelX = newX2 | |
| b.VelY = newY2 | |
| '--------------------------------------------- | |
| 'kocc.wav | |
| Velocity = Sqr(a.VelX ^ 2 + a.VelY ^ 2) | |
| If (Velocity > 0) And (CueAnim = False) Then | |
| If SoundIn Then PlayTheSound 1 'Sounds(3), 0, SND_ASYNC | |
| End If | |
| End If | |
| '--------------------------------------------- | |
| End Sub | |
| Public Function RolledDownBall(tableLeft, tableRight, tableTop, tableBottom, backRollDistance, i As Byte) As Boolean | |
| '--------------------------------------------- | |
| 'Lyukat ért-e a golyó? | |
| '--------------------------------------------- | |
| RolledDownBall = False 'Alapból nem... | |
| BackRollDist_01 = backRollDistance * 100 | |
| BackRollDist_02 = backRollDistance * 250 | |
| BackRollDist_03 = backRollDistance * 10 | |
| '--------------------------------------------- | |
| 'Szélső 4 lyuk ellenőrzése | |
| '--------------------------------------------- | |
| 'Tökéletesítve.. | |
| '--------------------------------------------- | |
| If Balls(i).OnTable = True Then 'hogyha még fenn van... | |
| '--------------------------------------------- | |
| 'felsojobb | |
| If (Balls(i).x + BackRollDist_01 > tableRight) And _ | |
| (Balls(i).y + BackRollDist_01 > tableBottom) Then | |
| Hole = 3 | |
| GoTo le_gurult: | |
| '--------------------------------------------- | |
| 'alsobal | |
| ElseIf (Balls(i).x - BackRollDist_01 <= tableLeft) And _ | |
| (Balls(i).y - BackRollDist_01 <= tableTop) Then | |
| Hole = 4 | |
| GoTo le_gurult: | |
| '--------------------------------------------- | |
| 'alsojobb | |
| ElseIf (Balls(i).x + BackRollDist_01 > tableRight) And _ | |
| (Balls(i).y - BackRollDist_01 <= tableTop) Then | |
| Hole = 6 | |
| GoTo le_gurult: | |
| '--------------------------------------------- | |
| 'felsobal | |
| ElseIf (Balls(i).x - BackRollDist_01 <= tableLeft) And _ | |
| (Balls(i).y + BackRollDist_01 > tableBottom) Then | |
| Hole = 1 | |
| GoTo le_gurult: | |
| '--------------------------------------------- | |
| 'És a középső 2 ellenőrzése | |
| ElseIf (Balls(i).x < -0.08 + BackRollDist_02) And _ | |
| (Balls(i).x > -0.12 - BackRollDist_02) And _ | |
| (Balls(i).y < tableTop + BackRollDist_03) Then | |
| Hole = 4 | |
| GoTo le_gurult: | |
| '--------------------------------------------- | |
| ElseIf (Balls(i).x <= -0.08 + BackRollDist_02) And _ | |
| (Balls(i).x >= -0.12 - BackRollDist_02) And _ | |
| (Balls(i).y > tableBottom - BackRollDist_03) Then | |
| Hole = 2 | |
| GoTo le_gurult: | |
| End If | |
| End If | |
| Exit Function | |
| '--------------------------------------------- | |
| '--------------------------------------------- | |
| le_gurult: 'Gazdaságosabb megoldás _ | |
| Egy jó programozó nem fél a goto-ktol:) | |
| 'az adotableTop golyó melyik körben ment le az asztalról | |
| Balls(i).RolledDownInRound = Round | |
| RolledDown = RolledDown + 1 | |
| RolledDownNOW = RolledDownNOW + 1 | |
| ReDim RolledDownInThisRound(RolledDown) | |
| RolledDownInThisRound(RolledDown) = i | |
| Balls(i).OnTable = False | |
| Balls(i).VelX = 0 | |
| Balls(i).VelY = 0 | |
| RolledDownBall = True | |
| '--------------------------------------------- | |
| If Balls(i).name = "feher0" Then | |
| 'Ha a fehér lemegy | |
| Balls(i).x = (tableRight + BackRollDist_01 + 0.3) | |
| Balls(i).y = tableBottom + 0.1 | |
| Main.WhiteToTable.Visible = True | |
| Exit Function | |
| End If | |
| NotOnTable = NotOnTable + 1 | |
| Balls(i).x = (tableRight + BackRollDist_01 + 0.1) - (NotOnTable * 0.075) + 0.32 | |
| Balls(i).y = (tableTop - BackRollDist_01 - 0.15) + 1.67 | |
| '--------------------------------------------- | |
| End Function | |
| Public Sub SearchMaxVelocity() | |
| '--------------------------------------------- | |
| 'Maximális X,Y sebesség keresés a golyók | |
| 'között... | |
| '--------------------------------------------- | |
| Dim k As Byte | |
| Dim MaxX As Byte | |
| Dim MaxY As Byte | |
| Dim Str As String | |
| MaxX = 0: MaxY = 0 | |
| '--------------------------------------------- | |
| 'Hányas számu golyonak a legnagyobb SX,SY.-ja? | |
| '--------------------------------------------- | |
| For k = 1 To N | |
| If Balls(k).OnTable And (Abs(Balls(k).VelX) > Abs(Balls(MaxX).VelX)) Then MaxX = k | |
| If Balls(k).OnTable And (Abs(Balls(k).VelY) > Abs(Balls(MaxY).VelY)) Then MaxY = k | |
| Next k | |
| If (Abs(Balls(MaxX).VelX) > Abs(Balls(MaxY).VelY)) Then: Velocity = Sqr(Balls(MaxX).VelX ^ 2 + Balls(MaxX).VelY ^ 2) | |
| If (Abs(Balls(MaxX).VelX) < Abs(Balls(MaxY).VelY)) Then: Velocity = Sqr(Balls(MaxY).VelX ^ 2 + Balls(MaxY).VelY ^ 2) | |
| '--------------------------------------------- | |
| 'Hogyha a sebessége 0, akkor dákóanim... | |
| '--------------------------------------------- | |
| If (Velocity = 0) And (Balls(MaxX).OnTable Or Balls(MaxY).OnTable) Then | |
| If Balls(0).OnTable Then | |
| CueAnim = True | |
| 'K ö v e t k e z ő j á t é k o s . . . | |
| If Mistake = False Then Call NextPlayer1 | |
| ' ShowCursor 1 | |
| End If | |
| End If | |
| Call AnalizeBall2 | |
| Call SelectType1(Seb) | |
| '--------------------------------------------- | |
| End Sub | |
| Public Function SelectType2(NextPlayR As Players, LastPlayR As Players) As Boolean | |
| '--------------------------------------------- | |
| 'Csak az első X körben, típusválasztás... | |
| 'Ameddig nincs eldöntve, hogy teli vagy csikos-e | |
| '--------------------------------------------- | |
| SelectType2 = False | |
| Dim TipusA As Byte, TipusB As Byte | |
| For i = 0 To N | |
| If (Not Balls(i).OnTable) And _ | |
| (Balls(i).Type = "csikos") Then | |
| TipusA = TipusA + 1 | |
| ElseIf (Not Balls(i).OnTable) And _ | |
| (Balls(i).Type = "teli") Then | |
| TipusB = TipusB + 1 | |
| End If | |
| Next i | |
| If TipusA > TipusB Then NextPlayR.Type = "csikos": LastPlayR.Type = "teli" | |
| If TipusA < TipusB Then NextPlayR.Type = "teli": LastPlayR.Type = "csikos" | |
| If TipusA = TipusB Then Exit Function | |
| SelectType2 = True | |
| '--------------------------------------------- | |
| End Function | |
| Public Sub SelectType1(Seb) | |
| '--------------------------------------------- | |
| 'Tipusválasztás-teli vagy csikos... | |
| '--------------------------------------------- | |
| If Screens = 2 Then | |
| If ((Velocity = 0) And (Round = 1)) Or ((Velocity = 0)) Then | |
| If SelectedType Then Exit Sub | |
| If NextPlayer = 1 Then 'Player1 | |
| If SelectType2(Player1, Player2) = True Then | |
| SelectedType = True | |
| Else | |
| SelectedType = False | |
| End If | |
| ElseIf NextPlayer = 2 Then 'Player2 | |
| If SelectType2(Player2, Player1) = True Then | |
| SelectedType = True | |
| Else | |
| SelectedType = False | |
| End If | |
| End If | |
| If SentType = True Then Exit Sub | |
| If SelectedType Then Call SendNameTypePoints: SentType = True | |
| End If | |
| End If | |
| '--------------------------------------------- | |
| End Sub | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment