home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / room3d / fdrivers.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-02-23  |  9.0 KB  |  270 lines
  1. VERSION 5.00
  2. Begin VB.Form fDrivers 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00000000&
  5.    BorderStyle     =   0  'None
  6.    ClientHeight    =   4500
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   6000
  10.    LinkTopic       =   "Form1"
  11.    Moveable        =   0   'False
  12.    Picture         =   "fDrivers.frx":0000
  13.    ScaleHeight     =   300
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   400
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.ListBox lstDrv 
  19.       BackColor       =   &H80000006&
  20.       ForeColor       =   &H0000FF00&
  21.       Height          =   2595
  22.       Left            =   240
  23.       TabIndex        =   5
  24.       Top             =   840
  25.       Width           =   5535
  26.    End
  27.    Begin VB.Label lblCancel 
  28.       BackStyle       =   0  'Transparent
  29.       Height          =   495
  30.       Left            =   240
  31.       TabIndex        =   4
  32.       Top             =   3720
  33.       Width           =   2655
  34.    End
  35.    Begin VB.Label lblAccept 
  36.       BackStyle       =   0  'Transparent
  37.       Height          =   495
  38.       Left            =   3120
  39.       TabIndex        =   3
  40.       Top             =   3720
  41.       Width           =   2655
  42.    End
  43.    Begin VB.Shape shpBorder 
  44.       BorderColor     =   &H00808080&
  45.       Height          =   495
  46.       Index           =   2
  47.       Left            =   3120
  48.       Top             =   3720
  49.       Width           =   2655
  50.    End
  51.    Begin VB.Shape shpBorder 
  52.       BorderColor     =   &H00808080&
  53.       Height          =   495
  54.       Index           =   3
  55.       Left            =   240
  56.       Top             =   3720
  57.       Width           =   2655
  58.    End
  59.    Begin VB.Shape shpBorder 
  60.       BorderColor     =   &H00808080&
  61.       Height          =   495
  62.       Index           =   1
  63.       Left            =   240
  64.       Top             =   240
  65.       Width           =   5535
  66.    End
  67.    Begin VB.Label lblTitle 
  68.       Appearance      =   0  'Flat
  69.       BackColor       =   &H80000005&
  70.       BackStyle       =   0  'Transparent
  71.       Caption         =   "Select Direct3D driver"
  72.       BeginProperty Font 
  73.          Name            =   "Arial"
  74.          Size            =   12
  75.          Charset         =   0
  76.          Weight          =   700
  77.          Underline       =   0   'False
  78.          Italic          =   0   'False
  79.          Strikethrough   =   0   'False
  80.       EndProperty
  81.       ForeColor       =   &H00C0C0C0&
  82.       Height          =   240
  83.       Index           =   10
  84.       Left            =   360
  85.       TabIndex        =   2
  86.       Top             =   360
  87.       Width           =   5280
  88.    End
  89.    Begin VB.Label lblCaptionAccept 
  90.       Alignment       =   2  'Center
  91.       BackStyle       =   0  'Transparent
  92.       Caption         =   "Accept"
  93.       BeginProperty Font 
  94.          Name            =   "Arial"
  95.          Size            =   12
  96.          Charset         =   0
  97.          Weight          =   700
  98.          Underline       =   0   'False
  99.          Italic          =   0   'False
  100.          Strikethrough   =   0   'False
  101.       EndProperty
  102.       ForeColor       =   &H00C0C0C0&
  103.       Height          =   255
  104.       Left            =   3120
  105.       TabIndex        =   1
  106.       Top             =   3840
  107.       Width           =   2655
  108.    End
  109.    Begin VB.Label lblCaptionCancel 
  110.       Alignment       =   2  'Center
  111.       BackStyle       =   0  'Transparent
  112.       Caption         =   "Cancel"
  113.       BeginProperty Font 
  114.          Name            =   "Arial"
  115.          Size            =   12
  116.          Charset         =   0
  117.          Weight          =   700
  118.          Underline       =   0   'False
  119.          Italic          =   0   'False
  120.          Strikethrough   =   0   'False
  121.       EndProperty
  122.       ForeColor       =   &H00C0C0C0&
  123.       Height          =   255
  124.       Left            =   240
  125.       TabIndex        =   0
  126.       Top             =   3840
  127.       Width           =   2655
  128.    End
  129. Attribute VB_Name = "fDrivers"
  130. Attribute VB_GlobalNameSpace = False
  131. Attribute VB_Creatable = False
  132. Attribute VB_PredeclaredId = True
  133. Attribute VB_Exposed = False
  134. Option Explicit
  135. ' Color constants for display of selection ...
  136.     Private Const RGBHighLight = 12640480   ' Highlight for mouse hover
  137.     Private Const RGBStandard = 12632256    ' Default gray
  138.     Private Const RGBSelected = 12648447    ' Highlight for selected items
  139. ' Enumeration for possible highlights
  140.     Private Enum eHighlights
  141.         eHighlightNone = -1
  142.         eHighlightDriver = 0
  143.         eHighlightAccept = 2
  144.         eHighlightCancel = 1
  145.     End Enum
  146. ' DirectX instance variables...
  147.     Private I_oDDInstance As IDirectDraw2                ' Instance of DirectDraw interface
  148.     Private I_oD3DInstance As IDirect3D2                 ' Instance of Direct3DIM interface
  149. ' Local copies of form properties...
  150.     Private I_bStatus As Boolean                         ' Contains error status
  151. ' STATUS: Tells if driver detection succeeded
  152. Public Property Get Status() As Boolean
  153.     Status = I_bStatus
  154. End Property
  155. ' FORMLOAD: Query Direct3D for drivers, set labels
  156. Private Sub Form_Load()
  157.     ' Setup local variables ...
  158.         
  159.         Dim L_nRun As Integer
  160.     ' Detect drivers ...
  161.             
  162.         ' Create instance of DirectDraw
  163.         DirectDrawCreate ByVal 0&, I_oDDInstance, Nothing
  164.         
  165.         ' Check instance existance, terminate if missing
  166.         If I_oDDInstance Is Nothing Then
  167.            I_bStatus = False
  168.            Me.Hide
  169.            Exit Sub
  170.         End If
  171.         
  172.         ' Query DirectDraw for D3D interface
  173.         Set I_oD3DInstance = I_oDDInstance
  174.         ' Check instance existance, terminate if missing
  175.         If I_oDDInstance Is Nothing Then
  176.            I_bStatus = False
  177.            Me.Hide
  178.            Exit Sub
  179.         End If
  180.         ' Set error handler to local for enumeration only
  181.         On Error Resume Next
  182.         
  183.         ' Start the callback that does the driver enumeration
  184.         G_nD3DDriverCount = -1
  185.         I_oD3DInstance.EnumDevices AddressOf EnumDeviceCallback, 0
  186.         ' Catch any error resulting from the enumeration and terminate
  187.         If err.Number > 0 Then
  188.            I_bStatus = False
  189.            Me.Hide
  190.            Exit Sub
  191.         End If
  192.         ' Reset error handler to default
  193.         On Error GoTo 0
  194.         
  195.         ' Check if any drivers found
  196.         If G_nD3DDriverCount = -1 Then
  197.            I_bStatus = False
  198.            Me.Hide
  199.            Exit Sub
  200.         End If
  201.             
  202.         ' Remember selected driver, initially the first one
  203.         G_dD3DSelectedDriver = G_dD3DDriver(0)
  204.         I_bStatus = True
  205.         
  206.         ' Cleanup DirectX
  207.         Set I_oD3DInstance = Nothing
  208.         Set I_oDDInstance = Nothing
  209.         
  210.     ' Write drivers into labels ...
  211.         
  212.         For L_nRun = 0 To 9
  213.             If L_nRun <= G_nD3DDriverCount Then
  214.                 lstDrv.AddItem G_dD3DDriver(L_nRun).DESC
  215.             End If
  216.         Next
  217.     If lstDrv.ListCount > 0 Then lstDrv.ListIndex = (lstDrv.ListCount - 1)
  218.     If lstDrv.ListCount > 1 Then lstDrv.ListIndex = (lstDrv.ListCount - 2)
  219. End Sub
  220. ' LBLACCEPT_CLICK: Accept selected driver and close dialog
  221. Private Sub lblAccept_Click()
  222.     lstDrv.SetFocus
  223.     G_dD3DSelectedDriver = G_dD3DDriver(lstDrv.ListIndex)
  224.     ' Show click on label
  225.     Me.lblAccept.ForeColor = RGBSelected
  226.     ' Close form
  227.     Me.Hide
  228.     Call AppStart
  229.         
  230. End Sub
  231. ' LBLCANCEL_CLICL: Close form and return cancelled
  232. Private Sub lblCancel_Click()
  233.     ' Show click on label
  234.     Me.lblCancel.ForeColor = RGBSelected
  235.     ' Set cancel status
  236.     I_bStatus = False
  237.     ' Close form
  238.     Me.Hide
  239.     End
  240. End Sub
  241. Private Sub lblTitle_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  242.     Call SetHighlights(eHighlightNone)
  243. End Sub
  244. Private Sub lblCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  245.     Call SetHighlights(eHighlightCancel)
  246. End Sub
  247. Private Sub lblAccept_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  248.     Call SetHighlights(eHighlightAccept)
  249. End Sub
  250. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  251.     Call SetHighlights(eHighlightNone)
  252. End Sub
  253. ' SETHIGHLIGHTS: Sets the highlight for mouse hover element and removes all other highlights
  254. Private Sub SetHighlights(Optional ByVal nElement As Variant, Optional ByVal nIndex As Variant)
  255.     ' Setup local variables ...
  256.         Dim L_nRunIndex As Integer  ' Variable to run through driver labels
  257.         
  258.     ' Set highlights ...
  259.         
  260.         ' Set label highlights
  261.         
  262.         If IsMissing(nIndex) Then nIndex = -1
  263.         ' Set button highlights
  264.         Me.lblCaptionAccept.ForeColor = IIf(nElement = 2, RGBHighLight, RGBStandard)
  265.         Me.lblCaptionCancel.ForeColor = IIf(nElement = 1, RGBHighLight, RGBStandard)
  266. End Sub
  267. Private Sub lstDrv_Click()
  268.     G_dD3DSelectedDriver = G_dD3DDriver(lstDrv.ListIndex)
  269. End Sub
  270.