rabit/r3/Form_Start.frm

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form Form_Start 
   AutoRedraw      =   -1  'True
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   " "
   ClientHeight    =   6555
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   5475
   ControlBox      =   0   'False
   BeginProperty Font 
      Name            =   "Arial"
      Size            =   6.75
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   KeyPreview      =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   437
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   365
   StartUpPosition =   2  'CenterScreen
   Begin VB.OptionButton Option_MultisampleType4 
      Caption         =   "4x"
      Enabled         =   0   'False
      Height          =   195
      Left            =   3540
      TabIndex        =   22
      Top             =   960
      Width           =   465
   End
   Begin VB.OptionButton Option_MultisampleType2 
      Caption         =   "2x"
      Enabled         =   0   'False
      Height          =   195
      Left            =   3030
      TabIndex        =   21
      Top             =   960
      Value           =   -1  'True
      Width           =   465
   End
   Begin VB.CommandButton Command_Start 
      Caption         =   "&Start"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4260
      TabIndex        =   15
      Top             =   960
      Width           =   1065
   End
   Begin VB.CommandButton Command_Exit 
      Caption         =   "E&xit"
      Height          =   375
      Left            =   4260
      TabIndex        =   14
      Top             =   2430
      Width           =   1065
   End
   Begin VB.ComboBox Combo_Resolution 
      Height          =   285
      Left            =   1080
      Style           =   2  'Dropdown List
      TabIndex        =   8
      Top             =   1530
      Width           =   1635
   End
   Begin VB.CommandButton Command_RefreshModes 
      Caption         =   "&Refresh modes"
      Height          =   375
      Left            =   2790
      TabIndex        =   7
      Top             =   1770
      Width           =   1215
   End
   Begin VB.CheckBox Check_Windowed 
      Caption         =   "&Windowed mode"
      Height          =   195
      Left            =   150
      TabIndex        =   6
      Top             =   960
      Width           =   1455
   End
   Begin VB.HScrollBar HScroll_Volume 
      Height          =   225
      LargeChange     =   512
      Left            =   1230
      Max             =   0
      Min             =   -8192
      TabIndex        =   5
      Top             =   2580
      Value           =   -4096
      Width           =   2775
   End
   Begin VB.ComboBox Combo_BitDepth 
      Height          =   285
      Left            =   1080
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   1200
      Width           =   1635
   End
   Begin VB.ComboBox Combo_RefreshRate 
      Height          =   285
      Left            =   1080
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   1860
      Width           =   1635
   End
   Begin VB.CheckBox Check_Antialias 
      Caption         =   "&Antialiasing"
      Height          =   195
      Left            =   1890
      TabIndex        =   2
      Top             =   960
      Width           =   1125
   End
   Begin VB.PictureBox Picture_Console 
      BackColor       =   &H00101008&
      Height          =   3225
      Left            =   60
      ScaleHeight     =   3165
      ScaleWidth      =   5295
      TabIndex        =   0
      Top             =   2970
      Width           =   5355
      Begin RichTextLib.RichTextBox Text_Console 
         Height          =   3075
         Left            =   60
         TabIndex        =   1
         TabStop         =   0   'False
         Top             =   60
         Width           =   5175
         _ExtentX        =   9128
         _ExtentY        =   5424
         _Version        =   393217
         BackColor       =   1052680
         BorderStyle     =   0
         ReadOnly        =   -1  'True
         ScrollBars      =   3
         Appearance      =   0
         TextRTF         =   $"Form_Start.frx":0000
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Terminal"
            Size            =   6
            Charset         =   255
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
   End
   Begin VB.Timer Timer_Performance 
      Enabled         =   0   'False
      Interval        =   250
      Left            =   210
      Top             =   4650
   End
   Begin VB.Label Label_Logo1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "R"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   32.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000C&
      Height          =   735
      Index           =   2
      Left            =   4680
      TabIndex        =   25
      Top             =   1620
      Width           =   465
   End
   Begin VB.Label Label_Logo1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "R"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   32.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000C&
      Height          =   735
      Index           =   1
      Left            =   4560
      TabIndex        =   24
      Top             =   1530
      Width           =   465
   End
   Begin VB.Label Label_Logo1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "R"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   32.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000C&
      Height          =   735
      Index           =   0
      Left            =   4440
      TabIndex        =   23
      Top             =   1440
      Width           =   465
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H8000000C&
      BorderWidth     =   3
      FillColor       =   &H8000000F&
      Height          =   885
      Left            =   4350
      Shape           =   5  'Rounded Square
      Top             =   1440
      Width           =   885
   End
   Begin VB.Label Label 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H8000000C&
      Caption         =   "Control"
      ForeColor       =   &H80000008&
      Height          =   195
      Index           =   6
      Left            =   4185
      TabIndex        =   19
      Top             =   705
      Width           =   1215
   End
   Begin VB.Label Label_Title 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "- - -"
      BeginProperty Font 
         Name            =   "Arial Black"
         Size            =   15.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   90
      TabIndex        =   18
      Top             =   60
      Width           =   5265
   End
   Begin VB.Label Label_Status 
      Caption         =   "Ready to start..."
      Height          =   165
      Left            =   120
      TabIndex        =   17
      Top             =   6300
      Width           =   5235
   End
   Begin VB.Label Label 
      AutoSize        =   -1  'True
      Caption         =   "Sound volume:"
      Height          =   165
      Index           =   1
      Left            =   120
      TabIndex        =   12
      Top             =   2610
      Width           =   1035
   End
   Begin VB.Label Label 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H8000000C&
      Caption         =   "Sound"
      ForeColor       =   &H80000008&
      Height          =   195
      Index           =   5
      Left            =   75
      TabIndex        =   16
      Top             =   2325
      Width           =   4005
   End
   Begin VB.Label Label 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H8000000C&
      Caption         =   "Display mode"
      ForeColor       =   &H80000008&
      Height          =   195
      Index           =   0
      Left            =   75
      TabIndex        =   13
      Top             =   705
      Width           =   4005
   End
   Begin VB.Shape Shape 
      BorderColor     =   &H8000000C&
      FillColor       =   &H8000000F&
      FillStyle       =   0  'Solid
      Height          =   585
      Index           =   2
      Left            =   60
      Top             =   2310
      Width           =   4035
   End
   Begin VB.Shape Shape 
      BorderColor     =   &H8000000C&
      FillColor       =   &H8000000F&
      FillStyle       =   0  'Solid
      Height          =   2205
      Index           =   1
      Left            =   4170
      Top             =   690
      Width           =   1245
   End
   Begin VB.Label Label 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Bit depth:"
      Height          =   165
      Index           =   2
      Left            =   360
      TabIndex        =   11
      Top             =   1260
      Width           =   675
   End
   Begin VB.Label Label 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Resolution:"
      Height          =   165
      Index           =   3
      Left            =   240
      TabIndex        =   10
      Top             =   1590
      Width           =   795
   End
   Begin VB.Label Label 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Refresh rate:"
      Height          =   165
      Index           =   4
      Left            =   165
      TabIndex        =   9
      Top             =   1920
      Width           =   870
   End
   Begin VB.Shape Shape 
      BackColor       =   &H8000000C&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H8000000C&
      FillColor       =   &H8000000F&
      FillStyle       =   0  'Solid
      Height          =   1545
      Index           =   0
      Left            =   60
      Top             =   690
      Width           =   4035
   End
   Begin VB.Shape Shape 
      BorderColor     =   &H8000000C&
      FillColor       =   &H8000000F&
      FillStyle       =   0  'Solid
      Height          =   225
      Index           =   3
      Left            =   60
      Top             =   6270
      Width           =   5355
   End
   Begin VB.Label Label_TitleBackground 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "- - -"
      BeginProperty Font 
         Name            =   "Arial Black"
         Size            =   15
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000C&
      Height          =   435
      Left            =   120
      TabIndex        =   20
      Top             =   120
      Width           =   5265
   End
