rabit/r3/Module_Overlay.bas

Attribute VB_Name = "Module_Overlay"
Option Explicit

Global lMenuIndex As Long
Global lMenuSelectedItem As Long

'Global clOverlayFont1 As D3DXFont
'Global clOverlayFont2 As D3DXFont
'Global clOverlayFont3 As D3DXFont

Global Col_clMenus As New Collection
Global Col_clD3DFonts As New Collection
Global Col_clOverlayTextures As New Collection
'

Public Function DrawOverlay() As Boolean

Dim clPlayer As Class_Player
Dim clSprite As D3DXSprite
Dim clTrackSegment As Class_TrackSegment

Dim lColour As Long

Dim tpSpriteSourceRect As RECT
Dim tpRectText1 As RECT
Dim tpVec2SpritePosition As D3DVECTOR2
Dim tpVec2SpriteScale As D3DVECTOR2

    Set clSprite = clSystem.D3DX8.CreateSprite(clD3DDevice)
    
    If lLocalPlayerHandle <> 0 Then
    
        Set clPlayer = clGame.Col_clPlayers("p" & lLocalPlayerHandle)
    
        tpVec2SpritePosition.X = 4
        tpVec2SpritePosition.Y = 4
    
        tpVec2SpriteScale.X = 0.5 'clPlayer.sgSpeedRate
        tpVec2SpriteScale.Y = 1 '0.01
    
        tpSpriteSourceRect.bottom = 23
        tpSpriteSourceRect.Left = 0
        tpSpriteSourceRect.Right = 255
        tpSpriteSourceRect.Top = 0
        
        clSprite.Begin
    
        clSprite.Draw Col_clOverlayTextures(1), tpSpriteSourceRect, tpVec2SpriteScale, tpVec2SpritePosition, 0, tpVec2SpritePosition, &H200000FF
    
        tpSpriteSourceRect.Right = Abs(255 * clPlayer.sgSpeedRate)
        clSprite.Draw Col_clOverlayTextures(1), tpSpriteSourceRect, tpVec2SpriteScale, tpVec2SpritePosition, 0, tpVec2SpritePosition, &HA0FF4040
    
        clSprite.End
    
        tpRectText1.Left = 5
        tpRectText1.Top = 5
        tpRectText1.bottom = 32
        tpRectText1.Right = 132
        
        clSystem.D3DX8.DrawText Col_clD3DFonts(2), &HA080E0FF, Int(clPlayer.sgSpeed * 3.6) & " km/h", tpRectText1, DT_TOP Or DT_CENTER
        
'        tpRectText1.Top = 4
'        tpRectText1.bottom = 20
'        tpRectText1.Right = tpUsedDispMode.Width - 4
'        tpRectText1.Left = tpRectText1.Right - 64
'
'        clSystem.D3DX8.DrawText clOverlayFont3, &H40FFFFFF, strCurrentFPS, tpRectText1, DT_TOP Or DT_RIGHT

    End If

Dim tpRectMenu As RECT
Dim l As Long
Dim lMenuTop As Long
Dim lMenuWidth As Long
Dim lMenuItemHeight As Long

    If lMenuIndex > 0 Then
    
        lMenuItemHeight = 28
        lMenuTop = 80
        lMenuWidth = 256
        
        tpSpriteSourceRect.bottom = 256
        tpSpriteSourceRect.Right = 256
        
        tpVec2SpritePosition.X = (tpUsedDispMode.Width - lMenuWidth) / 2
        tpVec2SpritePosition.Y = lMenuTop - 20
    
        tpVec2SpriteScale.X = lMenuWidth / 256
        tpVec2SpriteScale.Y = (42 + Col_clMenus(lMenuIndex).Count * lMenuItemHeight) / 256
    
        clSprite.Begin
    
        clSprite.Draw Col_clOverlayTextures(2), tpSpriteSourceRect, tpVec2SpriteScale, tpVec2SpritePosition, 0, tpVec2SpritePosition, &HE0404040
        
        clSprite.End
     
        tpRectMenu.Left = 32
        tpRectMenu.Right = tpUsedDispMode.Width - 32
        
        For l = 0 To Col_clMenus(lMenuIndex).Count - 1
        
            tpRectMenu.Top = lMenuTop + lMenuItemHeight * l
            tpRectMenu.bottom = tpRectMenu.Top + 30
            
            If lMenuSelectedItem <> l Then
            
                clSystem.D3DX8.DrawText Col_clD3DFonts(1), &H40C0C0A0, Col_clMenus(lMenuIndex).Item(l + 1).strCaption, tpRectMenu, DT_CENTER Or DT_TOP
        
            End If
        
        Next l
       
        tpRectMenu.Top = lMenuTop + lMenuItemHeight * lMenuSelectedItem
        tpRectMenu.bottom = tpRectMenu.Top + 30
        
        clSystem.D3DX8.DrawText Col_clD3DFonts(1), &H80FFFFA0, Col_clMenus(lMenuIndex).Item(lMenuSelectedItem + 1).strCaption, tpRectMenu, DT_CENTER Or DT_TOP

    Else

        tpRectMenu.Right = tpUsedDispMode.Width - 4
        tpRectMenu.Left = tpRectMenu.Right - 300
        
        For l = 0 To clGame.Col_clPlayers.Count - 1
        
            Set clPlayer = clGame.Col_clPlayers(l + 1)
            
            tpRectMenu.Top = 2 + 14 * l
            tpRectMenu.bottom = tpRectMenu.Top + 12
            
            If clPlayer.bOffroad Then lColour = &HC0FF6020 Else lColour = &H80FFFFFF
            
