This will more or less work but it won't be a proper well-behaved screensaver. Here's how I would do it, compile as "BlackHole.scr" and remember to save as "All files" so PB won't stick an ".exe" on the end of it. To install it into Windows properly, rightclick the .scr file in Windows Explorer and choose "Install":
Code: Select all
; Declarations
Declare PreviewCallback(hWnd, Msg, wParam, lParam) ; Destroys the preview window when OS requests it
Declare DoPresentation(runmode) ; Runs in either preview mode (autostretch windowed screen) or screensave mode (fullscreen)
; Note: The presentation should be sized for the full display and it will
; show correctly in fullscreen or in the small preview window because the
; the preview windowedscreen is set to autostretch. What we do is create
; a child window for the preview parent that the OS provides and size it
; to the client area of the parent. The windowed screen opened on this
; child should be sized to the full display and autostretch set on.
Declare DoPreview() ; Runs when the OS requests your presentation to run in the small preview window
Declare DoConfig() ; Runs when the OS or the user requests configuration of the screensaver
; Inits
InitSprite():InitKeyboard():InitMouse():ExamineDesktops()
; Globals
Global display_cx.i=DesktopWidth(0), display_cy.i=DesktopHeight(0), preview_cx.i
Global preview_cy.i, PreviewParent.i, ConfigHandle.i, runmode.i
; The OS will start the screensaver multiple times so if an instance
; is already running we must let it finish and exit here. The OS will
; try again as soon as the existing instance closes.
; This is an important component of all screensavers, without it the
; screensaver would be quite badly behaved.
result = CreateMutex_(#Null, #True, "MyScreenSaverIsAlreadyRunningMutex")
If GetLastError_() = #ERROR_ALREADY_EXISTS
CloseHandle_(result)
End
EndIf
parametercount = CountProgramParameters()
If parametercount = 0
DoConfig()
ElseIf parametercount=2 ; In preview mode we receive two parameters:
runmode = 0 ; "/p" comes in ProgramParameter(0), the preview window hwnd comes in (1)
DoPreview()
Else
If FindString(UCase(ProgramParameter(0)), "S")
runmode = 1 ; Screensave mode, fullscreen - no hwnd given by OS, we must create our own
OpenScreen(display_cx,display_cy,32,"MyScreenSaver",#PB_Screen_SmartSynchronization)
Repeat
DoPresentation(runmode)
ExamineKeyboard():ExamineMouse() ; After each flip of the buffers we check for key or mouse activity
If KeyboardPushed(#PB_Key_All) Or MouseDeltaX()>2 Or MouseDeltaY()>2
End
EndIf
ForEver
ElseIf FindString(UCase(ProgramParameter(0)), "C")
runmode = 2 ; Config mode, "/c" and the config hwnd come together in (0) in the form "/c:9999999999"
; You can use the supplied hwnd if desired or create your own config window
; Here there is nothing to configure so we just show a message box saying so
DoConfig()
EndIf
EndIf
; Procedures
Procedure PreviewCallback(hWnd, Msg, wParam, lParam)
Select Msg
Case #WM_CLOSE
UnregisterClass_("PreviewWindowClass", GetModuleHandle_(#Null))
DestroyWindow_(hWnd)
End
EndSelect
Result = DefWindowProc_(hWnd, Msg, wParam, lParam)
ProcedureReturn Result
EndProcedure
Procedure DoPreview()
PreviewParent = Val(ProgramParameter(1))
GetClientRect_(PreviewParent, @pp.RECT)
preview_cx = pp\right-pp\left
preview_cy = pp\bottom-pp\top
PreviewWindowClass.WNDCLASS
Classname.s = "BlackHole Preview Class"
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)
ratio.d = display_cy/display_cx
preview_cy = ratio*preview_cx
MyhWnd.l = CreateWindowEx_(0, Classname, "", #WS_CHILD | #WS_VISIBLE, 0, ((pp\bottom-pp\top-preview_cy)/2), preview_cx, preview_cy, PreviewParent, 0, GetModuleHandle_(#Null), 0)
OpenWindowedScreen(MyhWnd, 0, 0, display_cx, display_cy, 1, 0, 0)
Repeat
PeekMessage_(@message.msg, myhwnd, 0, 0, #PM_NOREMOVE)
TranslateMessage_(message.msg)
DispatchMessage_(message.msg)
DoPresentation(runmode)
Delay(1)
; Each call of DoPresentation() should draw one screen, flip the buffers and return
ForEver
EndProcedure
Procedure DoPresentation(mode)
; BlackHole - BasicallyPure
; 7.5.2013
; PureBasic 5.20 beta <--- YOU NEED THIS
Static firstrun=1
#PIx2 = #PI * 2
#Stars = 250
#BlackHoleSpeed = 12 ; larger = slower
If firstrun
firstrun=0
ExamineDesktops()
Static dw : dw = DesktopWidth(0)
Static xMid : xMid = dw / 2
Static dh : dh = DesktopHeight(0)
Static yMid : yMid = dh / 2
Static dd : dd = DesktopDepth(0)
Static a, r, g, b, z, sprite, spriteColor, frameCount
Static angle.f, BH_angle.f = #PI
Static xRadius : xRadius = dw / 3
Static yRadius : yRadius = dh / 3
Structure starType
x.f
y.f
speed.f
nSprite.i
EndStructure
Static Dim star.starType(#Stars)
For a = 0 To #Stars
star(a)\x = Random(dw - 1)
star(a)\y = Random(dh - 1)
star(a)\nSprite = Random(13)
star(a)\speed = star(a)\nSprite / 2.0 + 1
Next
For sprite = 0 To 13
r = Random(255) : b = Random(255) : g = 255 - (r + b) >> 1
spriteColor = RGB(r, g, b)
CreateSprite(sprite, 16, 16)
StartDrawing(SpriteOutput(sprite))
Circle(7, 7, 3, spriteColor)
LineXY(0, 7, 14, 7, spriteColor)
LineXY(7, 0, 7, 14, spriteColor)
StopDrawing()
z = 6 + sprite * 2
ZoomSprite(sprite, z, z)
Next sprite
Static blackHole.Point
blackHole\x = xMid - xRadius
blackHole\y = yMid
EndIf
ClearScreen(#Black)
For a = 0 To #Stars
angle = ATan2(blackHole\x - star(a)\x, blackHole\y - star(a)\y)
star(a)\x + star(a)\speed * Cos(angle)
star(a)\y + star(a)\speed * Sin(angle)
If Abs(star(a)\x - blackHole\x) < 5 And Abs(star(a)\y - blackHole\y) < 5
Select Random(4, 1)
Case 1 : star(a)\x = Random(dw - 1) : star(a)\y = 0
Case 2 : star(a)\x = Random(dw - 1) : star(a)\y = dh - 1
Case 3 : star(a)\x = 0 : star(a)\y = Random(dh - 1)
Case 4 : star(a)\x = dw - 1 : star(a)\y = Random(dh - 1)
EndSelect
EndIf
DisplayTransparentSprite(star(a)\nSprite,star(a)\x,star(a)\y)
Next
If frameCount < #BlackHoleSpeed : frameCount + 1
Else : frameCount = 0
BH_angle + Radian(1)
If BH_angle > #PIx2 : BH_angle - #PIx2 : EndIf
blackHole\x = Cos(BH_angle) * xRadius + xMid
blackHole\y = Sin(BH_angle) * yRadius + yMid
EndIf
FlipBuffers()
EndProcedure
Procedure DoConfig()
MessageRequester("BlackHole Screensaver Configuration","There are no user-configurable settings for this screensaver.",#MB_SYSTEMMODAL)
EndProcedure