form1.frm

大量优秀的vb编程

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form1 
   Caption         =   "设置屏幕分辨率"
   ClientHeight    =   2892
   ClientLeft      =   48
   ClientTop       =   336
   ClientWidth     =   5412
   LinkTopic       =   "Form1"
   ScaleHeight     =   2892
   ScaleWidth      =   5412
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "退出程序"
      Height          =   372
      Left            =   2760
      TabIndex        =   2
      Top             =   2400
      Width           =   1572
   End
   Begin ComctlLib.ListView lvSettings 
      Height          =   2172
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   5172
      _ExtentX        =   9123
      _ExtentY        =   3831
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   327682
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   3
      BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "宽度像素"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
         SubItemIndex    =   1
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "高度像素"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(3) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
         SubItemIndex    =   2
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "颜色"
         Object.Width           =   2540
      EndProperty
   End
   Begin VB.CommandButton cmdChange 
      Caption         =   "确定"
      Height          =   372
      Left            =   960
      TabIndex        =   0
      Top             =   2400
      Width           =   1572
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit



'----------------------------------------------------------
'Code for Subclassing
'----------------------------------------------------------
Private Sub Hook()
    lPreWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf MyWndProc)
End Sub

Private Sub Unhook()
    Call SetWindowLong(Me.hwnd, GWL_WNDPROC, lPreWndProc)
End Sub
    

'----------------------------------------------------------
'Code for display features
'----------------------------------------------------------
Private Sub Change()

    Dim utDevMode   As DevMode
    Dim iRes        As Long
    Dim sMsg        As String
    Dim oItem       As ListItem
    
    If lvSettings.SelectedItem Is Nothing Then Exit Sub
    
    Set oItem = lvSettings.SelectedItem
    With utDevMode
        .dmSize = Len(utDevMode)
        .dmPelsWidth = oItem.Text
        .dmBitsPerPel = oItem.SubItems(2)
        .dmPelsHeight = oItem.SubItems(1)
        .dmFields = DM_BITSPERPEL Or DM_PELSHEIGHT Or DM_PELSWIDTH
    End With
    
    iRes = ChangeDisplaySettings(utDevMode, CDS_UPDATEREGISTRY)

    Select Case iRes
        Case Is = DISP_CHANGE_SUCCESSFUL
            sMsg = "Display setting has been changed successfully."
        Case Is = DISP_CHANGE_RESTART
            sMsg = "You have to restart your computer in order to carry out the new setting."
        Case Is = DISP_CHANGE_FAILED
            sMsg = "Sorry, failed to change the display setting."
    End Select
    
    If sMsg <> vbNullString Then MsgBox sMsg, , "Display"
    
End Sub

Private Sub FillListBox()
    
    Dim utDevMode As DevMode, fEnd As Boolean
    Dim sDeviceName As String, iMode As Long
    Dim oItem As New ListItem
    
    utDevMode.dmSize = Len(utDevMode)
    iMode = 0
    
    Do
        fEnd = EnumDisplaySettings(sDeviceName, iMode, utDevMode)
'        oItem.Text = utDevMode.dmPelsWidth
        Set oItem = lvSettings.ListItems.Add(, "N" & Str(iMode), utDevMode.dmPelsWidth)
        oItem.SubItems(1) = utDevMode.dmPelsHeight
        oItem.SubItems(2) = utDevMode.dmBitsPerPel
'        lvSettings.ListItems.Add oItem
        iMode = iMode + 1
    Loop Until Not fEnd
    
End Sub


'----------------------------------------------------------
'Code of events
'----------------------------------------------------------
Private Sub cmdChange_Click()
    Change
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    FillListBox
'    Hook
End Sub

Private Sub Form_Unload(Cancel As Integer)
'    Unhook
End Sub