disp.frm

用VB写的用于分辨率设置的程序,仅供学习用

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "纵横网络维护工具 之 分辨率设置"
   ClientHeight    =   3240
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6240
   Icon            =   "Disp.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3240
   ScaleWidth      =   6240
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Caption         =   "分辨率"
      ForeColor       =   &H00FF0000&
      Height          =   1575
      Left            =   120
      TabIndex        =   2
      Top             =   240
      Width           =   4095
      Begin VB.OptionButton Option4 
         Caption         =   "1024*768　32位"
         Height          =   495
         Left            =   2160
         TabIndex        =   6
         Top             =   840
         Width           =   1815
      End
      Begin VB.OptionButton Option3 
         Caption         =   "1024*768　16位"
         Height          =   495
         Left            =   360
         TabIndex        =   5
         Top             =   840
         Width           =   1575
      End
      Begin VB.OptionButton Option2 
         Caption         =   "800*600　32位"
         Height          =   300
         Left            =   2160
         TabIndex        =   4
         Top             =   480
         Width           =   1815
      End
      Begin VB.OptionButton Option1 
         Caption         =   "800*600  16位"
         Height          =   255
         Left            =   360
         TabIndex        =   3
         Top             =   480
         Width           =   1695
      End
   End
   Begin VB.CommandButton Command2 
      BackColor       =   &H8000000D&
      Caption         =   "退出[&E]"
      Height          =   495
      Left            =   4440
      TabIndex        =   1
      Top             =   960
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "设置[&C]"
      Height          =   495
      Left            =   4440
      TabIndex        =   0
      Top             =   360
      Width           =   1455
   End
   Begin VB.Line Line1 
      Index           =   1
      X1              =   0
      X2              =   7080
      Y1              =   0
      Y2              =   0
   End
   Begin VB.Label Label5 
      Caption         =   "电话  [phone]"
      ForeColor       =   &H00FF00FF&
      Height          =   255
      Left            =   1440
      TabIndex        =   10
      Top             =   2880
      Width           =   1695
   End
   Begin VB.Label Label4 
      Caption         =   "Q  Q  213875"
      ForeColor       =   &H00FF00FF&
      Height          =   255
      Left            =   1440
      TabIndex        =   9
      Top             =   2640
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "联系方式："
      ForeColor       =   &H00FF00FF&
      Height          =   255
      Left            =   480
      TabIndex        =   8
      Top             =   2640
      Width           =   2655
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   $"Disp.frx":12A7
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   120
      TabIndex        =   7
      Top             =   2160
      Width           =   4215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long

Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Const PLANES = 14
Const BITSPIXEL = 12

Private Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Sub Command1_Click()
 Dim ret As Long
  
 If Option1.Value = True Then
     ret = SetDisplayMode(800, 600, 16)
 ElseIf Option2.Value = True Then
    ret = SetDisplayMode(800, 600, 32)
 ElseIf Option3.Value = True Then
    ret = SetDisplayMode(1024, 768, 16)
 ElseIf Option4.Value = True Then
    ret = SetDisplayMode(1024, 768, 32)
 End If
End Sub

Private Sub Command2_Click()
 Unload Me
End Sub

Private Sub Form_Load()
 Dim OldWidth As Integer, OldHeight As Integer, OldColor As Integer
 
 Me.Left = (Screen.Width - Me.Width) / 2
 Me.Top = (Screen.Height - Me.Height) / 2
    
 OldWidth = Screen.Width \ Screen.TwipsPerPixelX
 OldHeight = Screen.Height \ Screen.TwipsPerPixelY
 OldColor = GetDeviceCaps(hdc, PLANES) * GetDeviceCaps(hdc, BITSPIXEL)
    
 If OldWidth = 800 And OldColor = 16 Then
   Option1.Value = True
 ElseIf OldWidth = 800 And OldColor = 32 Then
   Option2.Value = True
 ElseIf OldWidth = 1024 And OldColor = 16 Then
   Option3.Value = True
 ElseIf OldWidth = 1024 And OldColor = 32 Then
   Option4.Value = True
 End If
End Sub