Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

screen saver 2

Status
Not open for further replies.

slowATthought

Programmer
Dec 2, 2003
56
US
Is there a way to make a program run as a screen saver in VB?
 
Rename the File.exe to File.scr, pretty easy huh.

"Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'."
 
Not exactly DrJavaJoe, if you want to be able to right click your desktop and click properties, screensaver and view a preview or show options for configuration you need to use a sub Main for startup and check the command arguments like so...

Sub Main()
' Must determine what mode screen saver is intended to be run

Select Case Mid(UCase$(Trim$(Command$)), 1, 2)

Case "/C" 'Configurations mode called
Run_Mode = "C"
FrmConfig.Show

Case "", "/S" 'Screensaver mode
Run_Mode = "S"
runScreensaver

Case "/A" 'Password protect dialog
'Here 's a different option to passwords!
MsgBox "Password Protection not available with" _
& " this screen saver", vbInformation, "Error"
End

Case "/P" 'Preview mode
preview = True
Run_Mode = "P"
runPreview

Case Else
End

End Select

End Sub

Probably the biggest mistake with a lot of so called screensavers is they dont look at the command arguments thus failing to give you any preview/options/password protection
 
I guess since we are being thorough,you'll also need to add code to your forms mousemove and click events that will close the app when fired.

"Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'."
 
Doh!

"Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'."
 
I renamed the file, but it now says File.scr and says that it is an application intead of saying File and calling it a screen saver. Do you know why?
 
Forget that last question. I changed the name in Explorer instead of hitting Make Exe and naming it .scr. Anyway, now that I have a screen saver file, what do I do? It does not appear in the screen saver list in the properties window, and I'm guessing that I need to do something to put it there.
 
Move it to your Windows folder and then it will appear in the screen saver list.

"Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'."
 
Two more questions:
1-Is there some sort of API or something that can tell me the system folder or whereever to put it?
2-How do I program it to run in that little box on the properties window? It isn't the preview thing, and it happens when you select a screen saver.
 
It's the Preview thing! The code above shows you how to intercept the command arguments. Case "/P" is the preview mode and we call a sub which involves finding the properties then setting your form's window into this properties window

1. Run the above code 'sub main' in a module and add the code below
2. Change FrmMain (in the code below)to your form's name


Private Sub runPreview()
Dim args As String
Dim preview_hwnd As Long
Dim preview_rect As RECT
Dim window_style As Long
' Get the command line arguments.
args = UCase$(Trim$(Command$))

' Get the preview area hWnd.
preview_hwnd = GetHwndFromCommand(args)

' Get the dimensions of the preview area.
GetClientRect preview_hwnd, preview_rect

Load FrmMain

' Set the caption for Windows 95.
FrmMain.Caption = "Preview"

' Get the current window style.
window_style = GetWindowLong(FrmMain.hwnd, GWL_STYLE)

' Add WS_CHILD to make this a child window.
window_style = (window_style Or WS_CHILD)

' Set the window's new style.
SetWindowLong FrmMain.hwnd, _
GWL_STYLE, window_style

' Set the window's parent so it appears
' inside the preview area.
SetParent FrmMain.hwnd, preview_hwnd

' Save the preview area's hWnd in
' the form's window structure.
SetWindowLong FrmMain.hwnd, _
GWL_HWNDPARENT, preview_hwnd

' Show the preview.
SetWindowPos FrmMain.hwnd, _
HWND_TOP, 0&, 0&, _
preview_rect.Right, _
preview_rect.Bottom, _
SWP_NOZORDER Or SWP_NOACTIVATE Or _
SWP_SHOWWINDOW
End Sub

 
Place these declares at the top of your module...

Option Explicit 'All variables must be declared

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Global preview As Boolean
'Function ShowCursor used to hide the cursor during the
'screen saver's runtime, and then enable it upon ending
Declare Function ShowCursor Lib "user32" (ByVal bShow _
As Long) As Long

'Function FindWindow used in determining whether or not
'another instance of the screen saver is running
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'GetPreview Reclangle Area
Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Declare Function 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) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long


'Constants
Public Const SW_SHOWNORMAL = 1
Public Const GWL_STYLE = (-16)
Public Const WS_CHILD = &H40000000
Public Const HWND_TOP = 0
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const GWL_HWNDPARENT = (-8)
Public Run_Mode As String
 
As far as getting the Windows folder use the SHGetSpecialFolderLocation API. Do a keyword search should turn up lots of hits.

"Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'."
 
thread222-721049

"Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'."
 
Just do a search for files named '*.scr' and see which dir they are sitting in
 
Actually both folders work for me, but I noticed the default screensavers are in the System32 folder. The above api will return this folder also.

"Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'."
 
hmm... on the preview, it doesn't seem to like GetHwndFromCommand. Am I missing something? I copied all of the APIs.
 
Use this to get the system folder:

strSystemFolder = fGetSpecialFolder(Me.hwnd, CSIDL_SYSTEM)

And place this in a module:
Option Explicit

Public Type SHORTITEMID
cb As Long
abID As Integer
End Type

Public Type ITEMIDLIST
mkid As SHORTITEMID
End Type

Public Declare Function SHGetPathFromIDList Lib _
"shell32.dll" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Public Declare Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _
As Long, pidl As ITEMIDLIST) As Long

