HOW TO: Create A Screen Saver in Microsoft Visual Basic 6.0 (818365)


The information in this article applies to:

  • Microsoft Visual Basic Enterprise Edition for Windows 6.0
  • Microsoft Visual Basic Professional Edition for Windows 6.0
  • Microsoft Visual Basic Learning Edition for Windows 6.0

IN THIS TASK

SUMMARY

This step-by-step article describes how to create a Microsoft Windows screen saver by using Microsoft Visual Basic 6.0.

back to the top

Step-by-Step Example

  1. Start Visual Basic 6.0.
  2. On the File menu, click New Project.
  3. On the New Project dialog box, click Standard EXE, and then click OK.

    By default, Form1 is created.
  4. Set the following properties of Form1:

    Name: frmScr
    ControlBox: False
    BorderStyle: None
    BackColor: &H00000000&
    ShowInTaskBar: False
  5. On the Project menu, click Project1 Properties.
  6. Click the General tab of the Project1 - Project Properties dialog box.
  7. Name the project MyScreenSaver, click to select Sub Main in the Startup Object drop-down list box, and then click OK.
  8. In the toolbox, double-click the Label control.

    By default, Label1 is added to the form.
  9. Set the following properties of Label1:

    Name: lblMessage
    Caption: Screen Saver Example
    BackColor: &H00000000&
    ForeColor: &H0000C0C0&
  10. In the toolbox, double-click the Timer control.

    Timer1 is added to the form.
  11. Set the Interval property of the Timer1 control to 10.
  12. In Project Explorer, right-click the frmScr form, and then click View Code.
  13. Paste the following code in the Code window:
    Option Explicit

Private Sub Command1_Click()
End Sub

Private Sub Form_Activate()

    'Center the lblMessage label to the form.
    lblMessage.Left = ScaleWidth
    lblMessage.Top = (ScaleHeight - lblMessage.Height) / 2
     
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

   'Immediately end when any key is pressed.
    Unload Me
    
End Sub

Private Sub Form_Load()

    'Make the screen saver a TOPMOST window (cover the taskbar, among other things).
    tmplng = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
    
    'Make the form exactly cover the screen.
    Move 0, 0, Screen.Width, Screen.Height
    
    'In Microsoft Windows 2000, screen savers that are not password-protected
    'start minimized. This will fix that:
    Me.WindowState = vbNormal
    
    'Determine whether you are running under Microsoft Windows NT-type systems (Windows NT, Windows 2000, Microsoft Windows XP, and others).
    GetOSVersion32
    
    'Tell the system that it is a screen saver application. This will
    'Disable the CTRL-ALT-DEL key combination on Microsoft Windows 95 and Microsoft Windows 98 systems.  Windows NT handles password-protected
    'screen savers at the system level, so the CTRL-ALT-DEL key combination cannot be
    'disabled.
    tmplng = SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1&, 0&, 0&)
    
    'Get the user's previous preference for the marquee message.
    
     ScrMsg = GetSetting("Samples", "Test Screen Saver", "Message", "Hello World")
     lblMessage.Caption = ScrMsg

    'Make the cursor disappear.
    Do
    Loop Until ShowCursor(False) < -5
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    'Immediately end on any mouse button that is being pressed.
    Unload Me

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Static nTimeDelay&
    nMouseMoves = nMouseMoves + 1
    
    'There will probably be one or two MouseMove events at
    'startup that must be ignored.
    'Change the value for more or less mouse sensitivity.
    
    If nMouseMoves = 4 Then
         Unload Me
    End If
    
    'MouseMove events are cumulative, so over time there
    'might be mouse creep.  Reset the counter if more
    'than 10 seconds have elapsed since mouse movement
    'began.
    If nTimeDelay = 0 Then
        nTimeDelay = Timer
    ElseIf Timer - nTimeDelay > 10 Then
        nTimeDelay = 0
        nMouseMoves = 0
    End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
  'Restore the mouse cursor.
    Do
    Loop Until ShowCursor(True) > 5
    
    'Re-enable the CTRL-ALT-DEL key combination if it is disabled.
    tmplng = SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0&, 0&, 0&)
End Sub

Private Sub Timer1_Timer()

    'Verify that the Message has moved completely off the left side of the screen.
    If lblMessage.Left < (0 - lblMessage.Width) Then
        lblMessage.Left = ScaleWidth
    End If
    
    'Moves lblMessage to the left.
    lblMessage.Left = lblMessage.Left - 10

