Skip to content

Instantly share code, notes, and snippets.

@klaszlo8207

klaszlo8207/Draws.bas

Created January 23, 2023 08:51
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save klaszlo8207/3f709be447935818c2beccb1aafc1ad7 to your computer and use it in GitHub Desktop.
Save klaszlo8207/3f709be447935818c2beccb1aafc1ad7 to your computer and use it in GitHub Desktop.
Download ZIP
Draws.bas 2003 körüli Visual Basic 6.0 szakdolgozat kódom egy része, Draws
Raw
Draws.bas
Attribute VB_Name = "mDraws"
'---------------------------------------------
'"A dákó színének a pulzálása"
Dim col1 As Single
Dim c_bool As Boolean
Dim b_Transp As Boolean
Dim dx, dx2, dxv
Dim Transp
Public deltaY As Integer
'---------------------------------------------
'---------------------------------------------
Public Sub drawTable()
'---------------------------------------------
' Hatter be..=ASZTAL
'---------------------------------------------
SelectTexture2D Texture(24 + TableStyle)
GlAlphaBlend True, False
If TableFade Then GlAlphaBlend True, True: GlLights_In 0
Call drawQuad1(-0.1, 0.12, 2.96, 2.25, 1)
If TableFade Then GlAlphaBlend False, False
GlAlphaBlend False, False
If ShadowsIn Then Call drawTableShadows
End Sub
Public Sub drawLogo()
'---------------------------------------------
'Logo mutatása
'---------------------------------------------
'---------------------------------------------
'ElTranspes...
If Not b_Transp Then Transp = Transp + 0.5
If b_Transp Then Transp = Transp - 0.5
If Transp >= 100 Then b_Transp = True
If Transp <= 20 Then b_Transp = False
'---------------------------------------------
GlAlphaBlend True, True
kx = 1.22: kY = -0.9
GlRGB 150, 150, 150
Call IdentityMatrix(kx + dx2, kY, -2.9)
RotateMatrix 1, dx / 3, 1, 1, 1
SelectTexture2D Texture(23)
gluDisk Quadratic, 0, 0.12, 10, 10
'---------------------------------------------
'b3ico
GlRGB Int(Transp), Int(Transp), Int(Transp)
IdentityMatrix -1.5, 1, -4
SelectTexture2D Texture(19)
Call drawQuad1(2.9, 0.1, 0.2, 0.2, 1)
'---------------------------------------------
'pörgés anim +
dx2 = 0.2: dx = dx + (Transp / 10)
GlAlphaBlend False, False
'---------------------------------------------
End Sub
Public Sub drawBackGround()
'---------------------------------------------
' Háttér
'---------------------------------------------
SelectTexture2D Texture(24)
glColor3f 0.35, 0.35, 0.35
Call drawQuad1(-0.2, 0.2, 3.5, 2.5, 1)
glColor3f 1, 1, 1
End Sub
Public Sub drawStart()
'---------------------------------------------
' showDataPage háttér
'---------------------------------------------
SelectTexture2D Texture(21)
Call drawQuad1(-0.85, 0.566, 0.35, 0.38, 1)
End Sub
Public Sub drawBalls()
'---------------------------------------------
'Golyók tényleges kirajzolása
'---------------------------------------------
'---------------------------------------------
For i = 0 To N
If ShadowsIn Then Call drawBallShadows(i)
If VelocityVectors Then Call drawVelocityVectors(i)
GlRGB 255, 255, 255
IdentityMatrix Balls(i).x, Balls(i).y, Balls(i).z
'Csak akkor forog a golyó, ha nem állt meg értelemszerűen...
If Not (Balls(i).VelX = 0) And Not (Balls(i).VelY = 0) Then
Dim normRot As Vect3
normRot = calculateNormalRotation(i)
glRotatef Balls(i).Rotation, normRot.x, normRot.y, normRot.z
Balls(i).OldRot = Balls(i).Rotation
Balls(i).OldRotXYZ.x = normRot.x
Balls(i).OldRotXYZ.y = normRot.y
Balls(i).OldRotXYZ.z = normRot.z
Else
'ha megállt-forgatás korrigálás...ne menjen vissza kezdőértékbe
glRotatef Balls(i).OldRot, Balls(i).OldRotXYZ.x, Balls(i).OldRotXYZ.y, Balls(i).OldRotXYZ.z
End If
'----------------
SelectTexture2D Texture(i)
gluSphere Quadratic, Balls(i).Rad, 15, 15
If Not CreditsIn And SphereMapIn Then Call drawEnvRoll(i)
Next i
'---------------------------------------------
End Sub
Public Sub drawCue(toX, toY, SfX, SfY, angle, angle2)
'---------------------------------------------
'Maga a dákónak a kirajzolása
'---------------------------------------------
GlRGB 255, 255, 255
'++++++++++++++++++++++++++++++++++++++++++++++
'---------------------------------------------
'(0) 'fejrész
SelectTexture2D Texture(0)
IdentityMatrix toX + SfX, toY + SfY, -2.165
RotateMatrix 2, 90, 1, 0, 0
RotateMatrix 2, 270, 0, 1, 0
RotateMatrix 2, angle2, 0, 1, 0
gluCylinder Quadratic, 0.004, 0.004, 0.0125, 15, 15
'---------------------------------------------
'Más a 2 játékos dákójának a színe is
'(01)(02)
If NextPlayer = 1 Then GlRGB 150, 150, 150
If NextPlayer = 2 Then GlRGB 150, 0, 0
'(1)'kozép
SelectTexture2D Texture(20)
IdentityMatrix toX + SfX, toY + SfY, -2.165
RotateMatrix 2, 90, 1, 0, 0
RotateMatrix 2, 270, 0, 1, 0
RotateMatrix 2, angle2, 0, 1, 0
gluCylinder Quadratic, 0.003, 0.012, 0.7, 15, 15
'---------------------------------------------
'(2)hátrész
SelectTexture2D Texture(20)
If NextPlayer = 1 Then GlRGB 80, 80, 80
If NextPlayer = 2 Then GlRGB 80, 80, 80
gluCylinder Quadratic, 0.0015, 0.015, 1.1, 15, 15
'++++++++++++++++++++++++++++++++++++++++++++++
'---------------------------------------------
'A potty a golyón...
SelectTexture2D Texture(20)
GlRGB 0, 0, 0
IdentityMatrix toX + (SfX / 2), toY + (SfY / 2), -2.175
RotateMatrix 2, angle2, 0, 1, 0
gluSphere Quadratic, Balls(i).Rad / 8, 15, 15
'---------------------------------------------
'A vonal kirajzolása-hova ütöm?
SelectTexture2D Texture(0)
IdentityMatrix toX, toY, Balls(i).z
RotateMatrix 2, 90, 1, 0, 0
RotateMatrix 2, 90, 0, 1, 0
RotateMatrix 2, angle2, 0, 1, 0
RotateMatrix 2, 90, 0, 0, 1
'---------------------------------------------
'ColorFade Animáció->pulzál a "line"
If col1 >= 1 Then c_bool = True
If col1 <= 0 Then c_bool = False
If c_bool Then col1 = col1 - 0.01
If Not c_bool Then col1 = col1 + 0.01
'alap---------------------------------------------
glColor3f 0, 0.3, 1
'segítség benn/kinn
'If HelpLine Then
BlendFunction 1
GlAlphaBlend False, True
gluCylinder Quadratic, Balls(0).Rad, Balls(0).Rad, 0.035 * (60 / 1.5), 2, 2
GlAlphaBlend False, False
BlendFunction 0
'End If
'vált---------------------------------------------
glColor3f 0, 0.6, 2
'segítség benn/kinn
'If HelpLine Then
BlendFunction 1
GlAlphaBlend False, True
gluCylinder Quadratic, Balls(0).Rad - 0.005, Balls(0).Rad - 0.005, 0.035 * (Strength / 1.5), 8, 8
GlAlphaBlend False, False
BlendFunction 0
'End If
End Sub
Public Sub drawCueShadow(toX, toY, SfX, SfY, angle, angle2)
'---------------------------------------------
'Maga a dákó árnyék kirajzolása
'---------------------------------------------
BlendFunction 2
GlAlphaBlend False, True
Call calculateShadowColor
'---------------------------------------------
'(0) 'fejrész
SelectTexture2D Texture(2)
IdentityMatrix toX + SfX, toY + SfY, -2.165 - 0.12
RotateMatrix 2, 90, 1, 0, 0
RotateMatrix 2, 270, 0, 1, 0
RotateMatrix 2, angle2, 0, 1, 0
RotateMatrix 2, 90, 0, 0, 1 'slices miatt kell
gluCylinder Quadratic, 0.004, 0.004, 0.0125, 15, 15
'(1)'kozép
SelectTexture2D Texture(0)
IdentityMatrix toX + SfX, toY + SfY, -2.165 - 0.12
RotateMatrix 2, 90, 1, 0, 0
RotateMatrix 2, 270, 0, 1, 0
RotateMatrix 2, angle2, 0, 1, 0
RotateMatrix 2, 90, 0, 0, 1 '
gluCylinder Quadratic, 0.003, 0.012, 0.7, 15, 15
'---------------------------------------------
'(2)hátrész
SelectTexture2D Texture(0)
gluCylinder Quadratic, 0.0015, 0.015, 1.1, 15, 15
GlAlphaBlend False, False
BlendFunction 0
End Sub
Public Sub drawVelocityVectors(i)
Dim Seb0 As Double
Seb0 = 20 * (Sqr(Balls(i).VelX ^ 2 + Balls(i).VelY ^ 2))
If Screens = 2 Then
''Forgásirányok mutatása
toX = Balls(i).x
toY = Balls(i).y
On Error Resume Next
angle = Atn(Balls(i).VelX / Balls(i).VelY)
angle2 = -angle / (3.14 / 180)
GlRGB 5, 255, 255
SelectTexture2D Texture(0)
IdentityMatrix toX, toY, -2.2
RotateMatrix 2, 90, 1, 0, 0
RotateMatrix 2, 90, 0, 1, 0
RotateMatrix 2, angle2, 0, 1, 0
RotateMatrix 2, 90, 0, 0, 1
'Csak azokét mutatja, amik nem álltak meg..
If Balls(i).VelX = 0 And Balls(i).VelY = 0 Then GoTo ki:
gluCylinder Quadratic, Seb0, Seb0, 0.003, 2, 2
ki:
GlRGB 255, 255, 255
End If
End Sub
Public Sub drawBox()
SelectTexture2D Texture(17)
GlAlphaBlend True, False
glColor3f 0.5, 0.5, 0.5
Call drawQuad2(-0.3, -2.1, 3.5, 0.2, 1)
glColor3f 1, 1, 1
GlAlphaBlend False, False
End Sub
Public Sub drawBallShadows(i)
BlendFunction 2
GlAlphaBlend False, True
'Shadows
If Balls(i).OnTable Then
SelectTexture2D Texture(0)
Call calculateShadowColor
IdentityMatrix Balls(i).x, Balls(i).y, Balls(i).z - 0.03
gluDisk Quadratic, 0, Balls(i).Rad + 0.005, 15, 15
End If
GlAlphaBlend False, False
BlendFunction 0
End Sub
Public Sub drawTableShadows()
BlendFunction 2
GlAlphaBlend False, True
SelectTexture2D Texture(0)
GlRGB 250, 250, 250
'baloldal
Call drawQuad1(0.095, -0.185, 0.025, 1.65, 1)
'jobboldal
Call drawQuad1(2.64, -0.185, 0.025, 1.65, 1)
'fennbal
Call drawQuad1(0.22, -0.1, 1.025, -0.025, 1)
'fennjobb
Call drawQuad1(1.52, -0.1, 1.025, -0.025, 1)
'lennbal
Call drawQuad1(0.22, -1.94, 1.025, -0.025, 1)
'lennjobb
Call drawQuad1(1.52, -1.94, 1.025, -0.025, 1)
GlAlphaBlend False, False
BlendFunction 0
End Sub
Public Sub drawSelectedHole()
'---------------------------------------------
'Egyértelműbb angol konstansok
'---------------------------------------------
'CAMERA_X
'CAMERA_Y
Const HOLE_LEFT As Single = -1.36 + CAMERA_X
Const HOLE_RIGHT As Single = 1.13 + CAMERA_X
Const HOLE_TOP As Single = 0.91 + CAMERA_Y
Const HOLE_TOP2 As Single = 0.96 + CAMERA_Y
Const HOLE_BOTTOM As Single = -0.92 + CAMERA_Y
Const HOLE_BOTTOM2 As Single = -0.96 + CAMERA_Y
Const HOLE_RADIUS1 As Single = 0
Const HOLE_RADIUS2 As Single = 0.1
Const HOLE_Z = -2.9
SelectTexture2D Texture(33)
GlRGB 255, 255, 255
'---------------------------------------------
Select Case SelectedRHole
'---------------------------------------------
Case 1:
IdentityMatrix HOLE_LEFT, HOLE_TOP, HOLE_Z
RotateMatrix 2, -20, 0, 1, 1
gluDisk Quadratic, HOLE_RADIUS1, HOLE_RADIUS2, 20, 20
Case 2:
IdentityMatrix (HOLE_LEFT + HOLE_RIGHT) / 2, HOLE_TOP2, HOLE_Z
RotateMatrix 2, 45, 1, 0, 0
gluDisk Quadratic, HOLE_RADIUS1, HOLE_RADIUS2, 20, 20
Case 3:
IdentityMatrix HOLE_RIGHT, HOLE_TOP, HOLE_Z
RotateMatrix 2, 20, 0, 1, 1
gluDisk Quadratic, HOLE_RADIUS1, HOLE_RADIUS2, 20, 20
Case 4:
IdentityMatrix HOLE_LEFT, HOLE_BOTTOM, HOLE_Z
RotateMatrix 2, -20, 0, 1, 1
gluDisk Quadratic, HOLE_RADIUS1, HOLE_RADIUS2, 20, 20
Case 5:
IdentityMatrix (HOLE_LEFT + HOLE_RIGHT) / 2, HOLE_BOTTOM2, HOLE_Z
RotateMatrix 2, -45, 1, 0, 0
gluDisk Quadratic, HOLE_RADIUS1, HOLE_RADIUS2, 20, 20
Case 6:
IdentityMatrix HOLE_RIGHT, HOLE_BOTTOM, HOLE_Z
RotateMatrix 2, 20, 0, 1, 1
gluDisk Quadratic, HOLE_RADIUS1, HOLE_RADIUS2, 20, 20
End Select
End Sub
Public Sub drawEnvRoll(i)
'vagyis a fény a golyókon...
'Environment Roller
GlAlphaBlend True, True
IdentityMatrix Balls(i).x, Balls(i).y, Balls(i).z
SelectTexture2D Texture(34)
gluSphere Quadratic, Balls(i).Rad, 15, 15
GlAlphaBlend False, False
End Sub
Public Sub drawMenus()
'---------------------------------------------
' Hatter be..=ASZTAL
'---------------------------------------------
'Menüháttér
GlAlphaBlend True, True
SelectTexture2D Texture(17)
Call drawQuad1(0.9, -0.4, 1#, 1.2, 1)
GlAlphaBlend False, False
GlAlphaBlend True, True
glColor4f 3, 3, 3, 1
glPrint2 230, 335, Main.OptLbl.Caption, 1.2, 1.2
GlAlphaBlend False, False
'menü01
GlAlphaBlend True, True
glColor4f 0, 3, 3, 1
glPrint2 320, 400, Main.Menu(4).Caption, 0.9, 0.9
GlAlphaBlend False, False
glPushName 1
GlAlphaBlend False, True
If selected = 1 Then glColor4f 0.9, 0.9, 0.9, 1 Else glColor4f 0.5, 0.5, 0.5, 1
SelectTexture2D Texture(36)
If selected = 1 Then Call drawQuad2(1, -0.6, 0.82, 0.12, 1) Else Call drawQuad1(1, -0.6, 0.82, 0.12, 1)
If selected = 1 Then GlAlphaBlend False, False
glPopName
'menü02
GlAlphaBlend True, True
glColor4f 0, 3, 3, 1
glPrint2 320, 365, Main.Menu(6).Caption, 0.9, 0.9
GlAlphaBlend False, False
glPushName 2
GlAlphaBlend False, True
If selected = 2 Then glColor4f 0.9, 0.9, 0.9, 1 Else glColor4f 0.5, 0.5, 0.5, 1
SelectTexture2D Texture(36)
If selected = 2 Then Call drawQuad2(1, -0.74, 0.82, 0.12, 1) Else Call drawQuad1(1, -0.74, 0.82, 0.12, 1)
If selected = 2 Then GlAlphaBlend False, False
glPopName
'menü03
GlAlphaBlend True, True
glColor4f 0, 3, 3, 1
glPrint2 320, 330, Main.Menu(8).Caption, 0.9, 0.9
GlAlphaBlend False, False
glPushName 3
GlAlphaBlend False, True
If selected = 3 Then glColor4f 0.9, 0.9, 0.9, 1 Else glColor4f 0.5, 0.5, 0.5, 1
SelectTexture2D Texture(36)
'+13
If selected = 3 Then Call drawQuad2(1, -0.87, 0.82, 0.12, 1)
If Not selected = 3 Then Call drawQuad1(1, -0.87, 0.82, 0.12, 1)
If selected = 3 Then GlAlphaBlend False, False
glPopName
'menü04
GlAlphaBlend True, True
glColor4f 0, 3, 3, 1
glPrint2 320, 292, Main.Menu(7).Caption, 0.9, 0.9
GlAlphaBlend False, False
glPushName 4
GlAlphaBlend False, True
If selected = 4 Then glColor4f 0.9, 0.9, 0.9, 1 Else glColor4f 0.5, 0.5, 0.5, 1
SelectTexture2D Texture(36)
'+13
If selected = 4 Then Call drawQuad2(1, -1.01, 0.82, 0.12, 1)
If Not selected = 4 Then Call drawQuad1(1, -1.01, 0.82, 0.12, 1)
If selected = 4 Then GlAlphaBlend False, False
glPopName
'menü05
GlAlphaBlend True, True
glColor4f 0, 3, 3, 1
glPrint2 320, 256, Main.Menu(9).Caption, 0.9, 0.9
GlAlphaBlend False, False
glPushName 5
GlAlphaBlend False, True
If selected = 5 Then glColor4f 0.9, 0.9, 0.9, 1 Else glColor4f 0.5, 0.5, 0.5, 1
SelectTexture2D Texture(36)
'+13
If selected = 5 Then Call drawQuad2(1, -1.15, 0.82, 0.12, 1)
If Not selected = 5 Then Call drawQuad1(1, -1.15, 0.82, 0.12, 1)
If selected = 5 Then GlAlphaBlend False, False
glPopName
'menü06
GlAlphaBlend True, True
glColor4f 0, 3, 3, 1
glPrint2 320, 221, Main.Menu(10).Caption, 0.9, 0.9
GlAlphaBlend False, False
glPushName 6
GlAlphaBlend False, True
If selected = 6 Then glColor4f 0.9, 0.9, 0.9, 1 Else glColor4f 0.5, 0.5, 0.5, 1
SelectTexture2D Texture(36)
'+13
If selected = 6 Then Call drawQuad2(1, -1.28, 0.82, 0.12, 1)
If Not selected = 6 Then Call drawQuad1(1, -1.28, 0.82, 0.12, 1)
If selected = 6 Then GlAlphaBlend False, False
glPopName
'menü07
GlAlphaBlend True, True
glColor4f 0, 3, 3, 1
glPrint2 320, 184, Main.Menu(11).Caption, 0.9, 0.9
GlAlphaBlend False, False
glPushName 7
GlAlphaBlend False, True
If selected = 7 Then glColor4f 0.9, 0.9, 0.9, 1 Else glColor4f 0.5, 0.5, 0.5, 1
SelectTexture2D Texture(36)
'+13
If selected = 7 Then Call drawQuad2(1, -1.42, 0.82, 0.12, 1)
If Not selected = 7 Then Call drawQuad1(1, -1.42, 0.82, 0.12, 1)
If selected = 7 Then GlAlphaBlend False, False
glPopName
End Sub
Public Sub drawOtherCue()
If Not NextPlayer = 1 And AllVelocity0 Then
'---------------------------------------------
'Nincs dáko animáció, ha CreditsIn vagy Szünet van..
If CreditsIn Or Pause Then Exit Sub
'---------------------------------------------
'Algoritmus Kicserélve erre
'Cue_RotY1 = 46 + (((0.75 - toY) / 1.8) * 600)
'Cue_RotX1 = 70 + (((1 + toX) / 2.4) * 800)
'---------------------------------------------
Dim SfX As Single, SfY As Single
'A dákó "elejének" a forgása...
On Error Resume Next
'---------------------------------------------
SfX = -Atn((Cue_RotY2 - Cue_RotY1) / (Cue_RotX2 - Cue_RotX1)) * (3.14 / 90)
SfY = SfX
angle = Atn((Cue_RotY2 - Cue_RotY1) / (Cue_RotX2 - Cue_RotX1))
angle2 = -angle / (3.14 / 180)
'---------------------------------------------
If (angle2 > 0) And (Cue_RotX2 < Cue_RotX1) Then angle2 = 180 + angle2
If (angle2 < 0) And (Cue_RotX2 < Cue_RotX1) Then angle2 = 180 + angle2
'---------------------------------------------
If (angle2 <= 0) Then
SfX = -SfX - 0.06: SfY = -SfY
ElseIf (angle2 > 0) And (angle2 < 90) Then
SfX = Abs(SfX) - 0.06: SfY = -SfY
ElseIf (angle2 >= 90) And (angle2 < 180) Then
SfX = 0.06 + SfX: SfY = SfY
ElseIf (angle2 >= 180) Then
SfX = -SfX + 0.06: SfY = Abs(SfY)
End If
'---------------------------------------------
'RAJZ
Call drawCue(toX, toY, SfX, SfY, angle, angle2)
'Árnyék
If ShadowsIn Then Call drawCueShadow(toX, toY, SfX, SfY, angle, angle2)
'---------------------------------------------
End If
End Sub
Public Sub SelectObj(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim hits As Long, i As Integer, idx As Integer
Dim SelBuf(0 To 511) As Long
Dim namepos As Integer, minz As Double
Dim viewport(0 To 3) As Long
Dim oldhit As Byte
mode = 1
glSelectBuffer 512, SelBuf(0)
glGetIntegerv GL_VIEWPORT, viewport(0)
glRenderMode GL_SELECT
glInitNames
glMatrixMode mmProjection
glPushMatrix
glLoadIdentity
gluPickMatrix x, viewport(3) - y, 0.1, 0.1, viewport(0)
gluPerspective 45!, viewport(2) / viewport(3), 1!, 100!
glMatrixMode mmModelView
Set m = New RENDER_CLASS
Call m.RenderAll
glMatrixMode mmProjection
glPopMatrix
glMatrixMode mmModelView
glFlush
hits = glRenderMode(rmRender)
If Not (hits = 0) Then
minz = 2147483647
idx = 0: selected = 0
For i = 1 To hits
namepos = SelBuf(idx)
If (SelBuf(idx + 1) < minz) And (namepos > 0) Then
minz = SelBuf(idx + 1)
selected = SelBuf(idx + 3)
End If
idx = idx + 3 + namepos
Next i
End If
'If Selected > 0 And Selected < 8 Then
' If (SoundIn) And (oldhit = Selected) Then PlayTheSound 7
' oldhit = Selected
'End If
mode = 0
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment