VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 用VB设计更换屏幕保护的程序
发表评论(0)作者:杜运庆, 平台:VB6.0+Win98, 阅读:16177, 日期:2004-10-28
  制作一个本企业的屏幕保护,在客户运行本企业的应用软件的时候,为客户更改屏幕保护,是个广告宣传的好办法。在VBGood论坛(http://www.vbgood.com)上有很多朋友提出这个问题,现解答如下:

  要更换屏幕保护,首先得做好一个屏幕保护(scr文件),本例以 工程1.scr 这个文件为例。由于windows是把屏幕保护文件存放在system下,但记录屏幕保护文件位置的文件却是windows目录下的system.ini,所以,首先需要找出系统的windows和system目录的确切安装位置。因此,可以分如下几步进行:

  1、找到windows和system目录的安装位置

  2、把屏幕保护文件复制到system目录下

  3、在system.ini中的[boot]中写入:

    SCRNSAVE.EXE=C:\WINDOWS\SYSTEM\工程1.SCR

  4、告诉系统切换屏幕保护。

 下面的例子成功地改变了屏幕保护,全部源代码如下:

注释:得到windows目录

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

注释:修改system.ini
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long

注释:得到system目录
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

注释:设置屏幕保护
Private Const SPI_SETSCREENSAVETIMEOUT = 15
Private Const SPI_SETSCREENSAVEACTIVE = 17
Private Const SPIF_UPDATEINIFILE = &H1
Private Const SPIF_SENDWININICHANGE = &H2

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Long, ByVal fuWinIni As Long) As Long

注释:启动屏幕保护
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_SYSCOMMAND = &H112
Private Const SC_SCREENSAVE = &HF140

Private Sub Form_Load()
 注释:得到system目录
 Dim sSave As String, Ret As Long
 sSave = Space(255)
 Ret = GetSystemDirectory(sSave, 255)
 sSave = Left$(sSave, Ret)
 注释:把屏保复制到系统目录
 FileCopy App.Path & "\工程1.scr", sSave & "\工程1.SCR"
 注释:得到windows目录
 Dim Path As String, strSave As String
 strSave = String(250, Chr$(0))
 Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave)))
 注释:修改system.ini
 Dim r As Long
 Dim iniPath As String
 iniPath$ = Path + "\system.ini"
 r = WritePrivateProfileString("boot", "SCRNSAVE.EXE", sSave & "\工程1.SCR", iniPath)
 注释:设置时间间隔为1分钟=60秒
 lRet = SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT, 60, ByVal 0&,  
     SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE)
 注释:设置屏幕保护
 retval = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, True, 0, 0)
 注释:启动屏幕保护
 Dim result As Long
result = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub

  本例在vb6.0+win95下运行通过。