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	cvsrabit	1.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