如何获取当前显示分辨率？

Question

请搜索一下以前的帖子这个可能对你有用
'******************************************************
'原作者：邓勇
'收集整理：小聪明 [email protected]
'欢迎访问小聪明的主页VB版： http://coolzm.533.net
'******************************************************
'功能:：窗体大小改变时窗体内的控件大小也随之动态改变
'使用方法：
'在相应的窗体程序中加入如下语句：
'---------------------------------------------------
'Private Sub Form_Load()
'  Call ResizeInit(Me) '在程序装入时必须加入
'End Sub'Private Sub Form_Resize()
'  Call ResizeForm(Me) '确保窗体改变时控件随之改变
'End Sub
'---------------------------------------------------
Option Explicit
Private FormOldWidth As Long '保存窗体的原始宽度
Private FormOldHeight As Long '保存窗体的原始高度
'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
  Dim Obj As Control
  FormOldWidth = FormName.ScaleWidth
  FormOldHeight = FormName.ScaleHeight
  On Error Resume Next
  For Each Obj In FormName
    Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
  Next Obj
  On Error GoTo 0
End Sub'按比例改变表单内各元件的大小，在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm(FormName As Form)
  Dim Pos(4) As Double
  Dim i As Long, TempPos As Long, StartPos As Long
  Dim Obj As Control
  Dim ScaleX As Double, ScaleY As Double
  ScaleX = FormName.ScaleWidth / FormOldWidth '保存窗体宽度缩放比例
  ScaleY = FormName.ScaleHeight / FormOldHeight '保存窗体高度缩放比例
  On Error Resume Next
  For Each Obj In FormName
    StartPos = 1
    For i = 0 To 4
    '读取控件的原始位置与大小
      TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
      If TempPos > 0 Then
        Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
        StartPos = TempPos + 1
      Else
        Pos(i) = 0
      End If
   '根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
      Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
    Next i
  Next Obj
  On Error GoTo 0
End Sub

Answer 1

确定屏幕分辨率
Submitted by Nicholas L. Otley, [email protected]; www.kalamazoo.co.uk
您可以用下面给出这一小段代码检测当前屏幕分辨率，然后根据结果作出反应──例如，重新调整窗体大小以适应用程序户分辨率。Public Function CheckRez(pixelWidth As Long, pixelHeight As Long) As Boolean
    '
    Dim lngTwipsX As Long
    Dim lngTwipsY As Long
    '
    ' convert pixels to twips
    lngTwipsX = pixelWidth * 15
    lngTwipsY = pixelHeight * 15
    '
    ' check against current settings
    If lngTwipsX <> Screen.Width Then
        CheckRez = False
    Else
        If lngTwipsY <> Screen.Height Then
            CheckRez = False
        Else
            CheckRez = True
        End If
    End If
    '
End FunctionNext, run the following code at the start of the program:    If CheckRez(640, 480) = False Then
        MsgBox "Incorrect screen size!"
    Else
        MsgBox "Screen Resolution Matches!"
    End If

Answer 2

Private Sub Command1_Click()
    '先判断用户的显示分辨率，根据不同的分辨率调整控件的位置、大小
    '显示分辨率 =
    Print Screen.Width / Screen.TwipsPerPixelX
    Print Screen.Height / Screen.TwipsPerPixelY
End Sub

Answer 3

一般情况下
分辨率改变后，窗体大小如何相应改变
这种做法好像很少用，大多是在程序执行的时候
把分辨率调整的合适的大小。
如何设定屏幕分辨率原始来源：??原则上，只改这一次，下一次开机会还原，但如果需重开机，才会Update
Registry中的设定，并重开机。
如果要永久设定其设定值，请将
b = ChangeDisplaySettings(DevM, 0) 改成
b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)Option Explicit
Private Declare Function EnumDisplaySettings Lib "user32" Alias _
   "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, _
   ByVal iModeNum As Long, lpDevMode As Any) As LongPrivate Declare Function ChangeDisplaySettings Lib "user32" Alias _
   "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
                 ByVal dwReserved As Long) As LongConst EWX_REBOOT = 2          ' 重开机
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000Const DISP_CHANGE_SUCCESSFUL = 0
Const DISP_CHANGE_RESTART = 1
Const CDS_UPDATEREGISTRY = 1Private Type DEVMODE
    dmDeviceName As String * CCDEVICENAME
    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 * CCFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type
Private DevM As DEVMODEPrivate Sub Command1_Click()
    Dim i As Long
    Dim b As Long
    Dim ans as Long
    Dim a As Long    a = EnumDisplaySettings(0, 0, DevM) 'Initial Setting    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    DevM.dmPelsWidth = 800   '设定成想要的分辨率
    DevM.dmPelsHeight = 600
    b = ChangeDisplaySettings(DevM, 0) 'Changed Only this time
    If b = DISP_CHANGE_RESTART Then
        ans = MsgBox("要重开机设定才能完成，重开？", vbOKCancel)
        If ans = 1 Then
           b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
           'after this , Will Update in Registry
           Call ExitWindowsEx(EWX_REBOOT, 0)
        End If
    Else
       If b <> DISP_CHANGE_SUCCESSFUL Then
          Call MsgBox("设定有误", vbCritical)
       End If
    End If
End Sub

Answer 4

一、
const screenMode=15Screenwidth=screen.width/screenMode
Screenwidth=screen.height/screenMode
text1.text="屏幕分辩率" & screenwidth & "*" screenheight 
二、
  可用 一个timer来控制，如果屏幕分辩率改变了，那窗体的width与height也相应的加上一定的长度就行了。

Answer 5

http://www.csdn.net/expert/topic/557/557458.xml?temp=.5311853
主　　题：  关于分辨率的问题 这样的问题在前面的帖子子里很多了 请按搜索 输入  分辨率  按 回车 就 可以搜到一大堆和你差不多的问题

Answer 6

取得屏幕分辨率 
  x = Screen.Width \ Screen.TwipsPerPixelX
  y = Screen.Height \ Screen.TwipsPerPixelY 

Answer 7

http://www.csdn.net/expert/topic/553/553529.xml?temp=.4698145