Draws.bas 2003 körüli Visual Basic 6.0 szakdolgozat kódom egy része, Draws

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