Here is code for a fairly complete screensaver, all this one lacks is registry reading/writing for configuration purposes. There is nothing to configure here, so it isn't needed. To see how that's done, look at Kale's example, his is good. You can just run this code from the browser if you have the ie tool (if not you should get it, it's great) to see the presentation, but if you want to use it as a screensaver, compile it to Roseace3d.scr and put it in c:\windows\system32. It will show properly in the little monitor screen. But before you do that you should comment out the line SelectModeandRun() in the default section of the select block in the main loop (near the bottom of the code) and uncomment the other line so that the config box will show when the user presses "settings". If you don't do that the screensaver will take off when the settings button is pushed.
Code: Select all
; The following <presentation only> code is an update from original Cederavic code
; posted on french forum formerly, posted to tricks & tips by fweil 20040515
;
; wrapped in screensaver boilerplate by netmaestro 20050731
;
; I found this excellent display effect on the tips & tricks forum
; along with a request from FWeil for anyone who knew how to convert it to a screensaver.
; I carved it up and plugged it into my screensaver boilerplate, and here it is for all to enjoy.
;
;
;
;-Config window constants
Enumeration 1
#Window_Form1
#Gadget_Form1_Button2
#Gadget_Form1_Image3
#Gadget_Form1_Text4
#Gadget_Form1_Text5
#Gadget_Form1_Text6
EndEnumeration
InitSprite()
InitSprite3D()
Sprite3DQuality(1)
Global a$, b$, PrevWinHndl.l
a$ = ProgramParameter() ; Either /p, /c or /s
b$ = ProgramParameter() ; Preview window handle or nothing, depending on mode
PrevWinHndl = Val(b$) ; Get the handle if it's there
Global width.l
Global height.l
Global depth.l
Global sizefactor.f
Global spritesizefactor.f
Global CX,CY,CXZ,CYZ,s.l,s2.l,sk.l,j.f,j2.f,k,SpriteLightX.f,SpriteLightY.f
Procedure CreateAllSprites()
Start3D()
Sprite3DQuality(1)
CX = width/2 - (width/33)
CY = height/2 - (height/25)
CXZ = sizefactor * width / 3
CYZ = sizefactor * height / 3
s.l = 1
s2.l = 1
sk.l = 1
j.f = 0.0
j2.f = 50.0
k.l = 0
SpriteLightX.f = 0.5
SpriteLightY.f = 0.5
For t = 0 To 400
CreateSprite(t, 32, 32, #PB_Sprite_Texture)
StartDrawing(SpriteOutput(t))
ColorMask.l = Random(7) + 1
Red = 32 * Random(4) * ((ColorMask & 4) >> 2)
Green = 32 * Random(4) * ((ColorMask & 2) >> 1)
Blue = 32 * Random(4) * ((ColorMask & 1))
SpriteCX.f = 16.0
SpriteCY.f = 16.0
SpriteRadius = 10
Circle(SpriteCX, SpriteCY, SpriteRadius, RGB(0, 0, 0))
For SpriteRadius = 9 To 2 Step - 1
Circle(SpriteCX, SpriteCY, SpriteRadius, RGB(Red, Green, Blue))
SpriteCX + SpriteLightX
SpriteCY + SpriteLightY
Red + 16
If Red > 255
Red = 255
EndIf
Green + 32
If Green > 255
Green = 255
EndIf
Blue + 32
If Blue > 255
Blue = 255
EndIf
Next
StopDrawing()
CreateSprite3D(t, t)
Next
EndProcedure
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
Procedure SetProcessLock(LockStr$)
*MySem = CreateSemaphore_(null, 0, 1, LockStr$)
If *MySem <> 0 And GetLastError_() = #ERROR_ALREADY_EXISTS
CloseHandle_(*MySem)
End
EndIf
EndProcedure
Procedure InitWindow()
If a$ = "/p" Or a$ = "-p"
SetProcessLock("MyPreviewModeLock")
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)
MyhWnd.l = CreateWindowEx_(0, "PreviewWindowClass", "", #WS_CHILD | #WS_VISIBLE, 0, 0, PreviewWindowSize\right, PreviewWindowSize\bottom, PrevWinHndl, 0, GetModuleHandle_(#Null), 0)
OpenWindowedScreen(MyhWnd, 0, 0, PreviewWindowSize\right, PreviewWindowSize\bottom, 0, 0, 0)
width = PreviewWindowSize\right
height = PreviewWindowSize\bottom
sizefactor = 0.75
spritesizefactor = 0.08 * width
Else
SetProcessLock("MySaverModeLock")
ExamineDesktops()
width = DesktopWidth(0)
height = DesktopHeight(0)
depth = DesktopDepth(0)
sizefactor = 3
spritesizefactor = 0.04 * width
OpenScreen(width, height, depth, "Roseace3D")
EndIf
EndProcedure
Procedure CheckStatus()
If a$ <> "/p" And a$ <> "-p"
ExamineKeyboard() : ExamineMouse()
If MouseDeltaX() Or MouseDeltaY() Or KeyboardPushed(#PB_Key_All) Or MouseButton(#PB_MouseButton_Left) Or MouseButton(#PB_MouseButton_Right)
End
EndIf
If GetFocus_() <> ScreenID()
End
EndIf
EndIf
EndProcedure
Procedure.l Window_Form1()
If OpenWindow(#Window_Form1,197,146,450,216,#PB_Window_ScreenCentered|#PB_Window_Invisible,"Roseace3D Screensaver")
If CreateGadgetList(WindowID(#Window_Form1))
ButtonGadget(#Gadget_Form1_Button2,85,170,290,25,"Close")
TextGadget(#Gadget_Form1_Text4,105,40,225,15,"Based on code submitted by fweil May 2004")
TextGadget(#Gadget_Form1_Text5,105,70,255,15,"Converted to Screensaver by netmaestro July 2005")
TextGadget(#Gadget_Form1_Text6,105,105,215,15,"Open source - free to copy or modify "+a$)
HideWindow(#Window_Form1,0)
ProcedureReturn WindowID()
EndIf
EndIf
EndProcedure
Procedure DoConfiguration()
If Window_Form1()
quitForm1=0
Repeat
EventID=WaitWindowEvent()
Select EventID
Case #PB_Event_CloseWindow
If EventWindowID()=#Window_Form1
quitForm1=1
EndIf
Case #PB_Event_Gadget
Select EventGadgetID()
Case #Gadget_Form1_Button2
quitForm1=1
EndSelect
EndSelect
Until quitForm1
CloseWindow(#Window_Form1)
EndIf
End
EndProcedure
Procedure ShowPresentation()
ClearScreen(0, 0, 0)
For t = 0 To 400
j + s * 0.00025
j2 + s2 * 0.00025
If j <= 5
s = 1
EndIf
If j => 35
s = -1
EndIf
If j2 <= 5
s2 = 1
EndIf
If j2 => 35
s2 = -1
EndIf
Angle1.f = t / j / 2
Alpha = Sin(Angle1) * 32
If Alpha < 40
Alpha = 128 - 3 * Alpha
Else
Alpha = 128 - Alpha / 3
EndIf
If Alpha > 255
Alpha = 255
ElseIf Alpha < 0
Alpha = 0
EndIf
ZoomSprite3D(t, spritesizefactor, spritesizefactor)
Angle1.f = 2 * Angle1
Angle2.f = 2 * t / j2 + j2 / 2
DisplaySprite3D(t, CX + CXZ * (Sin(Angle1) + Cos(Angle2)) * k / (width + Alpha), CY + CYZ * (Cos(Angle1) + Sin(Angle2)) * k / (height + Alpha), Alpha)
Next
k + sk
If k <= 50
sk = 1
EndIf
If k => 250
sk = -1
EndIf
FlipBuffers()
EndProcedure
Procedure SelectModeAndRun()
InitWindow()
CreateAllSprites()
Start3D() : InitKeyboard() : InitMouse()
If a$ = "/p" Or a$ = "-p"
Repeat
GetMessage_(Message.MSG, 0, 0, 0)
TranslateMessage_(Message)
DispatchMessage_(Message)
Repeat
EventID = WindowEvent()
ShowPresentation()
Delay(1)
Until EventID = #PB_Event_CloseWindow
ForEver
Else
Repeat
CheckStatus()
ShowPresentation()
Delay(0)
ForEver
EndIf
EndProcedure
; ******* Main Loop *******
Select a$
Case "/s"
SelectModeAndRun()
Case "/p"
SelectModeAndRun()
Case "-p"
SelectModeAndRun()
Case "/c"
DoConfiguration()
Default
;DoConfiguration()
Selectmodeandrun()
EndSelect
End
hehe