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	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