1 |
VERSION 5.00 |
2 |
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX" |
3 |
Begin VB.Form Form_Start |
4 |
AutoRedraw = -1 'True |
5 |
BorderStyle = 4 'Fixed ToolWindow |
6 |
Caption = " " |
7 |
ClientHeight = 6555 |
8 |
ClientLeft = 45 |
9 |
ClientTop = 285 |
10 |
ClientWidth = 5475 |
11 |
ControlBox = 0 'False |
12 |
BeginProperty Font |
13 |
Name = "Arial" |
14 |
Size = 6.75 |
15 |
Charset = 0 |
16 |
Weight = 700 |
17 |
Underline = 0 'False |
18 |
Italic = 0 'False |
19 |
Strikethrough = 0 'False |
20 |
EndProperty |
21 |
KeyPreview = -1 'True |
22 |
MaxButton = 0 'False |
23 |
MinButton = 0 'False |
24 |
ScaleHeight = 437 |
25 |
ScaleMode = 3 'Pixel |
26 |
ScaleWidth = 365 |
27 |
StartUpPosition = 2 'CenterScreen |
28 |
Begin VB.OptionButton Option_MultisampleType4 |
29 |
Caption = "4x" |
30 |
Enabled = 0 'False |
31 |
Height = 195 |
32 |
Left = 3540 |
33 |
TabIndex = 22 |
34 |
Top = 960 |
35 |
Width = 465 |
36 |
End |
37 |
Begin VB.OptionButton Option_MultisampleType2 |
38 |
Caption = "2x" |
39 |
Enabled = 0 'False |
40 |
Height = 195 |
41 |
Left = 3030 |
42 |
TabIndex = 21 |
43 |
Top = 960 |
44 |
Value = -1 'True |
45 |
Width = 465 |
46 |
End |
47 |
Begin VB.CommandButton Command_Start |
48 |
Caption = "&Start" |
49 |
Enabled = 0 'False |
50 |
Height = 375 |
51 |
Left = 4260 |
52 |
TabIndex = 15 |
53 |
Top = 960 |
54 |
Width = 1065 |
55 |
End |
56 |
Begin VB.CommandButton Command_Exit |
57 |
Caption = "E&xit" |
58 |
Height = 375 |
59 |
Left = 4260 |
60 |
TabIndex = 14 |
61 |
Top = 2430 |
62 |
Width = 1065 |
63 |
End |
64 |
Begin VB.ComboBox Combo_Resolution |
65 |
Height = 285 |
66 |
Left = 1080 |
67 |
Style = 2 'Dropdown List |
68 |
TabIndex = 8 |
69 |
Top = 1530 |
70 |
Width = 1635 |
71 |
End |
72 |
Begin VB.CommandButton Command_RefreshModes |
73 |
Caption = "&Refresh modes" |
74 |
Height = 375 |
75 |
Left = 2790 |
76 |
TabIndex = 7 |
77 |
Top = 1770 |
78 |
Width = 1215 |
79 |
End |
80 |
Begin VB.CheckBox Check_Windowed |
81 |
Caption = "&Windowed mode" |
82 |
Height = 195 |
83 |
Left = 150 |
84 |
TabIndex = 6 |
85 |
Top = 960 |
86 |
Width = 1455 |
87 |
End |
88 |
Begin VB.HScrollBar HScroll_Volume |
89 |
Height = 225 |
90 |
LargeChange = 512 |
91 |
Left = 1230 |
92 |
Max = 0 |
93 |
Min = -8192 |
94 |
TabIndex = 5 |
95 |
Top = 2580 |
96 |
Value = -4096 |
97 |
Width = 2775 |
98 |
End |
99 |
Begin VB.ComboBox Combo_BitDepth |
100 |
Height = 285 |
101 |
Left = 1080 |
102 |
Style = 2 'Dropdown List |
103 |
TabIndex = 4 |
104 |
Top = 1200 |
105 |
Width = 1635 |
106 |
End |
107 |
Begin VB.ComboBox Combo_RefreshRate |
108 |
Height = 285 |
109 |
Left = 1080 |
110 |
Style = 2 'Dropdown List |
111 |
TabIndex = 3 |
112 |
Top = 1860 |
113 |
Width = 1635 |
114 |
End |
115 |
Begin VB.CheckBox Check_Antialias |
116 |
Caption = "&Antialiasing" |
117 |
Height = 195 |
118 |
Left = 1890 |
119 |
TabIndex = 2 |
120 |
Top = 960 |
121 |
Width = 1125 |
122 |
End |
123 |
Begin VB.PictureBox Picture_Console |
124 |
BackColor = &H00101008& |
125 |
Height = 3225 |
126 |
Left = 60 |
127 |
ScaleHeight = 3165 |
128 |
ScaleWidth = 5295 |
129 |
TabIndex = 0 |
130 |
Top = 2970 |
131 |
Width = 5355 |
132 |
Begin RichTextLib.RichTextBox Text_Console |
133 |
Height = 3075 |
134 |
Left = 60 |
135 |
TabIndex = 1 |
136 |
TabStop = 0 'False |
137 |
Top = 60 |
138 |
Width = 5175 |
139 |
_ExtentX = 9128 |
140 |
_ExtentY = 5424 |
141 |
_Version = 393217 |
142 |
BackColor = 1052680 |
143 |
BorderStyle = 0 |
144 |
ReadOnly = -1 'True |
145 |
ScrollBars = 3 |
146 |
Appearance = 0 |
147 |
TextRTF = $"Form_Start.frx":0000 |
148 |
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} |
149 |
Name = "Terminal" |
150 |
Size = 6 |
151 |
Charset = 255 |
152 |
Weight = 700 |
153 |
Underline = 0 'False |
154 |
Italic = 0 'False |
155 |
Strikethrough = 0 'False |
156 |
EndProperty |
157 |
End |
158 |
End |
159 |
Begin VB.Timer Timer_Performance |
160 |
Enabled = 0 'False |
161 |
Interval = 250 |
162 |
Left = 210 |
163 |
Top = 4650 |
164 |
End |
165 |
Begin VB.Label Label_Logo1 |
166 |
Alignment = 2 'Center |
167 |
AutoSize = -1 'True |
168 |
BackStyle = 0 'Transparent |
169 |
Caption = "R" |
170 |
BeginProperty Font |
171 |
Name = "Times New Roman" |
172 |
Size = 32.25 |
173 |
Charset = 0 |
174 |
Weight = 400 |
175 |
Underline = 0 'False |
176 |
Italic = 0 'False |
177 |
Strikethrough = 0 'False |
178 |
EndProperty |
179 |
ForeColor = &H8000000C& |
180 |
Height = 735 |
181 |
Index = 2 |
182 |
Left = 4680 |
183 |
TabIndex = 25 |
184 |
Top = 1620 |
185 |
Width = 465 |
186 |
End |
187 |
Begin VB.Label Label_Logo1 |
188 |
Alignment = 2 'Center |
189 |
AutoSize = -1 'True |
190 |
BackStyle = 0 'Transparent |
191 |
Caption = "R" |
192 |
BeginProperty Font |
193 |
Name = "Times New Roman" |
194 |
Size = 32.25 |
195 |
Charset = 0 |
196 |
Weight = 400 |
197 |
Underline = 0 'False |
198 |
Italic = 0 'False |
199 |
Strikethrough = 0 'False |
200 |
EndProperty |
201 |
ForeColor = &H8000000C& |
202 |
Height = 735 |
203 |
Index = 1 |
204 |
Left = 4560 |
205 |
TabIndex = 24 |
206 |
Top = 1530 |
207 |
Width = 465 |
208 |
End |
209 |
Begin VB.Label Label_Logo1 |
210 |
Alignment = 2 'Center |
211 |
AutoSize = -1 'True |
212 |
BackStyle = 0 'Transparent |
213 |
Caption = "R" |
214 |
BeginProperty Font |
215 |
Name = "Times New Roman" |
216 |
Size = 32.25 |
217 |
Charset = 0 |
218 |
Weight = 400 |
219 |
Underline = 0 'False |
220 |
Italic = 0 'False |
221 |
Strikethrough = 0 'False |
222 |
EndProperty |
223 |
ForeColor = &H8000000C& |
224 |
Height = 735 |
225 |
Index = 0 |
226 |
Left = 4440 |
227 |
TabIndex = 23 |
228 |
Top = 1440 |
229 |
Width = 465 |
230 |
End |
231 |
Begin VB.Shape Shape1 |
232 |
BorderColor = &H8000000C& |
233 |
BorderWidth = 3 |
234 |
FillColor = &H8000000F& |
235 |
Height = 885 |
236 |
Left = 4350 |
237 |
Shape = 5 'Rounded Square |
238 |
Top = 1440 |
239 |
Width = 885 |
240 |
End |
241 |
Begin VB.Label Label |
242 |
Alignment = 2 'Center |
243 |
Appearance = 0 'Flat |
244 |
BackColor = &H8000000C& |
245 |
Caption = "Control" |
246 |
ForeColor = &H80000008& |
247 |
Height = 195 |
248 |
Index = 6 |
249 |
Left = 4185 |
250 |
TabIndex = 19 |
251 |
Top = 705 |
252 |
Width = 1215 |
253 |
End |
254 |
Begin VB.Label Label_Title |
255 |
Alignment = 2 'Center |
256 |
BackStyle = 0 'Transparent |
257 |
Caption = "- - -" |
258 |
BeginProperty Font |
259 |
Name = "Arial Black" |
260 |
Size = 15.75 |
261 |
Charset = 0 |
262 |
Weight = 400 |
263 |
Underline = 0 'False |
264 |
Italic = 0 'False |
265 |
Strikethrough = 0 'False |
266 |
EndProperty |
267 |
Height = 435 |
268 |
Left = 90 |
269 |
TabIndex = 18 |
270 |
Top = 60 |
271 |
Width = 5265 |
272 |
End |
273 |
Begin VB.Label Label_Status |
274 |
Caption = "Ready to start..." |
275 |
Height = 165 |
276 |
Left = 120 |
277 |
TabIndex = 17 |
278 |
Top = 6300 |
279 |
Width = 5235 |
280 |
End |
281 |
Begin VB.Label Label |
282 |
AutoSize = -1 'True |
283 |
Caption = "Sound volume:" |
284 |
Height = 165 |
285 |
Index = 1 |
286 |
Left = 120 |
287 |
TabIndex = 12 |
288 |
Top = 2610 |
289 |
Width = 1035 |
290 |
End |
291 |
Begin VB.Label Label |
292 |
Alignment = 2 'Center |
293 |
Appearance = 0 'Flat |
294 |
BackColor = &H8000000C& |
295 |
Caption = "Sound" |
296 |
ForeColor = &H80000008& |
297 |
Height = 195 |
298 |
Index = 5 |
299 |
Left = 75 |
300 |
TabIndex = 16 |
301 |
Top = 2325 |
302 |
Width = 4005 |
303 |
End |
304 |
Begin VB.Label Label |
305 |
Alignment = 2 'Center |
306 |
Appearance = 0 'Flat |
307 |
BackColor = &H8000000C& |
308 |
Caption = "Display mode" |
309 |
ForeColor = &H80000008& |
310 |
Height = 195 |
311 |
Index = 0 |
312 |
Left = 75 |
313 |
TabIndex = 13 |
314 |
Top = 705 |
315 |
Width = 4005 |
316 |
End |
317 |
Begin VB.Shape Shape |
318 |
BorderColor = &H8000000C& |
319 |
FillColor = &H8000000F& |
320 |
FillStyle = 0 'Solid |
321 |
Height = 585 |
322 |
Index = 2 |
323 |
Left = 60 |
324 |
Top = 2310 |
325 |
Width = 4035 |
326 |
End |
327 |
Begin VB.Shape Shape |
328 |
BorderColor = &H8000000C& |
329 |
FillColor = &H8000000F& |
330 |
FillStyle = 0 'Solid |
331 |
Height = 2205 |
332 |
Index = 1 |
333 |
Left = 4170 |
334 |
Top = 690 |
335 |
Width = 1245 |
336 |
End |
337 |
Begin VB.Label Label |
338 |
Alignment = 1 'Right Justify |
339 |
AutoSize = -1 'True |
340 |
BackStyle = 0 'Transparent |
341 |
Caption = "Bit depth:" |
342 |
Height = 165 |
343 |
Index = 2 |
344 |
Left = 360 |
345 |
TabIndex = 11 |
346 |
Top = 1260 |
347 |
Width = 675 |
348 |
End |
349 |
Begin VB.Label Label |
350 |
Alignment = 1 'Right Justify |
351 |
AutoSize = -1 'True |
352 |
BackStyle = 0 'Transparent |
353 |
Caption = "Resolution:" |
354 |
Height = 165 |
355 |
Index = 3 |
356 |
Left = 240 |
357 |
TabIndex = 10 |
358 |
Top = 1590 |
359 |
Width = 795 |
360 |
End |
361 |
Begin VB.Label Label |
362 |
Alignment = 1 'Right Justify |
363 |
AutoSize = -1 'True |
364 |
BackStyle = 0 'Transparent |
365 |
Caption = "Refresh rate:" |
366 |
Height = 165 |
367 |
Index = 4 |
368 |
Left = 165 |
369 |
TabIndex = 9 |
370 |
Top = 1920 |
371 |
Width = 870 |
372 |
End |
373 |
Begin VB.Shape Shape |
374 |
BackColor = &H8000000C& |
375 |
BackStyle = 1 'Opaque |
376 |
BorderColor = &H8000000C& |
377 |
FillColor = &H8000000F& |
378 |
FillStyle = 0 'Solid |
379 |
Height = 1545 |
380 |
Index = 0 |
381 |
Left = 60 |
382 |
Top = 690 |
383 |
Width = 4035 |
384 |
End |
385 |
Begin VB.Shape Shape |
386 |
BorderColor = &H8000000C& |
387 |
FillColor = &H8000000F& |
388 |
FillStyle = 0 'Solid |
389 |
Height = 225 |
390 |
Index = 3 |
391 |
Left = 60 |
392 |
Top = 6270 |
393 |
Width = 5355 |
394 |
End |
395 |
Begin VB.Label Label_TitleBackground |
396 |
Alignment = 2 'Center |
397 |
BackStyle = 0 'Transparent |
398 |
Caption = "- - -" |
399 |
BeginProperty Font |
400 |
Name = "Arial Black" |
401 |
Size = 15 |
402 |
Charset = 0 |
403 |
Weight = 700 |
404 |
Underline = 0 'False |
405 |
Italic = 0 'False |
406 |
Strikethrough = 0 'False |
407 |
EndProperty |
408 |
ForeColor = &H8000000C& |
409 |
Height = 435 |
410 |
Left = 120 |
411 |
TabIndex = 20 |
412 |
Top = 120 |
413 |
Width = 5265 |
414 |
End |
415 |
End |
416 |
Attribute VB_Name = "Form_Start" |
417 |
Attribute VB_GlobalNameSpace = False |
418 |
Attribute VB_Creatable = False |
419 |
Attribute VB_PredeclaredId = True |
420 |
Attribute VB_Exposed = False |
421 |
Dim tpDefaultDispMode As D3DDISPLAYMODE |
422 |
Dim lptpAdapterDispModes() As D3DDISPLAYMODE |
423 |
Dim lptpEmptyDispModes() As D3DDISPLAYMODE |
424 |
|
425 |
Dim bListingModes As Boolean |
426 |
' |
427 |
|
428 |
Private Sub Check_Antialias_Click() |
429 |
|
430 |
If Check_Antialias.Value = 1 Then |
431 |
|
432 |
Option_MultisampleType2.Enabled = True |
433 |
Option_MultisampleType4.Enabled = True |
434 |
|
435 |
Else |
436 |
|
437 |
Option_MultisampleType2.Enabled = False |
438 |
Option_MultisampleType4.Enabled = False |
439 |
|
440 |
End If |
441 |
|
442 |
End Sub |
443 |
|
444 |
Private Sub Check_Windowed_Click() |
445 |
|
446 |
If Check_Windowed.Value = 1 Then |
447 |
|
448 |
Combo_BitDepth.Enabled = False |
449 |
Combo_RefreshRate.Enabled = False |
450 |
Combo_Resolution.Enabled = False |
451 |
Command_RefreshModes.Enabled = False |
452 |
|
453 |
Else |
454 |
|
455 |
Combo_BitDepth.Enabled = True |
456 |
Combo_RefreshRate.Enabled = True |
457 |
Combo_Resolution.Enabled = True |
458 |
Command_RefreshModes.Enabled = True |
459 |
|
460 |
End If |
461 |
|
462 |
End Sub |
463 |
|
464 |
Private Sub Combo_BitDepth_Click() |
465 |
|
466 |
If Not bListingModes Then UpdateResolutionsList |
467 |
|
468 |
End Sub |
469 |
|
470 |
Private Sub Combo_Resolution_Click() |
471 |
|
472 |
If Not bListingModes Then UpdateRefreshRatesList |
473 |
|
474 |
End Sub |
475 |
|
476 |
Private Sub Command_Exit_Click() |
477 |
|
478 |
End |
479 |
|
480 |
End Sub |
481 |
|
482 |
Private Sub Command_RefreshModes_Click() |
483 |
|
484 |
GetModes 0 |
485 |
|
486 |
End Sub |
487 |
|
488 |
Private Sub Command_Start_Click() |
489 |
|
490 |
Command_Start.Enabled = False |
491 |
Command_Exit.Enabled = False |
492 |
Timer_Performance.Enabled = True |
493 |
|
494 |
ConPrint Const_strConsoleTextLine + Const_strConsoleTextLineIndent + "starting 3d engine...[brk]" + Const_strConsoleTextLine + "[brk]" |
495 |
|
496 |
DoEvents |
497 |
|
498 |
On Local Error Resume Next |
499 |
|
500 |
Form_D3D.Show |
501 |
Exit Sub |
502 |
|
503 |
' On Local Error GoTo 0 |
504 |
|
505 |
End Sub |
506 |
|
507 |
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) |
508 |
|
509 |
If KeyCode = vbKeyEscape Then End |
510 |
|
511 |
End Sub |
512 |
|
513 |
Private Sub Form_Load() |
514 |
|
515 |
Dim l As Long |
516 |
Dim m As Long |
517 |
Dim n As Long |
518 |
Dim p As Long |
519 |
|
520 |
With Me |
521 |
|
522 |
For l = -10 To .ScaleWidth * 1.5 Step 30 |
523 |
|
524 |
For m = 0 To .ScaleHeight |
525 |
|
526 |
n = 15 * ((m / 15) Mod 2) + 8 * Sin(m / 10) - m / 3 |
527 |
p = 0 |
528 |
|
529 |
Me.Line (l + n, m)-(l + n + 14, m), &HB0B0B0, BF |
530 |
'Me.Line (l + n + 15, m)-(l + n + 29, m), &HD0D0D0, BF |
531 |
|
532 |
Next m |
533 |
|
534 |
Next l |
535 |
|
536 |
.AutoRedraw = False |
537 |
.ClipControls = False |
538 |
|
539 |
Label_Title.Caption = Const_strApplicationLongName + " v" + Const_strApplicationVersion |
540 |
Label_TitleBackground.Caption = Label_Title.Caption |
541 |
|
542 |
.Show |
543 |
|
544 |
End With |
545 |
|
546 |
' For l = 0 To 15 |
547 |
' |
548 |
' ConPrint "[c" + Right("0" & l, 2) + "]" + Right("0" & l, 2) + " " |
549 |
' |
550 |
' Next l |
551 |
|
552 |
ConPrint Const_strConsoleTextLine + Const_strConsoleTextLineIndent + "[c15]" + Const_strApplicationCompany + "[c07] presents:[brk]" |
553 |
ConPrint Const_strConsoleTextLineIndent + "[c14]" + Const_strApplicationShortName + "[c08] - [c14]" + Const_strApplicationLongName + "[brk]" + Const_strConsoleTextLine |
554 |
ConPrint Const_strConsoleTextLineIndent + "by [c15]" + Const_strApplicationCreators + "[c08] (" + Const_strApplicationFirstDate + " - " + Const_strApplicationLastDate + ")[brk]" + Const_strConsoleTextLine + "[brk]" |
555 |
|
556 |
ConPrint Const_strConsoleBlockTitlePre + "initialising required objects:" + Const_strConsoleBlockTitlePost |
557 |
|
558 |
ConPrint " initialising directx8... " |
559 |
|
560 |
l = Benchmark(0) |
561 |
|
562 |
If clSystem.InitialiseDX8 Then |
563 |
|
564 |
ConPrint Const_strConsoleTextOK |
565 |
ConPrint " initialising direct3d8... " |
566 |
|
567 |
If clSystem.InitialiseD3D8 Then |
568 |
|
569 |
ConPrint Const_strConsoleTextOK |
570 |
ConPrint " initialising direct3dx8... " |
571 |
|
572 |
If clSystem.InitialiseD3DX8 Then |
573 |
|
574 |
l = Benchmark(l) |
575 |
|
576 |
ConPrint Const_strConsoleTextOK |
577 |
ConPrint "[brk] [c02]driectx and direct3d setup succeeded (" & l & " ms).[c15][brk][brk]" |
578 |
|
579 |
D3DXMatrixIdentity tpMatIdentity ' Global pre-defined identity matrix |
580 |
|
581 |
ConPrint Const_strConsoleBlockTitlePre + "testing additional features/objects:" + Const_strConsoleBlockTitlePost |
582 |
ConPrint " initialising directsound8... " |
583 |
|
584 |
If clSystem.InitialiseDS8() Then |
585 |
|
586 |
ConPrint Const_strConsoleTextOK |
587 |
|
588 |
InitialiseSound |
589 |
SetupMenuItems |
590 |
Load Form_NetworkListen |
591 |
|
592 |
Else |
593 |
|
594 |
ConPrint Const_strConsoleTextFail |
595 |
ConPrint "[brk] [c12]could not initialise directsound v8.[c07][brk](of course you may play w/o sound ;)[brk][brk]" |
596 |
|
597 |
End If |
598 |
|
599 |
GetModes 0 |
600 |
Check_Windowed.Value = 1 |
601 |
' Check_Antialias.Value = 1 |
602 |
|
603 |
Form_Start.Command_Start.Enabled = True |
604 |
|
605 |
Else |
606 |
|
607 |
ConPrint Const_strConsoleTextFail |
608 |
ConPrint "[brk] [c12]could not generate the d3dx v8 object![c07][brk][brk]" |
609 |
|
610 |
End If |
611 |
|
612 |
Else |
613 |
|
614 |
ConPrint Const_strConsoleTextFail |
615 |
ConPrint "[brk] [c12]could not generate the direct3d v8 object![c07][brk][brk]" |
616 |
|
617 |
End If |
618 |
|
619 |
Else |
620 |
|
621 |
ConPrint Const_strConsoleTextFail |
622 |
ConPrint "[brk] [c12]you need driectx v8 (or higher) to be installed for running this application![c07][brk][brk]" |
623 |
|
624 |
End If |
625 |
|
626 |
ConPrint "[brk]" |
627 |
|
628 |
End Sub |
629 |
|
630 |
Private Sub Form_Unload(Cancel As Integer) |
631 |
|
632 |
Unload Form_Debug |
633 |
Unload Form_NetworkListen |
634 |
|
635 |
clGame.RemoveAllPlayers |
636 |
|
637 |
End Sub |
638 |
|
639 |
Private Sub Text_Console_DblClick() |
640 |
|
641 |
Form_Debug.Show |
642 |
|
643 |
End Sub |
644 |
|
645 |
Private Sub Timer_Performance_Timer() |
646 |
|
647 |
Dim clPlayer As Class_Player |
648 |
Dim lTickCount As Long |
649 |
Static lLastTicks As Long |
650 |
|
651 |
lTickCount = GetTickCount |
652 |
strCurrentFPS = Int(lFramesCount * 1000 / (lTickCount - lLastTicks)) & " fps" |
653 |
lLastTicks = lTickCount |
654 |
lFramesCount = 0 |
655 |
|
656 |
If lLocalPlayerHandle > 0 Then |
657 |
|
658 |
Set clPlayer = clGame.Col_clPlayers("p" & lLocalPlayerHandle) |
659 |
Label_Status.Caption = strCurrentFPS + ", Player pos.: X=" & Int(clPlayer.GetPosition.X * 100) / 100 & ", Z=" & Int(clPlayer.GetPosition.Z * 100) / 100 & ", Angle=" & Int(clPlayer.sgAngleY * 100) / 100 & "°" |
660 |
|
661 |
Else |
662 |
|
663 |
Label_Status.Caption = strCurrentFPS |
664 |
|
665 |
End If |
666 |
|
667 |
End Sub |
668 |
|
669 |
Private Sub GetModes(lAdapter As Long) |
670 |
|
671 |
Dim l As Integer |
672 |
Dim lModeCount As Long |
673 |
Dim lListIndex As Long |
674 |
|
675 |
Dim lLastDispModeFormat As Long |
676 |
|
677 |
Dim Col_lFormatCode As New Collection |
678 |
|
679 |
Col_lFormatCode.Add "8 Bit", "f" & D3DFMT_R3G3B2 |
680 |
|
681 |
Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_A1R5G5B5 |
682 |
Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_A4R4G4B4 |
683 |
Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_A8R3G3B2 |
684 |
Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_R5G6B5 |
685 |
Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_X1R5G5B5 |
686 |
Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_X4R4G4B4 |
687 |
|
688 |
Col_lFormatCode.Add "24 Bit", "f" & D3DFMT_R8G8B8 |
689 |
|
690 |
Col_lFormatCode.Add "32 Bit", "f" & D3DFMT_A8R8G8B8 |
691 |
Col_lFormatCode.Add "32 Bit", "f" & D3DFMT_X8R8G8B8 |
692 |
|
693 |
clSystem.D3D8.GetAdapterDisplayMode lAdapter, tpDefaultDispMode |
694 |
lModeCount = clSystem.D3D8.GetAdapterModeCount(lAdapter) |
695 |
|
696 |
ReDim lptpAdapterDispModes(lModeCount - 1) |
697 |
|
698 |
bListingModes = True |
699 |
|
700 |
Combo_BitDepth.Clear |
701 |
|
702 |
For l = 0 To lModeCount - 1 |
703 |
|
704 |
clSystem.D3D8.EnumAdapterModes lAdapter, l, lptpAdapterDispModes(l) |
705 |
|
706 |
If lptpAdapterDispModes(l).Format <> lLastDispModeFormat Then |
707 |
|
708 |
lLastDispModeFormat = lptpAdapterDispModes(l).Format |
709 |
Combo_BitDepth.AddItem Col_lFormatCode("f" & lLastDispModeFormat) |
710 |
Combo_BitDepth.ItemData(Combo_BitDepth.ListCount - 1) = l |
711 |
lListIndex = Combo_BitDepth.ListCount - 1 |
712 |
|
713 |
End If |
714 |
|
715 |
Next l |
716 |
|
717 |
Combo_BitDepth.ListIndex = lListIndex |
718 |
|
719 |
bListingModes = False |
720 |
|
721 |
UpdateResolutionsList |
722 |
UpdateRefreshRatesList |
723 |
|
724 |
End Sub |
725 |
|
726 |
Private Sub UpdateResolutionsList() |
727 |
|
728 |
Dim l As Long |
729 |
Dim tpLastDispMode As D3DDISPLAYMODE |
730 |
|
731 |
Combo_Resolution.Clear |
732 |
|
733 |
For l = 0 To UBound(lptpAdapterDispModes) |
734 |
|
735 |
If lptpAdapterDispModes(l).Format = lptpAdapterDispModes(Combo_BitDepth.ItemData(Combo_BitDepth.ListIndex)).Format And lptpAdapterDispModes(l).Height <> tpLastDispMode.Height And lptpAdapterDispModes(l).Width <> tpLastDispMode.Width Then |
736 |
|
737 |
tpLastDispMode = lptpAdapterDispModes(l) |
738 |
Combo_Resolution.AddItem tpLastDispMode.Width & " x " & tpLastDispMode.Height |
739 |
Combo_Resolution.ItemData(Combo_Resolution.ListCount - 1) = l |
740 |
|
741 |
If tpDefaultDispMode.Height = lptpAdapterDispModes(l).Height And tpDefaultDispMode.Width = lptpAdapterDispModes(l).Width Then lListIndex = Combo_Resolution.ListCount - 1 |
742 |
|
743 |
End If |
744 |
|
745 |
Next l |
746 |
|
747 |
Combo_Resolution.ListIndex = lListIndex |
748 |
|
749 |
End Sub |
750 |
|
751 |
Private Sub UpdateRefreshRatesList() |
752 |
|
753 |
Dim l As Long |
754 |
Dim lDispModeIndex As Long |
755 |
Dim tpLastDispMode As D3DDISPLAYMODE |
756 |
|
757 |
Combo_RefreshRate.Clear |
758 |
|
759 |
For l = 0 To UBound(lptpAdapterDispModes) |
760 |
|
761 |
lDispModeIndex = Combo_Resolution.ItemData(Combo_Resolution.ListIndex) |
762 |
|
763 |
If lptpAdapterDispModes(l).Height = lptpAdapterDispModes(lDispModeIndex).Height And lptpAdapterDispModes(l).Width = lptpAdapterDispModes(lDispModeIndex).Width And lptpAdapterDispModes(l).Format = lptpAdapterDispModes(lDispModeIndex).Format And lptpAdapterDispModes(l).RefreshRate <> tpLastDispMode.RefreshRate Then |
764 |
|
765 |
tpLastDispMode = lptpAdapterDispModes(l) |
766 |
Combo_RefreshRate.AddItem tpLastDispMode.RefreshRate & " Hz" |
767 |
Combo_RefreshRate.ItemData(Combo_RefreshRate.ListCount - 1) = l |
768 |
|
769 |
If tpDefaultDispMode.RefreshRate = lptpAdapterDispModes(l).RefreshRate Then lListIndex = Combo_RefreshRate.ListCount - 1 |
770 |
|
771 |
End If |
772 |
|
773 |
Next l |
774 |
|
775 |
Combo_RefreshRate.ListIndex = lListIndex |
776 |
|
777 |
End Sub |