用VB设计更换屏幕保护的程序

来源:计算机等级考试    发布时间:2012-08-29    计算机等级考试视频    评论

  制作一个本企业的屏幕保护,在客户运行本企业的应用软件的时候,为客户更改屏幕保护,是个广告宣传的好办法。有很多朋友提出这个问题,现解答如下:

  要更换屏幕保护,首先得做好一个屏幕保护(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下运行通过。

视频学习

我考网版权与免责声明

① 凡本网注明稿件来源为"原创"的所有文字、图片和音视频稿件,版权均属本网所有。任何媒体、网站或个人转载、链接转贴或以其他方式复制发表时必须注明"稿件来源:我考网",违者本网将依法追究责任;

② 本网部分稿件来源于网络,任何单位或个人认为我考网发布的内容可能涉嫌侵犯其合法权益,应该及时向我考网书面反馈,并提供身份证明、权属证明及详细侵权情况证明,我考网在收到上述法律文件后,将会尽快移除被控侵权内容。

最近更新

社区交流

考试问答