189 8069 5689
您可以用下面给出这一小段代码检测当前屏幕分辨率，然后根据结果作出反应──例如，重新调整窗体大小以适应用程序户分辨率。
创新互联公司是一家专业提供犍为企业网站建设,专注与做网站、网站制作、成都h5网站建设、小程序制作等业务。10年已为犍为众多企业、政府机构等服务。创新互联专业网络公司优惠进行中。
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 Function
Next, 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
Public Class Form1
Dim 初始化控件自动大小调整与窗口的宽度比例 As Integer
Dim 初始化控件自动大小调整与窗口的高度比例 As Integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
初始化控件自动大小调整与窗口的宽度比例 = Me.Width / 控件自动大小调整.Width
初始化控件自动大小调整与窗口的高度比例 = Me.Height / 控件自动大小调整.Height
显示控件的位置坐标()
End Sub
Private Sub Form1_ResizeEnd(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.ResizeEnd
' Form1_ResizeEnd 这个事件是 窗口大小变化完成后 再进行操作的
控件自动大小调整.Location = New Point(控件自动大小调整.Left, 控件自动大小调整.Top)
'设置控件的初始左位置坐标 与 上位置坐标
控件自动大小调整.Size = New Point(Int(Me.Width / 初始化控件自动大小调整与窗口的宽度比例), Int(Me.Height / 初始化控件自动大小调整与窗口的高度比例))
'更改控件的大小 按第一次窗口的比例 进行调整
显示控件的位置坐标()
End Sub
Private Sub 显示控件的位置坐标()
Label1.Text = "控件的上边距坐标： " 控件自动大小调整.Top
Label2.Text = "控件的左边距坐标： " 控件自动大小调整.Left
Label3.Text = "控件的宽度大小： " 控件自动大小调整.Width
Label4.Text = "控件的高度大小： " 控件自动大小调整.Height
End Sub
End Class
设计与分辨率无关的窗体
缺省情况下，当改变屏幕分辨率时，Microsoft Visual Basic 不会改变窗体与控件的尺寸。这就意味着在分辨率为 1024 X 768 的屏幕上设计的窗体，在分辨率为 640 X 480 的屏幕中运行时会伸出屏幕的边界之外。如果想创建不管使用什么样的屏幕分辨率都能有相同比例的窗体和控件，必须在最低的分辨率下设计窗体，或者将改变窗体的代码添加到程序中去。
避免尺寸问题的最简单的方法是在 640 X 480 的分辨率下设计窗体。如果更喜欢在高一些的分辨率下工作，仍需要考虑窗体在低一些的分辨率下将如何显示。实现这一点的方法是用“Form Layout”窗口预览窗体的大小和位置。您也可以使用“Resolution Guides”观察在低分辨率时屏幕的哪些部分是可见的。要切换到“Resolution Guides”，可以在“Form Layout”窗口单击鼠标右键，从弹出菜单上选择“Resolution Guides”菜单项。
在运行时，Visual Basic 根据设计时的位置来放置窗体。如果设计时在 1024 X 768 的分辨率上运行，并把窗体放到屏幕的右下角，则当它在比较低的分辨率下运行时该窗体可能看不见。为了避免这种情况的发生，在设计时可从“Form Layout”窗口的弹出菜单选择“Startup Position”菜单项来设置窗体的启动位置。同样，您也可以在运行时用下面的 Form Load 事件中的代码来设置窗体的位置：
Private Sub Form_Load()
Me.Move Screen.Width - Width , 0
End Sub
'下面代码除字体外，基本能自动适应不同分辨率了：
Option Explicit
Dim MeWidth As Long
Dim MeHeight As Long
Private Type ctr
Width As Long
Height As Long
Left As Long
Top As Long
End Type
Dim myctr() As ctr
Private Sub Form_Load()
Dim i As Long, kx As Single, ky As Single
MeWidth = Me.ScaleWidth
MeHeight = Me.ScaleHeight
ScaleHeight = 1000 ' 设置高度的单位值。
ScaleWidth = 1000 ' 设置宽度的单位值。
ReDim myctr(Controls.Count)
'把每个控件的属性存入自定义类型数组
For i = 0 To Controls.Count - 1
myctr(i).Width = Controls(i).Width
myctr(i).Height = Controls(i).Height
myctr(i).Left = Controls(i).Left
myctr(i).Top = Controls(i).Top
Next
kx = Screen.Width / 1024 / 15
ky = Screen.Height / 768 / 15
Width = Width * kx
Height = Height * ky
Move Screen.Width - Width , 0
End Sub
Private Sub Form_Resize()
Dim i As Long
Dim MyControl As Control
ScaleHeight = 1000 ' 设置高度的单位值。
ScaleWidth = 1000 ' 设置宽度的单位值。
'把自定义类型数组存入每个控件的属性
For i = 0 To Controls.Count - 1
Controls(i).Width = myctr(i).Width
Controls(i).Height = myctr(i).Height
Controls(i).Left = myctr(i).Left
Controls(i).Top = myctr(i).Top
Next
End Sub
'注意代码中以下2行：
'kx = Screen.Width / 1024 / 15
'ky = Screen.Height / 768 / 15
'其中的1024 和768 表示在窗体设置时的屏幕分辨率，如在其他分辨率设置时可取相应值
默认单位是像素
96是系统的一种设定，每英寸的点数，是系统界面用小字体时的设置
用像素数除以dpi没有意义
这篇文章介绍了VB.NET设置屏幕分辨率、颜色位数、刷新率
实例代码，有需要的朋友可以参考一下
复制代码
代码如下:
Private
Declare
Function
GetDeviceCaps
Lib
"gdi32"
(ByVal
hdc
As
Long,
ByVal
nIndex
As
Long)
As
Long
Private
Declare
Function
ChangeDisplaySettings
Lib
"user32"
Alias
"ChangeDisplaySettingsA"
(lpDevMode
As
Any,
ByVal
dwflags
As
Long)
As
Long
Private
Const
CCDEVICENAME
As
Long
=
32
Private
Const
CCFORMNAME
As
Long
=
32
Private
Const
DM_BITSPERPEL
As
Long
=
H40000
Private
Const
DM_PELSWIDTH
As
Long
=
H80000
Private
Const
DM_PELSHEIGHT
As
Long
=
H100000
Private
Const
DM_DISPLAYFLAGS
As
Long
=
H200000
Private
Const
DM_DISPLAYFREQUENCY
=
H400000
Private
Const
CDS_FORCE
As
Long
=
H80000000
Private
Const
BITSPIXEL
As
Long
=
12
Private
Const
HORZRES
As
Long
=
8
Private
Const
VERTRES
As
Long
=
10
Private
Const
VREFRESH
=
116
Private
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
Sub
cmdChangeDesktopMode_Click()
Dim
DM
As
DEVMODE
With
DM
.dmPelsWidth
=
CInt(txtNewWidth.Text)
.dmPelsHeight
=
CInt(txtNewHeight.Text)
.dmBitsPerPel
=
CInt(txtNewColor.Text)
.dmDisplayFrequency
=
CInt(txtNewFreq.Text)
.dmFields
=
DM_PELSWIDTH
Or
DM_PELSHEIGHT
Or
DM_BITSPERPEL
Or
DM_DISPLAYFREQUENCY
.dmSize
=
LenB(DM)
End
With
If
ChangeDisplaySettings(DM,
CDS_FORCE)
Then
MsgBox
"错误!不支持此模式！"
End
If
End
Sub
Private
Sub
Form_Load()
txtOldWidth.Text
=
GetDeviceCaps(Me.hdc,
HORZRES)
txtOldHeight.Text
=
GetDeviceCaps(Me.hdc,
VERTRES)
txtOldColor.Text
=
GetDeviceCaps(Me.hdc,
BITSPIXEL)
txtOldFreq.Text
=
GetDeviceCaps(Me.hdc,
VREFRESH)
End
Sub
保存前加一句 myImage2.SetResolution(300, 300) 你设置的bMape不是保存的主画布 所以无效，设置分辨率就是 SetResolution（X,Y）