End
Attribute VB_Name = "Form_Start"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim tpDefaultDispMode As D3DDISPLAYMODE
Dim lptpAdapterDispModes() As D3DDISPLAYMODE
Dim lptpEmptyDispModes() As D3DDISPLAYMODE

Dim bListingModes As Boolean
'

Private Sub Check_Antialias_Click()
    
    If Check_Antialias.Value = 1 Then

        Option_MultisampleType2.Enabled = True
        Option_MultisampleType4.Enabled = True

    Else

        Option_MultisampleType2.Enabled = False
        Option_MultisampleType4.Enabled = False

    End If

End Sub

Private Sub Check_Windowed_Click()

    If Check_Windowed.Value = 1 Then

        Combo_BitDepth.Enabled = False
        Combo_RefreshRate.Enabled = False
        Combo_Resolution.Enabled = False
        Command_RefreshModes.Enabled = False

    Else

        Combo_BitDepth.Enabled = True
        Combo_RefreshRate.Enabled = True
        Combo_Resolution.Enabled = True
        Command_RefreshModes.Enabled = True

    End If

End Sub

Private Sub Combo_BitDepth_Click()
    
    If Not bListingModes Then UpdateResolutionsList

End Sub

Private Sub Combo_Resolution_Click()

    If Not bListingModes Then UpdateRefreshRatesList