Public Const CSIDL_DESKTOP = &H0 'Desktop
Public Const CSIDL_INTERNET = &H1 'Internet Explorer (icon on desktop)
Public Const CSIDL_PROGRAMS = &H2 'Start Menu\Programs
Public Const CSIDL_CONTROLS = &H3 'My Computer\Control Panel
Public Const CSIDL_PRINTERS = &H4 'My Computer\Printers
Public Const CSIDL_PERSONAL = &H5 'My Documents
Public Const CSIDL_FAVORITES = &H6 '<user name>\Favorites
Public Const CSIDL_STARTUP = &H7 'Start Menu\Programs\Startup
Public Const CSIDL_RECENT = &H8 '<user name>\Recent
Public Const CSIDL_SENDTO = &H9 '<user name>\SendTo
Public Const CSIDL_BITBUCKET = &HA '<desktop>\Recycle Bin
Public Const CSIDL_STARTMENU = &HB '<user name>\Start Menu
Public Const CSIDL_DESKTOPDIRECTORY = &H10 '<user name>\Desktop
Public Const CSIDL_DRIVES = &H11 'My Computer
Public Const CSIDL_NETWORK = &H12 'Network Neighborhood
Public Const CSIDL_NETHOOD = &H13 '<user name>\nethood
Public Const CSIDL_FONTS = &H14 'Windows\fonts
Public Const CSIDL_TEMPLATES = &H15
Public Const CSIDL_COMMON_STARTMENU = &H16 'All Users\Start Menu
Public Const CSIDL_COMMON_PROGRAMS = &H17 'All Users\Programs
Public Const CSIDL_COMMON_STARTUP = &H18 'All Users\Startup
Public Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19 'All Users\Desktop
Public Const CSIDL_APPDATA = &H1A '<user name>\Application Data
Public Const CSIDL_PRINTHOOD = &H1B '<user name>\PrintHood
Public Const CSIDL_LOCAL_APPDATA = &H1C '<user name>\Local Settings\Applicaiton Data (non roaming)
Public Const CSIDL_ALTSTARTUP = &H1D 'non localized startup
Public Const CSIDL_COMMON_ALTSTARTUP = &H1E 'non localized common startup
Public Const CSIDL_COMMON_FAVORITES = &H1F
Public Const CSIDL_INTERNET_CACHE = &H20
Public Const CSIDL_COOKIES = &H21
Public Const CSIDL_HISTORY = &H22
Public Const CSIDL_COMMON_APPDATA = &H23 'All Users\Application Data
Public Const CSIDL_WINDOWS = &H24 'Windows Directory
Public Const CSIDL_SYSTEM = &H25 'System Directory
Public Const CSIDL_PROGRAM_FILES = &H26 'C:\Program Files
Public Const CSIDL_MYPICTURES = &H27 'C:\Program Files\My Pictures
Public Const CSIDL_PROFILE = &H28 'USERPROFILE
Public Const CSIDL_SYSTEMX86 = &H29 'x86 system directory on RISC
Public Const CSIDL_PROGRAM_FILESX86 = &H2A 'x86 C:\Program Files on RISC
Public Const CSIDL_PROGRAM_FILES_COMMON = &H2B 'C:\Program Files\Common
Public Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C 'x86 Program Files\Common on RISC
Public Const CSIDL_COMMON_TEMPLATES = &H2D 'All Users\Templates
Public Const CSIDL_COMMON_DOCUMENTS = &H2E 'All Users\Documents
Public Const CSIDL_COMMON_ADMINTOOLS = &H2F 'All Users\Start Menu\Programs\Administrative Tools
Public Const CSIDL_ADMINTOOLS = &H30 '<user name>\Start Menu\Programs\Administrative Tools
Public Const CSIDL_CONNECTIONS = &H31 'Network and Dial-up Connections
'_____________________________

Public Function fGetSpecialFolder(hwnd As Long, ByVal lngCSIDL As Long) As String

'--- Given a CSIDL constant, returns the path to a special folder

Dim udtIDL As ITEMIDLIST
Dim lngRtn As Long 'Return value
Dim strFolder As String 'Buffer returned folder

lngRtn = SHGetSpecialFolderLocation(hwnd, _
lngCSIDL, udtIDL)
If lngRtn = 0 Then
strFolder = Space$(260)
lngRtn = SHGetPathFromIDList( _
ByVal udtIDL.mkid.cb, ByVal strFolder)
If lngRtn Then
fGetSpecialFolder = Left$(strFolder, _
InStr(1, strFolder, Chr$(0)) - 1)
End If
End If

End Function







&quot;Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'.&quot;
 
Nah, I left out a function...

' Get the hWnd for the preview window from the
' command line arguments.
Private Function GetHwndFromCommand(ByVal args As String) As Long
Dim argslen As Integer
Dim i As Integer
Dim ch As String

' Take the rightmost numeric characters.
args = Trim$(args)
argslen = Len(args)
For i = argslen To 1 Step -1
ch = Mid$(args, i, 1)
If ch < &quot;0&quot; Or ch > &quot;9&quot; Then Exit For
Next i

GetHwndFromCommand = CLng(Mid$(args, i + 1))
End Function

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top