Screen Saver in VB6

I am trying to make a screen saver in VB6. I got some of the outline done. It runs but I don't know how to add pictures/animation and make the settings work I also don't know how to add sounds. I have seen a few things in 3.0, 4.0 and 5.0, but the only thing for 6.0 is in msdn CD's and that has not helped to much.
Who is Participating?
Here is a sample that might help you with the settings problem, I found it a few months ago on the web. The main idea is to show the settings dialog when /C is passed as a command line to your screensaver

Regarding the other part, you can use PictureBoxes to add pictures, and the Multimedia control to play sounds and videos

Tell me if you need any more specific help
VB5 Screen Saver

Implementing a screensaver in VB is not as hard as you might think. The code below is distilled from several newsgroup posts and the Microsoft VB Homepage. I have tried to include all the required functionallity in a single code module. To create your screen saver copy the code from below and paste it into a code module, set the startup function to Sub Main. Create a new form called "savemain", this is your new screensaver canvas - for the moment just place a bit of text on it. The "savemain" form must be set to maximised startup with BorderStyle = None and remember to set the startup object to Sub Main. Save the project / form. Compile the program as a .SCR in the \Windows or \Winnt directory (depends on your operating system). All the basic functionallity is included in this module. I will leave the creative bit of your screensaver to you (what you do with the canvas), obviously you will need to scale your graphics / text / sprites etc for the preview window (note that I set a variable called RUNMODE - you can test this to decide what scaling is required). If you want a configuration form then simply add a form called "saveconf" to the project and put your configuration routines / controls on it - write your configuration information to an .INI file or the registry.

The password elements are derived in part from a VB4 screensaver example by Don Bradner and Jim Deutch.



' Created by E.Spencer ( - This code is public domain.


Option Explicit

' Constants List

Public Const WS_CHILD = &H40000000

Public Const GWL_STYLE = (-16)

Public Const GWL_HWNDPARENT = (-8)

Public Const HWND_TOP = 0&

Public Const SWP_NOZORDER = &H4

Public Const SWP_NOACTIVATE = &H10

Public Const SWP_SHOWWINDOW = &H40


' ScreenSaver Running Modes

Public Const RM_NORMAL = 1

Public Const RM_CONFIGURE = 2

Public Const RM_PASSWORD = 3

Public Const RM_PREVIEW = 4

' API call to turn mouse cursor on / off

Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

' API calls required to talk to the preview window

Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long

Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _

   ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _

   ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _

   ByVal nIndex As Long) As Long

Private Declare Function PwdChangePassword& Lib "mpr" Alias "PwdChangePasswordA" (ByVal lpcRegkeyname$, _

   ByVal hwnd&, ByVal uiReserved1&, ByVal uiReserved2&)

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 VerifyScreenSavePwd Lib "password.cpl" (ByVal hwnd&) As Boolean

' Version info

Private OsVers As OsVersionInfo

Type OsVersionInfo

   dwVersionInfoSize As Long

   dwMajorVersion As Long

   dwMinorVersion As Long

   dwBuildNumber As Long

   dwPlatform As Long

   szCSDVersion As String * 128

End Type

Private Declare Function GetVersionEx& Lib "kernel32" Alias "GetVersionExA" (lpStruct As OsVersionInfo)

' Registry API functions

Private Const HKEY_CURRENT_USER = &H80000001

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _

   ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

' Public variable fields

Public CurrOS As String ' Name of operating system, 95 or NT

Public PWMode As Integer ' Screensaver password enabled flag

Public RunMode As Long

Public DispRec As RECT ' Rectangle values of display form

Public Const REG_DWORD As Long = 4

' Private variable fields

Private dispHWND, style As Long

' Types

Public Type RECT

   Left As Long

   Top As Long

   Right As Long

   Bottom As Long

End Type


Sub Main()

' Ensure that only one instance of this screensaver is running

Randomize ' Seed the random number generator - may be required

' Check the command line arguments

' The command-line argument /p is used to launch the preview box

If Left(Command$, 2) = "/p" Then

   RunMode = RM_PREVIEW


' The command-line argument /c is used to launch the screen saver in setup mode

ElseIf Left(Command$, 2) = "/c" Then



' The command-line argument /s is used to launch the screen saver in normal operating mode

ElseIf Left(Command$, 2) = "/s" Or Command$ = "" And Not App.PrevInstance Then

   RunMode = RM_NORMAL


' The command-line argument /a is used to launch the password mode

ElseIf Left(Command$, 2) = "/a" Then

   RunMode = RM_PASSWORD


End If

End Sub

Public Sub cleanup_and_end() ' Public exit - can be called from forms etc.

On Error Resume Next

ShowCursor True  ' Unhide the mouse cursor

Set_TFS "enable" ' Restore CTL+ALT+DEL

End              ' Endex here

End Sub

Private Sub start_screensaver()

On Error GoTo saver_error

ShowCursor False ' Hide the mouse cursor

' Get the O/S name using function in SysInfo code module