'            Set clTrackSegment = clScene.Col_clTrackSegments(1)
            
'            If clTrackSegment.GetSide(clPlayer.GetPosition) Then lColour = &HC0FF4020 Else lColour = &H80FFFFFF
            
            clSystem.D3DX8.DrawText Col_clD3DFonts(3), lColour, """" + clPlayer.strName + """, RD " & clPlayer.lRoundCount & ", RT " + Format(clPlayer.sgRoundTime, "000.00") + ", BT " + Format(clPlayer.sgRoundBestTime, "000.00"), tpRectMenu, DT_RIGHT Or DT_TOP
        
        Next l

    End If

End Function

Public Sub SetupMenuItems()

Dim Col_clMenuItems As New Collection

    Set Col_clMenus = New Collection
    
    Col_clMenuItems.Add CreateMenuItem("Single player game", "single")
'    Col_clMenuItems.Add CreateMenuItem("Network gaming", "menu 3")
    Col_clMenuItems.Add CreateMenuItem("Leave scene", "exit")
'    Col_clMenuItems.Add CreateMenuItem("System setup", "")
    Col_clMenuItems.Add CreateMenuItem("Quit R3", "menu 2")

    Col_clMenus.Add Col_clMenuItems, "main"

    Set Col_clMenuItems = New Collection

    Col_clMenuItems.Add CreateMenuItem("Please, let me out...", "quit")
    Col_clMenuItems.Add CreateMenuItem("Nooo! Brm brrrmm!", "menu 0")

    Col_clMenus.Add Col_clMenuItems, "quit"

    Set Col_clMenuItems = New Collection

    Col_clMenuItems.Add CreateMenuItem("Start an own game", "")
    Col_clMenuItems.Add CreateMenuItem("Search games", "")
    Col_clMenuItems.Add CreateMenuItem("...go back", "menu 1")

    Col_clMenus.Add Col_clMenuItems, "net"

    Set Col_clMenuItems = New Collection

End Sub

Public Sub SetupOverlay()

Dim sfFont As New StdFont
Dim ifFontDesc As IFont
        
    sfFont.Name = "Tahoma"
    sfFont.Size = 16
    sfFont.Bold = True

    Set ifFontDesc = sfFont
    Col_clD3DFonts.Add clSystem.D3DX8.CreateFont(clD3DDevice, ifFontDesc.hFont)

    sfFont.Name = "Tahoma"
    sfFont.Size = 12
    sfFont.Bold = True

    Set ifFontDesc = sfFont
    Col_clD3DFonts.Add clSystem.D3DX8.CreateFont(clD3DDevice, ifFontDesc.hFont)

    sfFont.Name = "Tahoma"
    sfFont.Size = 8
    sfFont.Bold = True

    Set ifFontDesc = sfFont
    Col_clD3DFonts.Add clSystem.D3DX8.CreateFont(clD3DDevice, ifFontDesc.hFont)

    Col_clOverlayTextures.Add clSystem.D3DX8.CreateTextureFromFileEx(clD3DDevice, App.Path + "\Scenes\Textures\floor3.jpg", 128, 128, 1, 0, tpUsedDispMode.Format, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)
    Col_clOverlayTextures.Add clSystem.D3DX8.CreateTextureFromFileEx(clD3DDevice, App.Path + "\Scenes\Textures\netfrag.jpg", 256, 256, 1, 0, tpUsedDispMode.Format, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)

End Sub

Private Function CreateMenuItem(strCaption As String, strCommand As String) As Class_SubMenuItem

    Set CreateMenuItem = New Class_SubMenuItem

    With CreateMenuItem
    
        .strCaption = strCaption
        .strCommand = strCommand

    End With

