Microsoft KB Archive/818365

= HOW TO: Create A Screen Saver in Microsoft Visual Basic 6.0 =

Article ID: 818365

Article Last Modified on 1/12/2007

-

APPLIES TO


 * Microsoft Visual Basic 6.0 Enterprise Edition
 * Microsoft Visual Basic 6.0 Professional Edition
 * Microsoft Visual Basic 6.0 Learning Edition

-





IN THIS TASK

 * SUMMARY
 * Step-by-Step Example
 * REFERENCES



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
 Start Visual Basic 6.0. On the File menu, click New Project. On the New Project dialog box, click Standard EXE, and then click OK.

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

 On the Project menu, click Project1 Properties. Click the General tab of the Project1 - Project Properties dialog box. Name the project MyScreenSaver, click to select Sub Main in the Startup Object drop-down list box, and then click OK.</li> In the toolbox, double-click the Label control.

By default, Label1 is added to the form.</li> Set the following properties of Label1:

</li> In the toolbox, double-click the Timer control.

Timer1 is added to the form.</li> Set the Interval property of the Timer1 control to 10 .</li> In Project Explorer, right-click the frmScr form, and then click View Code.</li>  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(&quot;Samples&quot;, &quot;Test Screen Saver&quot;, &quot;Message&quot;, &quot;Hello World&quot;) 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 </li> On the Project menu, click Add Form.</li> On the Add Form dialog box, click Open.

By default, Form1 is created.</li> On the Properties window, set the Name property of Form1 to frmCnfg .</li> Add a Label control, add a TextBox control, and add two CommandButton controls to the frmCnfg form.</li> Set the following properties: <ul> Label1

</li> TextBox

</li> Command1

</li> Command2

</li></ul> </li> <li>Right-click the frmCnfg form, and then click View Code.</li> <li> 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 &quot;Samples&quot;, &quot;Test Screen Saver&quot;, &quot;Message&quot;, txtMessage.Text Unload Me End Sub </li> <li>On the Project menu, click Add Module.</li> <li>In the Add Module dialog box, click Open.

By default, Module1 is created.</li> <li> 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 &quot;user32&quot; Alias &quot;FindWindowA&quot; (ByVal lpClassName$, ByVal lpWindowName$) Private Declare Function GetVersionEx& Lib &quot;kernel32&quot; Alias &quot;GetVersionExA&quot; (lpStruct As OsVersionInfo) Private Declare Function RegCloseKey& Lib &quot;advapi32.dll&quot; (ByVal HKey&) Private Declare Function RegOpenKeyExA& Lib &quot;advapi32.dll&quot; (ByVal HKey&, ByVal lpszSubKey$, dwOptions&, ByVal samDesired&, lpHKey&) Private Declare Function RegQueryValueExA& Lib &quot;advapi32.dll&quot; (ByVal HKey&, ByVal lpszValueName$, lpdwRes&, lpdwType&, ByVal lpDataBuff$, nSize&) Public Declare Function SetWindowPos Lib &quot;user32&quot; (ByVal h&, ByVal hb&, ByVal X&, ByVal Y&, ByVal cx&, ByVal cy&, ByVal f&) As Integer Public Declare Function SystemParametersInfo Lib &quot;user32&quot; Alias &quot;SystemParametersInfoA&quot; (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long Public Declare Function ShowCursor Lib &quot;user32&quot; (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 = &quot;&quot; Then 'This occurs when a user right-clicks the .scr 'file and chooses &quot;configure.&quot; sStartType = &quot;/C&quot; End If   Select Case sStartType Case &quot;/C&quot; frmcnfg.Show Case &quot;/S&quot; If CheckUniqueWindow(&quot;Screen Saver Main Form&quot;) = 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 </li> <li>On the File menu, click Make MyScreenSaver.exe.</li> <li>In the Make Project dialog box, name the file MyScreenSaver.scr .</li> <li>Save the MyScreenSaver.scr file in the Windows System folder, and then click OK.

MyScreenSaver is an available screen saver on your computer.</li></ol>

back to the top

<div class="references_section">