Creating MAX Screensaver

BlitzMax Forums/BlitzMax Programming/Creating MAX Screensaver

The forum is locked. These are the original blitzbasic.com forums, kept so they can still be read. No new topics, replies or edits can be made here. To join in, head over to the Blitz3D+ forums.

is there a reason, or is it just on my machine that the preview whilst in the screen save tab on desktop preferences....it is very flickery is it actually running too fast and needs to be slown down, is it skipping and not waiting for the vertical blank......I modified it because between the two versions on this page neither worked coreectly but this hacked version seems to.....any ideas...
'******************** Open Source Screensaver Program ************************
'
' Version 1.1 June 27, 2006
'
' Known issues: None at this time
'
' Contributors: netmaestro, eikon, chris c, Uncle Ho
'
'
' Use: Compile with "GUI App" CHECKED
' Rename .exe to .scr
' move .scr to c:\windows\system32 (or...)
'
'*****************************************************************************

Framework BRL.GLMax2D
Import BRL.Basic
Import BRL.System
Import brl.Retro
Import pub.Win32
Import "-lshell32"
Import "-luser32"
Import "-lkernel32"

Extern "win32"
	Function FindWindow (x:Byte Ptr, y:Byte Ptr) = "FindWindowA@8"
	Function MoveWindow (hWnd,x,y,w,h,d) = "MoveWindow@24"
	Function ShowWindow (hWnd,style) = "ShowWindow@8"
	Function GetWindowLong (hwnd, nIndex) = "GetWindowLongA@8"
	Function SetWindowLong (hWnd,x,y) = "SetWindowLongW@12"
	Function SetParent (hWnd1,hWnd2) = "SetParent@8"
	Function IsWindowVisible (hWnd) = "IsWindowVisible@4"
	Function GetDesktopWindow () = "GetDesktopWindow@0"
	Function GetWindowRect (hWnd:Int,r:Byte Ptr) = "GetWindowRect@8"
	Function CreateSemaphore (a:Byte Ptr, b:Int, c:Int, d:String) = "CreateSemaphoreW@16"
	Function GetLastError () = "GetLastError@0"
EndExtern

'**************** Get Current Desktop Resolution *******************
Global r:Int[4] 
Global p:Byte Ptr = VarPtr( r[0] ) 

' This is advisable because it is best not to switch screen
deskWnd = GetDesktopWindow( ) 		' settings when the screen saver starts.
GetWindowRect(deskWnd, p) 

Global DeskWidth :Float =r[2]
Global DeskHeight:Float =r[3] 
'**************** End Get Current Desktop Resolution ***************

Global Width: Float = 0
Global Height:Float = 0
Global startmousex:Int = 0
Global startmousey:Int = 0

Const ERROR_ALREADY_EXISTS:Int = 183
Const PREVIEW_ACTIVE:Int = 0
Const CONFIG_ACTIVE:Int = 1
Const SAVER_ACTIVE:Int = 2

Global PrevWnd:Int
If AppArgs.length = 3  
	PrevWnd:Int = Int( AppArgs[2] ) 	'Handle of the preview window
EndIf
Global pscale:Float = 1 				'scale value to apply depending on screen size
Global bmw:Int = 0 						'Handle of the BMax window
Global Status:Int = 0 					'Program status, identifies preview, regular, or config modes
Global timemark:Int = 0 				'Time marker to use for a makeshift timer

SetGraphicsDriver GLMax2DDriver( )

If AppArgs.length > 1 
	Select AppArgs[1]
		Case "/p"
			InitPreviewMode( )
		Case "/s"
			InitSaverMode( )
		Case "/c"
			InitConfigMode( )
		Default
			InitConfigMode( )
	End Select  
Else
	InitConfigMode( )
EndIf 


While not KeyHit( KEY_ESCAPE )

	'**************** TODO: Write your own presentation code ***************
	'
	' Multiply any scaling by pscale (=1 in Saver mode, .15-.25 in Preview)
	' You will scale your speeds too (nothing moving in this one)
	'
	'***********************************************************************
	Cls
	SetColor 255,255,255
	DrawOval Rnd(1024), Rand(768), 200, 200
	SetColor 255, 0, 0
	DrawOval Rnd(1024), Rand(768), 200, 200
	SetColor 0,255,0
	DrawOval Rnd(1024), Rand(768), 200, 200
	SetColor 0,0,255
	DrawOval Rnd(1024), Rand(768), 200, 200
	Flip
	GCCollect
	
	'******* This block is boilerplate ********
	Select Status 
		Case PREVIEW_ACTIVE
			CheckVisible( )
		Case SAVER_ACTIVE
			CheckMovement( )
	End Select 
	'************* Do Not Remove **************

Wend

End

Function InitSaverMode()
	If SetProcessLock( "SaverModeLock" ) <> 0 Then End
	Status = SAVER_ACTIVE
	Width = DeskWidth
	Height = DeskHeight
	Graphics Width, Height, 32'-1, -1
	SetWindowPos(FindWindow(Null, "BlitzMax Application"), HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE) 
	pscale = 1
	startmousex = MouseX( )
	startmousey = MouseY() 
	FlushMouse
	FlushKeys
	Return
EndFunction

Function InitPreviewMode( )
	If SetProcessLock("PreviewModeLock") <> 0 Then End
	Status = PREVIEW_ACTIVE
	Width = 152
	Height = 112
	Graphics Width, Height, 0, -1
	bmw = FindWindow( Null, "BlitzMax Application" )
	Local bmx_Style = GetWindowLong( bmw, -16 )
	bmx_Style = bmx_Style and $40000000 or $800000 and $10000000
	SetWindowLong bmw, -16, bmx_Style;
	SetParent( bmw,PrevWnd )
	MoveWindow ( bmw, 0, 0, 152, 112, True )
	pscale = 152/DeskWidth
	SetScale pscale, pscale
	timemark = MilliSecs()
	Return
EndFunction

Function InitConfigMode( )
	Status = CONFIG_ACTIVE
	Width = 320
	Height = 200
	AppTitle = "Configuration Screen"
	Graphics Width,Height, 0
	bmw = FindWindow( Null, "Configuration Screen" )
	MoveWindow ( bmw, ( DeskWidth/2-Width/2 ),( DeskHeight/2-Height/2 ), 320, 200, True )
	SetClsColor 192, 192, 192
	SetColor 0, 0, 0
	Cls
	DrawText "TODO: Write config code", 50, 80
	DrawText "Press <ANY KEY> to exit", 55, 130
	Flip
	WaitKey
	End
EndFunction

Function SetProcessLock:Int( LockStr:String )
	Global MySem = CreateSemaphore( Null, 0, 1, LockStr )
	If MySem <> 0 and GetLastError( ) = ERROR_ALREADY_EXISTS
		Return 1
	Else
		Return 0
	EndIf
EndFunction

Function CheckVisible( )
	If MilliSecs()-timemark > 2000 'Delay visibility check til window is drawn
		If not IsWindowVisible( PrevWnd )
			End
		EndIf
	EndIf
EndFunction

Function CheckMovement( )
	If MouseX( ) <> startmousex or MouseY( ) <> startmousey Then End
	If GetChar( ) <> 0 Then End
	'Probably want to put some more keyhits in here; I'm too lazy
EndFunction




oh and how do you do them scrolling boxes in this forum.....