@rdc:
I coded a little screensaver fx two/three years ago :
http://www.weltenkonstrukteur.de/?site=works&prd=TVNoiseIt is written in
PureBasic - but it uses of course a lot of WinApi for the
screensaver part. I post the source maybe it is of some use for you.
Some points about the source- the "Common.pb" include isn't import - it just contains some gui-stuff for the
configuration window
- the "ExecutePreview" is a bit faked - I just show a screenshot of the fx here
- check the
"deal with the Parameters passed to this program" - part to see
which arguments are passed to the screensaver ( -> configuration, ->run etc.)
IncludeFile "Common.pb"
;===========================================================================
;-ONLY START ONE INSTANCE
;===========================================================================
Global ScreensaverName.s
ScreensaverName = "TV-Noise Screensaver"
;The next function call uses the AppRunning User Library
If AppRunning(ScreensaverName) : End : EndIf
;===========================================================================
;-CONSTANTS
;===========================================================================
#SCREEN_X = 800
#SCREEN_Y = 600
#LOOPTIME = 1000/40 ; 40 Frames in 1000ms (1second)
;===========================================================================
;-GLOBAL FLAGS / VARIABLES / STRUCTURES / ARRAYS
;===========================================================================
Global Parameter.s
Global PrevWinHndlString.s
Global PrevWinHndl.l
Parameter = UCase(ProgramParameter())
If Len(Parameter) > 2
PrevWinHndlString = RemoveString(Parameter, Left(Parameter, 3), 1)
Parameter = RemoveString(Parameter, Left(Parameter, 1), 1)
Parameter = Left(Parameter, 1)
Else
Parameter = RemoveString(Parameter, Left(Parameter, 1), 1)
PrevWinHndlString = ProgramParameter()
If FindString(PrevWinHndlString, "-", 0) <> 0 : PrevWinHndlString = RemoveString(PrevWinHndlString, "-", 1) : EndIf
If FindString(PrevWinHndlString, "/", 0) <> 0 : PrevWinHndlString = RemoveString(PrevWinHndlString, "/", 1) : EndIf
EndIf
PrevWinHndl = Val(PrevWinHndlString)
;===========================================================================
;-PROCEDURES
;===========================================================================
;simple error checking
Procedure HandleError(result, text.s)
If result = 0 : MessageRequester("Error", text, #PB_MessageRequester_Ok) : End : EndIf
EndProcedure
;preview window callback
Procedure PreviewCallback(hWnd, Message, wParam, lParam)
Select Message
Case #WM_CLOSE
UnregisterClass_("PreviewWindowClass", GetModuleHandle_(#NULL))
DestroyWindow_(hWnd)
End
EndSelect
Result = DefWindowProc_(hWnd, Message, wParam, lParam)
ProcedureReturn Result
EndProcedure
;execute the preview in the little mini monitor in 'Display Properties'
Procedure ExecutePreview()
PreviewWindowSize.RECT
GetClientRect_(PrevWinHndl, @PreviewWindowSize)
PreviewWindowClass.WNDCLASS
Classname.s = "PreviewWindowClass"
PreviewWindowClass\style = #CS_HREDRAW | #CS_VREDRAW
PreviewWindowClass\lpfnWndProc = @PreviewCallback()
PreviewWindowClass\cbClsExtra = 0
PreviewWindowClass\cbWndExtra = 0
PreviewWindowClass\hInstance = GetModuleHandle_(#NULL)
PreviewWindowClass\hIcon = 0
PreviewWindowClass\hCursor = 0
PreviewWindowClass\hbrBackground = 0
PreviewWindowClass\lpszMenuName = 0
PreviewWindowClass\lpszClassName = @Classname
RegisterClass_(PreviewWindowClass)
hWnd.l = CreateWindowEx_(0, "PreviewWindowClass", "", #WS_CHILD | #WS_VISIBLE, 0, 0, PreviewWindowSize\right, PreviewWindowSize\bottom, PrevWinHndl, 0, GetModuleHandle_(#NULL), 0)
If hWnd
CatchImage(1, ?PreviewImage)
HandleError(CreateGadgetList(hWnd), "Gadget list in preview window could not be created!")
ImageGadget(1, 0, 0, PreviewWindowSize\right, PreviewWindowSize\bottom, UseImage(1))
While GetMessage_(Message.MSG, 0, 0, 0)
TranslateMessage_(Message)
DispatchMessage_(Message)
Wend
EndIf
EndProcedure
; Procedure, die die Farbe in den aktuellen Farbmodus umwandelt.
; (Bei 15-bit bin ich mir nicht sicher ob das so richtig ist, konnte es nicht testen...)
Procedure.l TransformColor(R.b,G.b,b.b)
Select DrawingBufferPixelFormat()
Case #PB_PixelFormat_32Bits_RGB
ProcedureReturn R+G<<8+b<<16
Case #PB_PixelFormat_32Bits_BGR
ProcedureReturn b+G<<8+R<<16
Case #PB_PixelFormat_24Bits_RGB
ProcedureReturn R+G<<8+b<<16
Case #PB_PixelFormat_24Bits_BGR
ProcedureReturn b+G<<8+R<<16
Case #PB_PixelFormat_16Bits
ProcedureReturn b>>3+(G&%11111100)<<3+(R&%11111000)<<8
Case #PB_PixelFormat_15Bits
ProcedureReturn R&%11111000>>3+(G&%11111000)<<2+(b&%11111000)<<7
EndSelect
EndProcedure
; For Speed-Optimation - Original by Danilo!
Procedure InitGameTimer()
; initialize highres timing function TimeGetTime_()
Shared _GT_DevCaps.TIMECAPS
timeGetDevCaps_(_GT_DevCaps,SizeOf(TIMECAPS))
timeBeginPeriod_(_GT_DevCaps\wPeriodMin)
EndProcedure
Procedure StopGameTimer()
; de-initialize highres timing function TimeGetTime_()
Shared _GT_DevCaps.TIMECAPS
timeEndPeriod_(_GT_DevCaps\wPeriodMin)
EndProcedure
;run the fullscreen screensaver code
Procedure ExecuteScreenSaver()
If InitSprite()=0 Or InitMouse()=0 Or InitKeyboard()=0
MessageRequester("ERROR","Cant init DirectX !",#MB_ICONERROR):End
EndIf
If OpenScreen(#SCREEN_X, #SCREEN_Y, 32, "weltenkonstrukteur.de")=0
MessageRequester("ERROR","Cant open screen !",#MB_ICONERROR):End
EndIf
StartDrawing(ScreenOutput())
Pitch = DrawingBufferPitch()
StopDrawing()
White = TransformColor(255,255,255)
Noise = 0
Carry = 0
Index = 0
Seed = $12345
; InitScreenSaver()
SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, #TRUE, @oldval, 0)
ShowCursor_(0)
While quit=0
FlipBuffers()
ExamineMouse()
ExamineKeyboard()
StartDrawing(ScreenOutput())
For y = 0 To #SCREEN_Y -1
For x = 0 To #SCREEN_X -1
noise = seed;
noise = noise >> 3
noise = noise ! seed
carry = noise & 1
seed = seed >> 1
seed = seed | ( carry << 30)
noise = noise & $FF
*Screen.LONG = DrawingBuffer()
*Screen + (Pitch * y) + (x*4)
*Screen\l = (noise<<16) | (noise << 8) | noise
Next x
Next y
StopDrawing()
While ( timeGetTime_()-LoopTimer )<#LOOPTIME : Delay(1) : Wend
LoopTimer = timeGetTime_()
If KeyboardPushed(#PB_Key_All)
quit = 2
EndIf
If MouseDeltaX() <> 0 Or MouseDeltaY() <> 0 Or MouseWheel() <> 0 Or MouseButton(1) <> 0 Or MouseButton(2) <> 0 Or MouseButton(3) <> 0
quit = 2
EndIf
Wend
ShowCursor_(1)
SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, #FALSE, @oldval, 0)
End
EndProcedure
;configuration window
Procedure ExecuteConfiguration()
; MessageRequester("Saver - Config", "Nichts einzurichten!"+Chr(13)+"(c)coming art")
Open_Window_0()
Repeat
Event = WaitWindowEvent()
If Event = #PB_EventGadget
;Debug "WindowID: " + Str(EventWindowID())
GadgetID = EventGadgetID()
If GadgetID = #Button_0
End
EndIf
EndIf
Until Event = #PB_EventCloseWindow
End
EndProcedure
;===========================================================================
;-MAIN
;===========================================================================
;deal with the Parameters passed to this program
Select Parameter
Case "" ;double clicked
ExecuteConfiguration()
Case "A" ;check password
End
Case "C" ;'Settings' button clicked in the screensaver dialog
ExecuteConfiguration()
Case "P" ;when the preview is requested in the screensaver dialog by selecting this screensaver
ExecutePreview()
Case "S" ;launch the main screensaver after an interval or by pressing 'Preview' in the dialog
ExecuteScreenSaver()
EndSelect
End
;===========================================================================
;-DATA
;===========================================================================
DataSection
PreviewImage:
IncludeBinary "Preview.bmp"
EndDataSection