End Sub

Private Sub Command_Exit_Click()

    End

End Sub

Private Sub Command_RefreshModes_Click()

    GetModes 0

End Sub

Private Sub Command_Start_Click()

    Command_Start.Enabled = False
    Command_Exit.Enabled = False
    Timer_Performance.Enabled = True

    ConPrint Const_strConsoleTextLine + Const_strConsoleTextLineIndent + "starting 3d engine...[brk]" + Const_strConsoleTextLine + "[brk]"
    
    DoEvents
    
    On Local Error Resume Next
    
    Form_D3D.Show
    Exit Sub
    
'    On Local Error GoTo 0
    
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyEscape Then End

End Sub

Private Sub Form_Load()

Dim l As Long
Dim m As Long
Dim n As Long
Dim p As Long

    With Me
     
        For l = -10 To .ScaleWidth * 1.5 Step 30
        
            For m = 0 To .ScaleHeight
            
                n = 15 * ((m / 15) Mod 2) + 8 * Sin(m / 10) - m / 3
                p = 0
                
                Me.Line (l + n, m)-(l + n + 14, m), &HB0B0B0, BF
                'Me.Line (l + n + 15, m)-(l + n + 29, m), &HD0D0D0, BF
            
            Next m
        
        Next l
        
        .AutoRedraw = False
        .ClipControls = False
        
        Label_Title.Caption = Const_strApplicationLongName + " v" + Const_strApplicationVersion
        Label_TitleBackground.Caption = Label_Title.Caption
        
        .Show
    
    End With
    
'    For l = 0 To 15
'
'        ConPrint "[c" + Right("0" & l, 2) + "]" + Right("0" & l, 2) + " "
'
'    Next l
    
    ConPrint Const_strConsoleTextLine + Const_strConsoleTextLineIndent + "[c15]" + Const_strApplicationCompany + "[c07] presents:[brk]"
    ConPrint Const_strConsoleTextLineIndent + "[c14]" + Const_strApplicationShortName + "[c08] - [c14]" + Const_strApplicationLongName + "[brk]" + Const_strConsoleTextLine
    ConPrint Const_strConsoleTextLineIndent + "by [c15]" + Const_strApplicationCreators + "[c08] (" + Const_strApplicationFirstDate + " - " + Const_strApplicationLastDate + ")[brk]" + Const_strConsoleTextLine + "[brk]"
    
    ConPrint Const_strConsoleBlockTitlePre + "initialising required objects:" + Const_strConsoleBlockTitlePost
    
    ConPrint "  initialising directx8... "
    
    l = Benchmark(0)
    
    If clSystem.InitialiseDX8 Then
    
        ConPrint Const_strConsoleTextOK
        ConPrint "  initialising direct3d8... "
    
        If clSystem.InitialiseD3D8 Then
        
            ConPrint Const_strConsoleTextOK
            ConPrint "  initialising direct3dx8... "

            If clSystem.InitialiseD3DX8 Then
        
                l = Benchmark(l)
            
                ConPrint Const_strConsoleTextOK
                ConPrint "[brk]  [c02]driectx and direct3d setup succeeded (" & l & " ms).[c15][brk][brk]"
                
                D3DXMatrixIdentity tpMatIdentity ' Global pre-defined identity matrix
                
                ConPrint Const_strConsoleBlockTitlePre + "testing additional features/objects:" + Const_strConsoleBlockTitlePost
                ConPrint "  initialising directsound8... "
                
                If clSystem.InitialiseDS8() Then
                
                    ConPrint Const_strConsoleTextOK
                
                    InitialiseSound
                    SetupMenuItems
                    Load Form_NetworkListen
    
                Else
                
                    ConPrint Const_strConsoleTextFail
                    ConPrint "[brk]  [c12]could not initialise directsound v8.[c07][brk](of course you may play w/o sound ;)[brk][brk]"
                
                End If
                
                GetModes 0
                Check_Windowed.Value = 1
'                Check_Antialias.Value = 1
                
                Form_Start.Command_Start.Enabled = True

            Else
            
                ConPrint Const_strConsoleTextFail
                ConPrint "[brk]  [c12]could not generate the d3dx v8 object![c07][brk][brk]"
            
            End If

        Else
        
            ConPrint Const_strConsoleTextFail
            ConPrint "[brk]  [c12]could not generate the direct3d v8 object![c07][brk][brk]"
        
        End If
    
    Else
    
        ConPrint Const_strConsoleTextFail
        ConPrint "[brk]  [c12]you need driectx v8 (or higher) to be installed for running this application![c07][brk][brk]"
    
    End If
    
    ConPrint "[brk]"
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    Unload Form_Debug
    Unload Form_NetworkListen
    
    clGame.RemoveAllPlayers
    
