引用 | 编辑
oway
2006-06-19 22:33 |
楼主
▼ |
||
![]() 希望对各位有用,如果各位觉得不错,烦请赏我一朵花好吗 下面的 Form 里面,只有一个 Label 及两个 Button 元件而已: Public Class Form1 Private Const CCDEVICENAME As Short = 32 Private Const CCFORMNAME As Short = 32 Private Const DM_PELSWIDTH As Integer = &H80000 Private Const DM_PELSHEIGHT As Integer = &H100000 '更新萤幕扫瞄频率常数 Private Const DM_DISPLAYFREQUENCY As Integer = &H400000 '宣告要使用的 API 函式 Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Integer, ByVal iModeNum As Integer, ByRef lpDevMode As DEVMODE) As Boolean '宣告要使用的 API 函式 Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByRef lpDevMode As DEVMODE, ByVal dwflags As Integer) As Integer '定义要使用的变数结构 Private Structure DEVMODE <VBFixedString(CCDEVICENAME), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=CCDEV .. 访客只能看到部份内容,免费 加入会员 ![]()
|
引用 | 编辑
chen9999
2006-06-19 23:47 |
1楼
▲ ▼ |
你确定是 "你自己写的" ?
Option Explicit Private Declare Function EnumDisplaySettings Lib "user32" Alias _ "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, _ ByVal iModeNum As Long, lpDevMode As Any) As Long Private 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 Long Const EWX_REBOOT = 2 ' 重开机 Const CCDEVICENAME = 32 Const CCFORMNAME = 32 Const DM_PELSWIDTH = &H80000 Const DM_PELSHEIGHT = &H100000 Const DISP_CHANGE_SUCCESSFUL = 0 Const DISP_CHANGE_RESTART = 1 Const CDS_UPDATEREGISTRY = 1 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 DevM As DEVMODE Private 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 变数名称都相同.......不太可能吧 我想我应该不用说出原文在那, 除非那个原文是你做的. ![]() |
引用 | 编辑
oway
2006-06-20 01:32 |
2楼
▲ ▼ |
下面是引用chen9999于2006-06-19 23:47发表的 :您贴的那一篇我在大陆网站也有看过,好多地方都有的, 我并没有说我是原创,我只是说我使用 VB.Net 2005 尝试写出来,将它分享出来而已, 这功能的教学资料在网路上许多地方都找的到的,如下面的网址都是: http://www.microsoft.com/china/community/Column/28.mspx http://www.aspxboy.com/private/260/default.aspx http://www.faq-it.org/archives/vb/97a324b65f66323708e93266830b0fcc.php 但那些都不是 VB.Net 2005 的范例,虽然语法差不多,但还是没有完全一样, 因此我分享的是我改成 2005 能用的版本。 补充: ChangeDisplaySettings() 是一个 API 而已,原创是微软,从 Win98 的时候就存在, VB 的用法较复杂,相较之下,BCB 的用法就简单多了,如下几行就可以达成了: DEVMODE DevM; 看来我还是不要贴 VB 的范例好了,因为网路上太好找了。 ![]() |
引用 | 编辑
jansonshie
2010-01-06 15:20 |
3楼
▲ ▼ |
但这都针对一个萤幕,哪如何变更第二台萤幕的解析度呢?
![]() |
引用 | 编辑
zsx123665
2013-05-15 12:45 |
5楼
▲ ▼ |
复制程式
Private Sub ChangeDisp(ByRef iWidth As Single, ByRef iHeight As Single) Dim blnWorked As Boolean Dim DevM As New DEVMODE blnWorked = EnumDisplaySettings(0, 0, DevM) With DevM .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_DISPLAYFREQUENCY .dmPelsWidth = iWidth .dmPelsHeight = iHeight '.dmDisplayFrequency = 75 '更新频率定为 75 End With Call ChangeDisplaySettings(DevM, 0) End Sub 改成:Dim DevM As New DEVMODE 避免发生 Null ![]() |