Solved

how to create a screen saver for windows in vb5

Posted on 1998-07-25
7
201 Views
Last Modified: 2012-05-04
i have written some programs which i would love to make into windows screensavers, but i do not know how.  simply giving them the .scr extention doesnt work.  please help me if you can.
0
Comment
Question by:darink
  • 4
  • 3
7 Comments
 

Author Comment

by:darink
ID: 1466703
please help me.  i am unable to do this on my own.
0
 
LVL 8

Accepted Solution

by:
MikeP090797 earned 50 total points
ID: 1466704
Here is a doc I found on screen savers:


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 (elliot@spnc.demon.co.uk) - 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

Public Const SPI_SCREENSAVERRUNNING = 97&

' 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

   start_preview_box

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

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

   RunMode = RM_CONFIGURE

   run_configuration

' 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

   start_screensaver

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

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

   RunMode = RM_PASSWORD

   Check_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

saver_error:

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

pw_error:

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, _

SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW

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)

Else

   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"

Else

   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


0
 

Author Comment

by:darink
ID: 1466705
everything is working fine on the screensaver, with the exception being that multiple copies of the program run.  there is a remark about that in the code, but i cant figure out what it means.  please help me.

0
Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 8

Expert Comment

by:MikeP090797
ID: 1466706
You must check if an instance of the program already exist:
if App.PrevInsance then end
0
 

Author Comment

by:darink
ID: 1466707
this line gives me a 'method or data member not found' error.
0
 
LVL 8

Expert Comment

by:MikeP090797
ID: 1466708
sorry, misspeled it, it's PrevInstance
0
 

Author Comment

by:darink
ID: 1466709
sorry, i read about as well as you spell.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

860 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question