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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide 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
Initial project import

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