Hab mal einen Screensaver probiert.
Zu erst eine EXE erstellen und dann die Endung auf SCR umbenennen.
Mit rechter Maustaste anklicken --> installieren oder nach Windows\System32 kopieren
Getestet unter Windows XP SP2 und Windows Vista
Download:PBScreensaver.zip
Lg. Legion
Code: Alles auswählen
Global XPOS.l,YPOS.l
Global EXITSTATUS.b
Global FirstParam.s,Command.s
;-----------------------------------------------------------------------------------------------------------
Procedure PreviewAutoDestruction(window,message,wParam,lParam)
Shared WM_DestroyPreview
Result = #PB_ProcessPureBasicEvents
Select message
Case #WM_CLOSE
DestroyWindow_(window)
If IsImage(1): FreeImage(1) : EndIf
End
Case WM_DestroyPreview
If IsImage(1): FreeImage(1) : EndIf
End
EndSelect
ProcedureReturn Result
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure Preview(preview)
CatchImage(1,?VOS)
UseGadgetList(preview)
GetClientRect_(preview,@rc.rect)
ImageGadget(1,0,0,0,0,ImageID(1))
CloseGadgetList()
Shared WM_DestroyPreview
WM_DestroyPreview=RegisterWindowMessage_(@"PREVIEW AUTO DESTRUCTION")
SendMessage_(#HWND_BROADCAST,WM_DestroyPreview,0,0)
SetParent_(OpenWindow(0,0,0,0,0,"CHILD WINDOW",#PB_Window_Invisible),preview)
SetWindowCallback(@PreviewAutoDestruction())
Repeat
WaitWindowEvent()
ForEver
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure Fadein()
Protected i
For i = 0 To 255 Step 5
ClearScreen(0)
DisplayTranslucentSprite(1,XPOS,YPOS,i)
FlipBuffers()
If EXITSTATUS = 1 : Break : EndIf
Next i
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure Fadeaut()
Protected i = 255
While i > 1
ClearScreen(0)
DisplayTranslucentSprite(1,XPOS,YPOS,i)
FlipBuffers()
i = i-5
If EXITSTATUS = 1 : Break : EndIf
Wend
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure RandomPos(index)
Repeat
XPOS = Random(DesktopWidth(0)-ImageWidth(0))
YPOS = Random(DesktopHeight(0)-ImageHeight(0))
If EXITSTATUS = 1 : Break : EndIf
StartSpecialFX()
Fadein()
StopSpecialFX()
If EXITSTATUS = 1 : Break : EndIf
Delay(4000)
If EXITSTATUS = 1 : Break : EndIf
StartSpecialFX()
Fadeaut()
StopSpecialFX()
If EXITSTATUS = 1 : Break : EndIf
ForEver
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure Main()
If InitSprite() And InitSound() And InitKeyboard() And ExamineDesktops() And InitMouse()And OpenScreen(DesktopWidth(0),DesktopHeight(0),DesktopDepth(0),"")
CatchImage(0,?BAK)
CatchSprite(1,?BAK,#PB_Sprite_Memory)
StartSpecialFX()
Thread = CreateThread(@RandomPos(),0)
If IsThread(Thread)
Repeat
ExamineMouse()
MouseDeltaX()
MouseDeltaY()
If MouseDeltaX() <> 0 Or MouseDeltaY() <> 0
EXITSTATUS = 1
WaitThread(Thread)
Break
EndIf
Delay(1)
ForEver
EndIf
FreeImage(0)
FreeSprite(1)
Else
MessageRequester("Fehler","Konnte DirectX nicht einwandfrei initialisieren",#PB_MessageRequester_Ok)
EndIf
EndProcedure
;-----------------------------------------------------------------------------------------------------------
FirstParam = ProgramParameter()
Command = LCase(Left(ReplaceString(FirstParam,"-","/"),2))
ParentWindow.l = Val(StringField(FirstParam,2,":")) | Val(ProgramParameter())
EXITSTATUS = 0
;-----------------------------------------------------------------------------------------------------------
Select Command
Case "/p"
;Preview
Preview(ParentWindow)
;-----------------------------------------------------------------------------------------------------------
Case "/c"
;Config
MessageRequester("Info","Dieser Bildschirmschoner hat keine Optionen, die Sie einstellen können",#PB_MessageRequester_Ok)
;-----------------------------------------------------------------------------------------------------------
Default
;Start Screensaver
Main()
EndSelect
;-----------------------------------------------------------------------------------------------------------
End
;-----------------------------------------------------------------------------------------------------------
;Nicht vergessen auf eigene Pfade umzustellen ! ! ! ! ! ! ! !
DataSection
BAK: IncludeBinary "Logo das eingeblendet wird"
VOS: IncludeBinary "Vorschaubild"
EndDataSection