End Sub

Private Sub Text_Console_DblClick()

    Form_Debug.Show

End Sub

Private Sub Timer_Performance_Timer()

Dim clPlayer As Class_Player
Dim lTickCount As Long
Static lLastTicks As Long

    lTickCount = GetTickCount
    strCurrentFPS = Int(lFramesCount * 1000 / (lTickCount - lLastTicks)) & " fps"
    lLastTicks = lTickCount
    lFramesCount = 0

    If lLocalPlayerHandle > 0 Then
        
        Set clPlayer = clGame.Col_clPlayers("p" & lLocalPlayerHandle)
        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 & "°"

    Else
    
        Label_Status.Caption = strCurrentFPS
        
    End If

End Sub

Private Sub GetModes(lAdapter As Long)

Dim l As Integer
Dim lModeCount As Long
Dim lListIndex As Long

Dim lLastDispModeFormat As Long

Dim Col_lFormatCode As New Collection

    Col_lFormatCode.Add "8 Bit", "f" & D3DFMT_R3G3B2
    
    Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_A1R5G5B5
    Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_A4R4G4B4
    Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_A8R3G3B2
    Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_R5G6B5
    Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_X1R5G5B5
    Col_lFormatCode.Add "16 Bit", "f" & D3DFMT_X4R4G4B4
        
    Col_lFormatCode.Add "24 Bit", "f" & D3DFMT_R8G8B8
    
    Col_lFormatCode.Add "32 Bit", "f" & D3DFMT_A8R8G8B8
    Col_lFormatCode.Add "32 Bit", "f" & D3DFMT_X8R8G8B8
    
    clSystem.D3D8.GetAdapterDisplayMode lAdapter, tpDefaultDispMode
    lModeCount = clSystem.D3D8.GetAdapterModeCount(lAdapter)
    
    ReDim lptpAdapterDispModes(lModeCount - 1)
    
    bListingModes = True
    
    Combo_BitDepth.Clear
    
    For l = 0 To lModeCount - 1

        clSystem.D3D8.EnumAdapterModes lAdapter, l, lptpAdapterDispModes(l)
    
        If lptpAdapterDispModes(l).Format <> lLastDispModeFormat Then
        
            lLastDispModeFormat = lptpAdapterDispModes(l).Format
            Combo_BitDepth.AddItem Col_lFormatCode("f" & lLastDispModeFormat)
            Combo_BitDepth.ItemData(Combo_BitDepth.ListCount - 1) = l
            lListIndex = Combo_BitDepth.ListCount - 1
            
        End If
        
    Next l

    Combo_BitDepth.ListIndex = lListIndex
    
    bListingModes = False

    UpdateResolutionsList
    UpdateRefreshRatesList

End Sub

Private Sub UpdateResolutionsList()

Dim l As Long
Dim tpLastDispMode As D3DDISPLAYMODE

    Combo_Resolution.Clear
    
    For l = 0 To UBound(lptpAdapterDispModes)

        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
    
            tpLastDispMode = lptpAdapterDispModes(l)
            Combo_Resolution.AddItem tpLastDispMode.Width & " x " & tpLastDispMode.Height
            Combo_Resolution.ItemData(Combo_Resolution.ListCount - 1) = l
    
            If tpDefaultDispMode.Height = lptpAdapterDispModes(l).Height And tpDefaultDispMode.Width = lptpAdapterDispModes(l).Width Then lListIndex = Combo_Resolution.ListCount - 1

        End If

    Next l

    Combo_Resolution.ListIndex = lListIndex

End Sub

Private Sub UpdateRefreshRatesList()

Dim l As Long
Dim lDispModeIndex As Long
Dim tpLastDispMode As D3DDISPLAYMODE

    Combo_RefreshRate.Clear
    
    For l = 0 To UBound(lptpAdapterDispModes)

        lDispModeIndex = Combo_Resolution.ItemData(Combo_Resolution.ListIndex)
        
        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
    
            tpLastDispMode = lptpAdapterDispModes(l)
            Combo_RefreshRate.AddItem tpLastDispMode.RefreshRate & " Hz"
            Combo_RefreshRate.ItemData(Combo_RefreshRate.ListCount - 1) = l
            
            If tpDefaultDispMode.RefreshRate = lptpAdapterDispModes(l).RefreshRate Then lListIndex = Combo_RefreshRate.ListCount - 1

        End If

    Next l

    Combo_RefreshRate.ListIndex = lListIndex

End Sub
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
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26