End Sub
  14. On the Project menu, click Add Form.
  15. On the Add Form dialog box, click Open.

    By default, Form1 is created.
  16. On the Properties window, set the Name property of Form1 to frmCnfg.
  17. Add a Label control, add a TextBox control, and add two CommandButton controls to the frmCnfg form.
  18. Set the following properties:
    • Label1

      Caption: Enter Message
    • TextBox

      Name: txtMessage
      Text: "" (no text)
    • Command1

      Name: cmdOK
      Caption: &OK
    • Command2

      Name: cmdCancel
      Caption: &Cancel
  19. Right-click the frmCnfg form, and then click View Code.
  20. Paste the following code in the Code window: 
    Option Explicit

Private Sub cmdCancel_Click()

    Unload Me

End Sub

Private Sub cmdOK_Click()
 'Save the current  settings to
    'HKEY_CURRENT_USER\Software\VB and VBA Program Settings
    'in the registry.
    SaveSetting "Samples", "Test Screen Saver", "Message", txtMessage.Text
   Unload Me
End Sub
  21. On the Project menu, click Add Module.
  22. In the Add Module dialog box, click Open.

    By default, Module1 is created.
  23. Replace the code in the Code window with the following code:
    Option Explicit

Type OsVersionInfo
    dwVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatform As Long
    szCSDVersion As String * 128
End Type

Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = 1
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_TOPMOST = -1
Public Const HKEY_CURRENT_USER = &H80000001

''Registry Read permissions:
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const Key_Read = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
'
Private Const REG_DWORD = 4&       ' 32-bit number
Public Const SPI_SCREENSAVERRUNNING = 97&
Public tmplng&
Public nMouseMoves%
Public xPixel%
Public yPixel%
Public ScrMsg As String
Public ScreenWidth%
Public ScreenHeight%
Private OsVers As OsVersionInfo
Public winOS&

'--------------------------------------------------------------------------
'API declarations
''--------------------------------------------------------------------------
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function GetVersionEx& Lib "kernel32" Alias "GetVersionExA" (lpStruct As OsVersionInfo)
Private Declare Function RegCloseKey& Lib "advapi32.dll" (ByVal HKey&)
Private Declare Function RegOpenKeyExA& Lib "advapi32.dll" (ByVal HKey&, ByVal lpszSubKey$, dwOptions&, ByVal samDesired&, lpHKey&)
Private Declare Function RegQueryValueExA& Lib "advapi32.dll" (ByVal HKey&, ByVal lpszValueName$, lpdwRes&, lpdwType&, ByVal lpDataBuff$, nSize&)
Public Declare Function SetWindowPos Lib "user32" (ByVal h&, ByVal hb&, ByVal X&, ByVal Y&, ByVal cx&, ByVal cy&, ByVal f&) As Integer
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Public Sub Main()


    'Start the screen saver from a sub main that arbitrates
    'the command line parameter and loads an appropriate form.
    Dim sStartType$
    xPixel = Screen.TwipsPerPixelX
    yPixel = Screen.TwipsPerPixelY
        
    sStartType = UCase(Left$(Command, 2))
    If sStartType = "" Then
        'This occurs when a user right-clicks the .scr
        'file and chooses "configure."
        sStartType = "/C"
    End If
    Select Case sStartType
        Case "/C"
            frmcnfg.Show
        Case "/S"
              If CheckUniqueWindow("Screen Saver Main Form") = False Then
                Exit Sub
            End If
            frmscr.Show
  
    End Select

End Sub
Sub GetOSVersion32()
    OsVers.dwVersionInfoSize = 148&
    tmplng = GetVersionEx(OsVers)
    winOS = OsVers.dwPlatform
End Sub

Function CheckUniqueWindow%(FormCaption$)
    'Looks for a window with the same caption.
    Dim HandleWin&
    HandleWin = FindWindow(vbNullString, FormCaption)
    If HandleWin = 0 Then
        CheckUniqueWindow = True
    Else
        CheckUniqueWindow = False
    End If
End Function
  24. On the File menu, click Make MyScreenSaver.exe.
  25. In the Make Project dialog box, name the file MyScreenSaver.scr.
  26. Save the MyScreenSaver.scr file in the Windows System folder, and then click OK.

    MyScreenSaver is an available screen saver on your computer.
back to the top

REFERENCES

For more information about programming screen savers by using Microsoft DirectX, visit the following Microsoft Developer Network (MSDN) Web site:

http://msdn.microsoft.com/library/en-us/dndrive/html/directx08202001.asp

back to the top
Modification Type:MajorLast Reviewed:7/7/2003
Keywords:kbHOWTOmaster kbProgramming kbScreenSaver kbForms kbCursor KB818365 kbAudDeveloper
©2003 Microsoft Corporation. All rights reserved.