Question

VB中如何实现定时启动某一程序

需要定时改变屏幕的分辨率，已经找到了如何更改分辨率的VB代码
我想定时的执行代码，让显示器分辨率在800*600和1024*768之间转换
请问要如何实现？
代码如下
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 Form_Load()
On Error Resume Next
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 = 1024
DevM.dmPelsHeight = 768
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
End Sub

Answer 1

（1）在窗体上加一个时钟控件（外形象机械钟表），选住它，在属性里设置Interval属性值为100（意义是每隔100毫秒执行一次程序，你可以根据你的要求设置），并设置Eable属性为True。
（2）双击时钟控件，填入代码：
Timer1.Interval = 100 '和你设置的那个必须一样
call myfun 'myfun是个函数，定义如下面

（3）定义myfun函数
Public Function myfun()

On Error Resume Next
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 = 1024
DevM.dmPelsHeight = 768
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 Function

（4）删除多余代码
删除掉你的Private Sub Form_Load() 段代码，
即下面这段：
Private Sub Form_Load()
On Error Resume Next
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 = 1024
DevM.dmPelsHeight = 768
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
End Sub

我在VB6.0下通过测试了，只是只能由600*800到768*1024的转化，反过来不行

Answer 2

这个基本不清楚。。太复杂了。

Answer 3

既然是定时，加一个TIMER控件应该能解决问题吧。