monitors.frm

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

VERSION 5.00
Object = "{75D4F148-8785-11D3-93AD-0000832EF44D}#3.1#0"; "FAST2003.ocx"
Begin VB.Form frmMonitors 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "FWMonitors Control Demo"
   ClientHeight    =   4050
   ClientLeft      =   3720
   ClientTop       =   3435
   ClientWidth     =   6240
   Icon            =   "Monitors.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4050
   ScaleWidth      =   6240
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox txtInformation 
      BackColor       =   &H8000000F&
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2580
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   13
      Top             =   105
      Width           =   3015
   End
   Begin VB.ListBox lstMonitors 
      Height          =   840
      ItemData        =   "Monitors.frx":000C
      Left            =   3510
      List            =   "Monitors.frx":0013
      TabIndex        =   8
      Top             =   1590
      Width           =   2595
   End
   Begin VB.CommandButton cmdRefresh 
      Caption         =   "Refresh"
      Height          =   495
      Left            =   4935
      TabIndex        =   7
      Top             =   720
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Height          =   1275
      Left            =   120
      TabIndex        =   1
      Top             =   2700
      Width           =   6015
      Begin VB.OptionButton optDefNear 
         Caption         =   "If no monitor at XY, return nearest monitor"
         Height          =   195
         Left            =   2520
         TabIndex        =   12
         Top             =   840
         Width           =   3255
      End
      Begin VB.OptionButton optDefPri 
         Caption         =   "If no monitor at XY, return primary monitor"
         Height          =   195
         Left            =   2520
         TabIndex        =   11
         Top             =   540
         Width           =   3255
      End
      Begin VB.OptionButton optDefNone 
         Caption         =   "Return None if no monitor at XY"
         Height          =   195
         Left            =   2520
         TabIndex        =   10
         Top             =   240
         Value           =   -1  'True
         Width           =   2835
      End
      Begin VB.CommandButton cmdMonFromPoint 
         Caption         =   "Get Monitor from Point"
         Height          =   495
         Left            =   150
         TabIndex        =   4
         Top             =   240
         Width           =   2175
      End
      Begin VB.TextBox txtX 
         Height          =   285
         Left            =   420
         MaxLength       =   5
         TabIndex        =   3
         Text            =   "1"
         Top             =   810
         Width           =   675
      End
      Begin VB.TextBox txtY 
         Height          =   285
         Left            =   1650
         MaxLength       =   5
         TabIndex        =   2
         Text            =   "1"
         Top             =   810
         Width           =   675
      End
      Begin VB.Label Label1 
         Caption         =   "X:"
         Height          =   195
         Left            =   180
         TabIndex        =   6
         Top             =   870
         Width           =   195
      End
      Begin VB.Label Label2 
         Caption         =   "Y:"
         Height          =   195
         Left            =   1410
         TabIndex        =   5
         Top             =   870
         Width           =   195
      End
   End
   Begin VB.CommandButton cmdCenter 
      Caption         =   "Center this Form on the Current Monitor"
      Height          =   495
      Left            =   4380
      TabIndex        =   0
      Top             =   45
      Width           =   1800
   End
   Begin FLWSystem.FWMonitors objMonitors 
      Left            =   3765
      Top             =   435
      _ExtentX        =   767
      _ExtentY        =   741
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   3930
      Picture         =   "Monitors.frx":0024
      Top             =   600
      Width           =   480
   End
   Begin VB.Label Label3 
      Caption         =   "Monitor Handles:"
      Height          =   255
      Left            =   3510
      TabIndex        =   9
      Top             =   1320
      Width           =   1275
   End
End
Attribute VB_Name = "frmMonitors"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
  cmdRefresh.Value = True
End Sub

Private Sub cmdCenter_Click()
  Call objMonitors.CenterOnMonitor(Me)
End Sub

Private Sub cmdRefresh_Click()
  Dim objMonitor As FLWSystem.IFWMonitor
  Dim lngMonitor As Long
  Dim lngInd     As Long
  
  Call objMonitors.Refresh
  
  With objMonitors
    txtInformation = IIf(.Count = 1, _
                        "Only one monitor in use", _
                        .Count & " monitors in use") & vbCrLf & _
                     vbCrLf & _
                     "Virtual Size" & vbCrLf & _
                     "  Left  : " & .DesktopLeft & vbCrLf & _
                     "  Top   : " & .DesktopTop & vbCrLf & _
                     "  Width : " & .DesktopWidth & vbCrLf & _
                     "  Height: " & .DesktopHeight & vbCrLf
  End With
  
  lngMonitor = objMonitors.GetFromWindow(Me.hWnd, FLWSystem.flwGetMonitorNull)
  If lngMonitor < 1 Then
    lngMonitor = 1
  End If
  Set objMonitor = objMonitors.Item(lngMonitor)
  With objMonitor
    txtInformation = txtInformation & vbCrLf & _
                     "'My monitor' information" & vbCrLf & _
                     "  Left  : " & .Left & vbCrLf & _
                     "  Top   : " & .Top & vbCrLf & _
                     "  Right : " & .Right & vbCrLf & _
                     "  Bottom: " & .Bottom & vbCrLf & _
                     "  Width : " & .Width & vbCrLf & _
                     "  Height: " & .Height
  End With
  
  Call lstMonitors.Clear
  For Each objMonitor In objMonitors
    lngInd = lngInd + 1
    lstMonitors.AddItem "Monitor " & lngInd
  Next
End Sub

Private Sub lstMonitors_DblClick()
  Dim lReturn    As Long
  Dim objMonitor As FLWSystem.IFWMonitor
  
  For Each objMonitor In objMonitors
    With objMonitor
      If .Handle = lstMonitors.List(lstMonitors.ListIndex) Then
        MsgBox "Left: " & .Left & vbCrLf & _
               "Top: " & .Top & vbCrLf & _
               "Right: " & .Right & vbCrLf & _
               "Bottom: " & .Bottom & vbCrLf & _
               "Width: " & .Width & vbCrLf & _
               "Height: " & .Height, vbInformation
        Exit Sub
      End If
    End With
  Next
End Sub

Private Sub cmdMonFromPoint_Click()
  Dim lReturn As Long
    
  Select Case True
    Case optDefNone
      lReturn = objMonitors.GetFromXYPoint(Val(txtX.Text), Val(txtY.Text), FLWSystem.flwGetMonitorNull)
    Case optDefPri
      lReturn = objMonitors.GetFromXYPoint(Val(txtX.Text), Val(txtY.Text), FLWSystem.flwGetMonitorPrimary)
    Case optDefNear
      lReturn = objMonitors.GetFromXYPoint(Val(txtX.Text), Val(txtY.Text), FLWSystem.flwGetMonitorNearest)
  End Select
    
  Select Case lReturn
    Case -1
      MsgBox "Non-Multimonitor OS, only one monitor, and it does not have a handle.", vbInformation
    Case 0
      MsgBox "There is no monitor at those coordinates.", vbInformation
    Case Else
      MsgBox "Monitor " & lReturn & " is at those coordinates.", vbInformation
  End Select
End Sub