Solved

how to create a screen saver for windows in vb5

Posted on 1998-07-25
7
191 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
Comment Utility
please help me.  i am unable to do this on my own.
0
 
LVL 8

Accepted Solution

by:
MikeP090797 earned 50 total points
Comment Utility
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
Comment Utility
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
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 8

Expert Comment

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

Author Comment

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

Expert Comment

by:MikeP090797
Comment Utility
sorry, misspeled it, it's PrevInstance
0
 

Author Comment

by:darink
Comment Utility
sorry, i read about as well as you spell.
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

771 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now