modes.frm

不错的一个VB菜单设计 界面和功能都不错

VERSION 5.00
Object = "*\A..\SOURCE\FAST2003.vbp"
Object = "*\A..\SOURCE\FAST2003.vbp"
Begin VB.Form frmVideo 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Video modes"
   ClientHeight    =   3750
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7890
   Icon            =   "Modes.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3750
   ScaleWidth      =   7890
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdChange 
      Caption         =   "Change"
      Height          =   420
      Left            =   1980
      TabIndex        =   2
      Top             =   3240
      Width           =   1680
   End
   Begin VB.CommandButton cmdTest 
      Caption         =   "Test video mode"
      Height          =   420
      Left            =   135
      TabIndex        =   1
      Top             =   3240
      Width           =   1680
   End
   Begin VB.ListBox lstModes 
      Height          =   2985
      Left            =   90
      TabIndex        =   0
      Top             =   90
      Width           =   3615
   End
   Begin FLWSystem.FWVideo objVideo 
      Left            =   7275
      Top             =   3165
      _ExtentX        =   820
      _ExtentY        =   820
   End
   Begin VB.Label lblInfo 
      Height          =   3570
      Left            =   3915
      TabIndex        =   3
      Top             =   90
      Width           =   3885
   End
End
Attribute VB_Name = "frmVideo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
  Dim objVideoMode As FLWSystem.IFWVideoMode
  
  Call MyRefresh
  
  For Each objVideoMode In objVideo.Modes
    Call lstModes.AddItem(objVideoMode.Name)
  Next
End Sub

Private Sub MyRefresh()
  With objVideo
    Call .Refresh
    lblInfo = "Active video mode information" & vbCrLf & _
              "Counts: " & vbCrLf & _
              "  " & .BrushCount & " Brushes" & vbCrLf & _
              "  " & .MarkerCount & " Markers" & vbCrLf & _
              "  " & .PenCount & " pens" & vbCrLf & _
              "  " & .ColorCount & " colors" & vbCrLf & _
              "  " & .ColorPlanes & " planes" & vbCrLf & _
              "  " & .FontCount & " Fonts" & vbCrLf & _
              "  " & .BitsPerPixel & " bits per pixel" & vbCrLf & _
              "Palette size " & .PaletteSize & vbCrLf & _
              "Real size " & .RealXPixels & "x" & .RealYPixels & vbCrLf & _
              "Aspect " & .XAspect & " " & .YAspect & " " & .XYAspect & vbCrLf & _
              "Pixels " & .XPixels & "x" & .YPixels & vbCrLf & _
              "Size   " & .XSize & "x" & .YSize
  End With
End Sub

Private Sub cmdChange_Click()
  Dim lngChange As FLWSystem.flwChangeModeResults
  
  If lstModes.ListIndex >= 0 Then
    lngChange = objVideo.Modes(lstModes.ListIndex + 1).Change
    Select Case lngChange
      Case FLWSystem.flwChangeModeSuccesful
        Call MsgBox("Video mode changed")
      Case FLWSystem.flwChangeModeMustRestart
        Call MsgBox("Video mode changed. You need restart the system")
      Case Else
        Call MsgBox("Video mode not changed")
    End Select
  End If
  Call MyRefresh
End Sub

Private Sub cmdTest_Click()
  Dim lngChange As FLWSystem.flwChangeModeResults
  
  If lstModes.ListIndex >= 0 Then
    lngChange = objVideo.Modes(lstModes.ListIndex + 1).Test
    Select Case lngChange
      Case FLWSystem.flwChangeModeSuccesful, FLWSystem.flwChangeModeMustRestart
        Call MsgBox("Video mode supported")
      Case Else
        Call MsgBox("Video mode not supported")
    End Select
  End If
  Call MyRefresh
End Sub