/[cvs]/rabit/RaBit's Rapid Racers/Module_Overlay.bas
ViewVC logotype

Contents of /rabit/RaBit's Rapid Racers/Module_Overlay.bas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (vendor branch)
Tue Mar 12 21:23:10 2002 UTC (22 years, 9 months ago) by cvsrabit
Branch: NFO, MAIN
CVS Tags: v034a, HEAD
Changes since 1.1: +0 -0 lines
Error occurred while calculating annotation data.
Initial project import

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 RSS 2.0 feed