End Function
1	cvsrabit	1.1	Attribute VB_Name = "Module_Overlay"
2			Option Explicit
3
4			Global lMenuIndex As Long
5			Global lMenuSelectedItem As Long
6
7			'Global clOverlayFont1 As D3DXFont
8			'Global clOverlayFont2 As D3DXFont
9			'Global clOverlayFont3 As D3DXFont
10
11			Global Col_clMenus As New Collection
12			Global Col_clD3DFonts As New Collection
13			Global Col_clOverlayTextures As New Collection
14			'
15
16			Public Function DrawOverlay() As Boolean
17
18			Dim clPlayer As Class_Player
19			Dim clSprite As D3DXSprite
20			Dim clTrackSegment As Class_TrackSegment
21
22			Dim lColour As Long
23
24			Dim tpSpriteSourceRect As RECT
25			Dim tpRectText1 As RECT
26			Dim tpVec2SpritePosition As D3DVECTOR2
27			Dim tpVec2SpriteScale As D3DVECTOR2
28
29			Set clSprite = clSystem.D3DX8.CreateSprite(clD3DDevice)
30
31			If lLocalPlayerHandle <> 0 Then
32
33			Set clPlayer = clGame.Col_clPlayers("p" & lLocalPlayerHandle)
34
35			tpVec2SpritePosition.X = 4
36			tpVec2SpritePosition.Y = 4
37
38			tpVec2SpriteScale.X = 0.5 'clPlayer.sgSpeedRate
39			tpVec2SpriteScale.Y = 1 '0.01
40
41			tpSpriteSourceRect.bottom = 23
42			tpSpriteSourceRect.Left = 0
43			tpSpriteSourceRect.Right = 255
44			tpSpriteSourceRect.Top = 0
45
46			clSprite.Begin
47
48			clSprite.Draw Col_clOverlayTextures(1), tpSpriteSourceRect, tpVec2SpriteScale, tpVec2SpritePosition, 0, tpVec2SpritePosition, &H200000FF
49
50			tpSpriteSourceRect.Right = Abs(255 * clPlayer.sgSpeedRate)
51			clSprite.Draw Col_clOverlayTextures(1), tpSpriteSourceRect, tpVec2SpriteScale, tpVec2SpritePosition, 0, tpVec2SpritePosition, &HA0FF4040
52
53			clSprite.End
54
55			tpRectText1.Left = 5
56			tpRectText1.Top = 5
57			tpRectText1.bottom = 32
58			tpRectText1.Right = 132
59
60			clSystem.D3DX8.DrawText Col_clD3DFonts(2), &HA080E0FF, Int(clPlayer.sgSpeed * 3.6) & " km/h", tpRectText1, DT_TOP Or DT_CENTER
61
62			' tpRectText1.Top = 4
63			' tpRectText1.bottom = 20
64			' tpRectText1.Right = tpUsedDispMode.Width - 4
65			' tpRectText1.Left = tpRectText1.Right - 64
66			'
67			' clSystem.D3DX8.DrawText clOverlayFont3, &H40FFFFFF, strCurrentFPS, tpRectText1, DT_TOP Or DT_RIGHT
68
69			End If
70
71			Dim tpRectMenu As RECT
72			Dim l As Long
73			Dim lMenuTop As Long
74			Dim lMenuWidth As Long
75			Dim lMenuItemHeight As Long
76
77			If lMenuIndex > 0 Then
78
79			lMenuItemHeight = 28
80			lMenuTop = 80
81			lMenuWidth = 256
82
83			tpSpriteSourceRect.bottom = 256
84			tpSpriteSourceRect.Right = 256
85
86			tpVec2SpritePosition.X = (tpUsedDispMode.Width - lMenuWidth) / 2
87			tpVec2SpritePosition.Y = lMenuTop - 20
88
89			tpVec2SpriteScale.X = lMenuWidth / 256
90			tpVec2SpriteScale.Y = (42 + Col_clMenus(lMenuIndex).Count * lMenuItemHeight) / 256
91
92			clSprite.Begin
93
94			clSprite.Draw Col_clOverlayTextures(2), tpSpriteSourceRect, tpVec2SpriteScale, tpVec2SpritePosition, 0, tpVec2SpritePosition, &HE0404040
95
96			clSprite.End
97
98			tpRectMenu.Left = 32
99			tpRectMenu.Right = tpUsedDispMode.Width - 32
100
101			For l = 0 To Col_clMenus(lMenuIndex).Count - 1
102
103			tpRectMenu.Top = lMenuTop + lMenuItemHeight * l
104			tpRectMenu.bottom = tpRectMenu.Top + 30
105
106			If lMenuSelectedItem <> l Then
107
108			clSystem.D3DX8.DrawText Col_clD3DFonts(1), &H40C0C0A0, Col_clMenus(lMenuIndex).Item(l + 1).strCaption, tpRectMenu, DT_CENTER Or DT_TOP
109
110			End If
111
112			Next l
113
114			tpRectMenu.Top = lMenuTop + lMenuItemHeight * lMenuSelectedItem
115			tpRectMenu.bottom = tpRectMenu.Top + 30
116
117			clSystem.D3DX8.DrawText Col_clD3DFonts(1), &H80FFFFA0, Col_clMenus(lMenuIndex).Item(lMenuSelectedItem + 1).strCaption, tpRectMenu, DT_CENTER Or DT_TOP
118
119			Else
120
121			tpRectMenu.Right = tpUsedDispMode.Width - 4
122			tpRectMenu.Left = tpRectMenu.Right - 300
123
124			For l = 0 To clGame.Col_clPlayers.Count - 1
125
126			Set clPlayer = clGame.Col_clPlayers(l + 1)
127
128			tpRectMenu.Top = 2 + 14 * l
129			tpRectMenu.bottom = tpRectMenu.Top + 12
130
131			If clPlayer.bOffroad Then lColour = &HC0FF6020 Else lColour = &H80FFFFFF
132
133			' Set clTrackSegment = clScene.Col_clTrackSegments(1)
134
135			' If clTrackSegment.GetSide(clPlayer.GetPosition) Then lColour = &HC0FF4020 Else lColour = &H80FFFFFF
136
137			clSystem.D3DX8.DrawText Col_clD3DFonts(3), lColour, """" + clPlayer.strName + """, RD " & clPlayer.lRoundCount & ", RT " + Format(clPlayer.sgRoundTime, "000.00") + ", BT " + Format(clPlayer.sgRoundBestTime, "000.00"), tpRectMenu, DT_RIGHT Or DT_TOP
138
139			Next l
140
141			End If
142
143			End Function
144
145			Public Sub SetupMenuItems()
146
147			Dim Col_clMenuItems As New Collection
148
149			Set Col_clMenus = New Collection
150
151			Col_clMenuItems.Add CreateMenuItem("Single player game", "single")
152			' Col_clMenuItems.Add CreateMenuItem("Network gaming", "menu 3")
153			Col_clMenuItems.Add CreateMenuItem("Leave scene", "exit")
154			' Col_clMenuItems.Add CreateMenuItem("System setup", "")
155			Col_clMenuItems.Add CreateMenuItem("Quit R3", "menu 2")
156
157			Col_clMenus.Add Col_clMenuItems, "main"
158
159			Set Col_clMenuItems = New Collection
160
161			Col_clMenuItems.Add CreateMenuItem("Please, let me out...", "quit")
162			Col_clMenuItems.Add CreateMenuItem("Nooo! Brm brrrmm!", "menu 0")
163
164			Col_clMenus.Add Col_clMenuItems, "quit"
165
166			Set Col_clMenuItems = New Collection
167
168			Col_clMenuItems.Add CreateMenuItem("Start an own game", "")
169			Col_clMenuItems.Add CreateMenuItem("Search games", "")
170			Col_clMenuItems.Add CreateMenuItem("...go back", "menu 1")
171
172			Col_clMenus.Add Col_clMenuItems, "net"
173
174			Set Col_clMenuItems = New Collection
175
176			End Sub
177
178			Public Sub SetupOverlay()
179
180			Dim sfFont As New StdFont
181			Dim ifFontDesc As IFont
182
183			sfFont.Name = "Tahoma"
184			sfFont.Size = 16
185			sfFont.Bold = True
186
187			Set ifFontDesc = sfFont
188			Col_clD3DFonts.Add clSystem.D3DX8.CreateFont(clD3DDevice, ifFontDesc.hFont)
189
190			sfFont.Name = "Tahoma"
191			sfFont.Size = 12
192			sfFont.Bold = True
193
194			Set ifFontDesc = sfFont
195			Col_clD3DFonts.Add clSystem.D3DX8.CreateFont(clD3DDevice, ifFontDesc.hFont)
196
197			sfFont.Name = "Tahoma"
198			sfFont.Size = 8
199			sfFont.Bold = True
200
201			Set ifFontDesc = sfFont
202			Col_clD3DFonts.Add clSystem.D3DX8.CreateFont(clD3DDevice, ifFontDesc.hFont)
203
204			Col_clOverlayTextures.Add clSystem.D3DX8.CreateTextureFromFileEx(clD3DDevice, App.Path + "\Scenes\Textures\floor3.jpg", 128, 128, 1, 0, tpUsedDispMode.Format, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)
205			Col_clOverlayTextures.Add clSystem.D3DX8.CreateTextureFromFileEx(clD3DDevice, App.Path + "\Scenes\Textures\netfrag.jpg", 256, 256, 1, 0, tpUsedDispMode.Format, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)
206
207			End Sub
208
209			Private Function CreateMenuItem(strCaption As String, strCommand As String) As Class_SubMenuItem
210
211			Set CreateMenuItem = New Class_SubMenuItem
212
213			With CreateMenuItem
214
215			.strCaption = strCaption
216			.strCommand = strCommand
217
218			End With
219
220			End Function
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26