' Get the PW flag using a function in the ellreg code module.

CurrOS = GetVersion32 ' Find out the operating system, 95 or NT

' Find out if the user has enabled passwords for this screen saver

If CurrOS = "95" Then PWMode = ReadRegistry(HKEY_CURRENT_USER, "Control Panel\Desktop", "ScreenSaveUsePassword")

Set_TFS "disable" ' Stop CTL+ALT+DEL

savemain.Show ' Start the screensaver

Exit Sub


MsgBox "The screensaver has failed", vbOKOnly, "Saver"

End Sub

Private Sub Check_password()

Dim pwlong As Long

On Error GoTo pw_error

dispHWND = CLng(Right$(Command$, Len(Command$) - 3)) ' Convert display properties window handle to long type

pwlong = PwdChangePassword("SCRSAVE", dispHWND, 0, 0)

Exit Sub


MsgBox "The password change has failed", vbOKOnly, "PW"

End Sub

Private Sub start_preview_box()

On Error GoTo preview_error

dispHWND = CLng(Right$(Command$, Len(Command$) - 3)) ' Convert preview window handle to long type

Load savemain ' Load up the preview form

GetClientRect dispHWND, DispRec ' Get Preview Box Rectangle dimensions

style = GetWindowLong(savemain.hwnd, GWL_STYLE) ' Get current window style

style = style Or WS_CHILD ' Append "WS_CHILD" style to the hWnd window style

SetWindowLong savemain.hwnd, GWL_STYLE, style ' Add new style to window

SetParent savemain.hwnd, dispHWND ' Set preview form into preview window

SetWindowLong savemain.hwnd, GWL_HWNDPARENT, dispHWND ' Save the hWnd Parent in hWnd's window struct.

SetWindowPos savemain.hwnd, HWND_TOP, 0&, 0&, DispRec.Right, DispRec.Bottom, _


preview_error: ' No error messages when in preview mode - looks messy

End Sub

Private Sub run_configuration()

On Error GoTo conf_error

saveconf.Show ' Show the screensaver configuration form (if we have one)

Exit Sub

conf_error: ' If we don't have a configuration form let the user know

MsgBox "This screensaver has no configuration options", vbOKOnly, "Setup"

End Sub

Public Sub Set_TFS(Command As String)

' Disable three finger salute (TFS) on Win 95.

' Call when you don't want people breaking past the screensaver

' when passwords are enabled. Command can be "enable" or "disable".

' Example - Set_TFS "enable"

If PWMode = 1 And CurrOS = "95" Then

   If LCase(Command) = "disable" Then

      SystemParametersInfo SPI_SCREENSAVERRUNNING, 1&, 0&, 0&

   End If

   If LCase(Command) = "enable" Then

      SystemParametersInfo SPI_SCREENSAVERRUNNING, 0&, 0&, 0&

   End If

End If

End Sub

' From my registry access module (slightly amended to simplify the code)

Public Function ReadRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String) As String

Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double

On Error Resume Next

lResult = RegOpenKey(Group, Section, lKeyValue)

sValue = Space$(2048)

lValueLength = Len(sValue)

lResult = RegQueryValueEx(lKeyValue, Key, 0&, lDataTypeValue, sValue, lValueLength)

If (lResult = 0) And (Err.Number = 0) Then

   If lDataTypeValue = REG_DWORD Then

      td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))

      sValue = Format$(td, "000")

   End If

   sValue = Left$(sValue, lValueLength - 1)


   sValue = "Not Found"

End If

lResult = RegCloseKey(lKeyValue)

ReadRegistry = sValue

End Function

Public Function GetVersion32() As String

' Call to get the 32 Bit O/S ID. Returned values are either "95" or "NT" or "Unknown"

' Example - MyString = GetVersion32


OsVers.dwVersionInfoSize = 148&

GetVersionEx OsVers

If OsVers.dwPlatform = 1& Then

   GetVersion32 = "95"

ElseIf OsVers.dwPlatform = 2& Then

   GetVersion32 = "NT"


   GetVersion32 = "Unknown"

End If

End Function


When the screen saver is password protected we need to ensure the user types in the correct password before we close down the screen saver, to do this we check the password in the Form_QueryUnload event trigger and cancel the unload if the user fails to type in the correct password. An example from my screen saver is given below :-

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Dim PWOK As Boolean

' If passwords are turned on and we are not on NT check the password.

If RunMode = RM_NORMAL Then

   If PWMode = 1 And CurrOS = "95" Then

      ShowCursor True ' Need the cursor for the dialog box

      PWOK = VerifyScreenSavePwd(Me.hwnd)

      If PWOK = False Then Cancel = True

      ShowCursor False ' Get rid of cursor - turn back on if exiting

   End If

End If

End Sub

SenebirtAuthor Commented:
Edited text of question
SenebirtAuthor Commented:
Thanks a lot. When I make a screen saver I will be sure to put you in the credits I tried to give you 600 points but it would not let me that sure sucks. Thanks again see ya. :)
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.